haskell - 按类型打印数据类型的结构

Question

我想将 JSON 文件解析为一种数据类型，并在解析错误的情况下打印错误以及预期的数据结构。

让我们以数据记录为例:

data Foo = {
  bar :: String
}

我想在解析失败时将此数据的结构打印到控制台，以向用户显示 JSON 应该是什么结构。另外，我不想将结构硬编码到错误日志中，以使其类型安全(意思是:当我向数据添加新字段时，它也应该被打印以防出现解析错误。当它会被硬编码我会忘记修改关于要打印的结构的字符串)。

只要在 Foo 上使用 deriving Show 就可以很容易地将它打印到控制台。但是如何打印没有值的结构呢？

如果我能够按字面打印类型定义就足够了。但是，如果您有一个很好的类型安全的解决方案并且可以很好地格式化，那肯定是受欢迎的:)

Answer 1

我确信有多种方法可以做到这一点，但我使用的是泛型。如果您不熟悉泛型，您应该阅读 GHC.Generics 的文档.

首先，一些语言扩展和导入:

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}

import GHC.Generics
import GHC.TypeLits ( KnownSymbol, symbolVal )
import Data.Proxy ( Proxy(..) )
import Data.Typeable (typeRep, Typeable)

使用 DefaultSignatures 扩展和 DeriveGeneric，我们可以创建一个自动实现 printStructure 的类型类 PrintStructure为你发挥作用。您需要做的就是传入一个带有 phantom variable 的 Proxy WhateverYouWantToPrint 类型。

class PrintStructure a where
    printStructure :: Proxy a -> String
    default printStructure :: (Generic a, PrintStructure' (Rep a)) => Proxy a -> String
    printStructure _ = printStructure' (Proxy :: Proxy (Rep a p))

PrintStucture' 是一个使用 Generic 表示打印类型结构的类。

class PrintStructure' a where
    printStructure' :: Proxy (a p) -> String

现在，除非您阅读了文档，否则下一部分将没有意义，所以请先阅读文档。 (泛型并不像它们看起来那么复杂)。
为 void 和 unit 类型实现 PrintStructure':

-- Empty string, there's nothing to print for them
instance PrintStructure' V1 where
    printStructure' _ = ""

instance PrintStructure' U1 where
    printStructure' _ = ""

构造函数:

instance ( PrintStructure' f
         , KnownSymbol name
         ) => PrintStructure' (C1 ('MetaCons name fx sl) f) where
    printStructure' _ = symbolVal (Proxy @name)
                     ++ " { " 
                     ++ printStructure' (Proxy :: Proxy (f p)) 
                     ++ " }"

记录选择器:

instance ( KnownSymbol name
         , PrintStructure' f
         ) => PrintStructure' (S1 ('MetaSel ('Just name) su ss ds) f) where
    printStructure' _ = symbolVal (Proxy @name) ++ " :: " ++ printStructure' (Proxy :: Proxy (f p))

总和、乘积、构造函数字段和数据类型:

instance ( PrintStructure' f
         , PrintStructure' g
         ) => PrintStructure' (f :*: g) where
    printStructure' _ = printStructure' (Proxy :: Proxy (f p))
                     ++ ", "
                     ++ printStructure' (Proxy :: Proxy (g p))

instance ( PrintStructure' f
         , PrintStructure' g
         ) => PrintStructure' (f :+: g) where
    printStructure' _ = printStructure' (Proxy :: Proxy (f p))
                     ++ " | "
                     ++ printStructure' (Proxy :: Proxy (g p))

instance ( PrintStructure' f
         ) => PrintStructure' (S1 ('MetaSel 'Nothing su ss ds) f) where
    printStructure' _ = printStructure' (Proxy :: Proxy (f p))

instance (Typeable t) => PrintStructure' (Rec0 t) where
    printStructure' _ = show (typeRep (Proxy @t))

instance ( KnownSymbol name
         , PrintStructure' f
         ) => PrintStructure' (D1 ('MetaData name mod pkg nt) f) where
    printStructure' _ = "data "
                     ++ symbolVal (Proxy @name)
                     ++ " = "
                     ++ printStructure' (Proxy :: Proxy (f p))

现在我们可以测试一下。

λ> data Foo = Bar { p :: String, q :: Int } | Baz { r :: Bool } | Qux () Int deriving (Show, Generic)

λ> instance PrintStructure Foo

λ> putStrLn $ printStructure (Proxy :: Proxy Foo)
data Foo = Bar { p :: [Char], q :: Int } | Baz { r :: Bool } | Qux { (), Int }

而且有效!如您所见，格式不是最好的，但 pretty-print 应该不是什么大问题。