在 Haskell 中序列化复杂的 AST

Question

我正在使用 Haskell 中的一个库，它具有非常非常复杂的递归数据结构，代表 AST。它包含数十个不同的构造函数，有些具有简单的递归定义，有些具有相互递归定义，而且都是令人讨厌的。

我希望能够将这个巨大的递归怪物序列化为 JSON 字符串，然后能够反序列化它。它是一个数据类，所以我觉得我应该能够拥有某种通用函数，将其转换为 JSON 格式的巨大的人类可读字符串。我真的、真的希望避免为其 80 多个构造函数编写自定义序列化逻辑。

这可能吗？

为了澄清，我正在尝试序列化 此数据结构，它是官方 GHC API 的一部分。我知道漂亮打印给了我一个字符串，但我真的很喜欢它作为 JSON 结构。

编辑：该类对于 Generic 来说太复杂，无法创建合适的 ToJSON 和 FromJSON，除非我遗漏了某些内容。

Answer 1

唯一合理的方法是使用独立的派生子句为（大多数）涉及的类型派生 Generic 实例，并生成尽可能多的 FromJSON/ToJSON 实例尽可能使用基于默认 Generic 的默认值。

我开始摆弄它，我发现没有无法克服的技术障碍，但所需的样板数量并不小。您将需要大量Generic 实例。您可能还需要使用 ghc-lib 源代码的修改副本，因为某些类型（例如 TyCon）不会随其构造函数一起导出，从而阻止派生实例。

总体而言，Generic 实例并没有那么糟糕，因为大多数都可以在阶段中以多态方式派生：

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

import BasicTypes
import CoAxiom
-- etc. --

import GHC.Generics

deriving instance Generic (AnnDecl p)
deriving instance Generic (AnnProvenance p)
deriving instance Generic (Branches br)
deriving instance Generic (CoAxiom br)
deriving instance Generic (ForeignDecl p)
deriving instance Generic (GenLocated l e)
deriving instance Generic (HsBracket p)
deriving instance Generic (HsExpr p)
-- etc. --

FromJSON、ToJSON 实例稍微多一点难的。 Phase 参数用于通过类型族来更改树的某些部分中的类型，因此多态实例：

import Data.Aeson

instance FromJSON (HSExpr p)

将开始需要很多类型族实例，例如instance FromJSON (XWrap p) 以及其他几十个。您无法以多态方式提供这些：

instance FromJSON (XWrap p)  -- Illegal type synonym family application

因为它们是类型系列，而 GHC 不支持它们。我认为最好的方法是为每个所需阶段定义实例，并且由于存在一些阶段间依赖关系，因此您需要为多个阶段定义实例，即使您只是尝试序列化一个阶段。因此：

instance FromJSON (HSExpr GhcTc)
instance FromJSON (HSExpr GhcRn)
-- etc. --

从这里开始，就需要跟踪编译器错误消息 re：丢失实例并将其全部填充。您选择的编辑器中的一些键盘宏应该可以减轻痛苦。

您最终将了解一些可能不应该一般序列化的叶类型。例如，FastString 是存储在公共哈希表中用于快速比较的字符串，您需要/需要手动序列化和反序列化它（或在反序列化端重建哈希表） 。

不管怎样，我在大约 35 个 Generic 实例和 50 个 FromJSON 实例后停止了，我认为那时我只完成了大约四分之一。另一方面，这花了我不到一个小时，所以我认为一两天的乏味工作就可以完成。

这是我失去兴趣之前的经历。大约一半的 FromJSON 实例进行类型检查；其余的仍然是要求较高的情况。不过，我使用的是 GHC 8.10.7，因此模块名称和类型可能与您的不匹配。

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TemplateHaskell #-}

module MyModule where

import BasicTypes
import CoAxiom
import FastString
import GHC.Hs
import GHC.Hs.Extension
import Name
import SrcLoc
import TyCoRep
import TyCon
import Unique
import UniqSet
import Var
import qualified Data.Array as Array

import GHC.Generics
import Data.Aeson

deriving instance Generic (AnnDecl p)
deriving instance Generic (AnnProvenance p)
deriving instance Generic (Branches br)
deriving instance Generic (CoAxiom br)
deriving instance Generic (ForeignDecl p)
deriving instance Generic (GenLocated l e)
deriving instance Generic (HsBracket p)
deriving instance Generic (HsExpr p)
deriving instance Generic (HsGroup p)
deriving instance Generic (HsImplicitBndrs p (LHsType p))
deriving instance Generic (HsRecField' id arg)
deriving instance Generic (HsSplice p)
deriving instance Generic (HsType p)
deriving instance Generic (HsWildCardBndrs p (LHsType p))
deriving instance Generic (Match p (LHsExpr p))
deriving instance Generic (MatchGroup p (LHsExpr p))
deriving instance Generic (RuleDecls p)
deriving instance Generic (StmtLR p p (LHsExpr p))
deriving instance Generic (VarBndr var argf)
deriving instance Generic (WarnDecl p)
deriving instance Generic (WarnDecls p)
deriving instance Generic AnonArgFlag
deriving instance Generic ArgFlag
deriving instance Generic CoAxBranch
deriving instance Generic Coercion
deriving instance Generic ForeignImport
deriving instance Generic NoExtCon
deriving instance Generic NoExtField
deriving instance Generic Role
deriving instance Generic SourceText
deriving instance Generic SrcSpan
deriving instance Generic StringLiteral
deriving instance Generic TyLit
deriving instance Generic Type
deriving instance Generic WarningTxt

instance (FromJSON l, FromJSON e) => FromJSON (GenLocated l e)
instance FromJSON (AnnDecl GhcTc)
instance FromJSON (AnnProvenance Var)
instance FromJSON (Branches br)
instance FromJSON (CoAxiom Branched)
instance FromJSON (ConDeclField GhcRn)
instance FromJSON (ConDeclField GhcTc)
instance FromJSON (ForeignDecl GhcTc)
instance FromJSON (GRHS GhcTc (LHsExpr GhcTc))
instance FromJSON (HsBracket GhcRn)
instance FromJSON (HsBracket GhcTc)
instance FromJSON (HsExpr GhcRn)
instance FromJSON (HsExpr GhcTc)
instance FromJSON (HsGroup GhcRn)
instance FromJSON (HsGroup GhcTc)
instance FromJSON (HsImplicitBndrs GhcTc (LHsExpr GhcTc))
instance FromJSON (HsImplicitBndrs GhcTc (LHsType GhcTc))
instance FromJSON (HsLocalBindsLR GhcTc GhcTc)
instance FromJSON (HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcTc))
instance FromJSON (HsRecFields GhcTc (LHsExpr GhcTc))
instance FromJSON (HsSplice GhcTc)
instance FromJSON (HsTyVarBndr GhcRn)
instance FromJSON (HsTyVarBndr GhcTc)
instance FromJSON (HsType GhcRn)
instance FromJSON (HsType GhcTc)
instance FromJSON (HsValBindsLR GhcTc GhcTc)
instance FromJSON (HsWildCardBndrs GhcRn (LHsSigType GhcRn))
instance FromJSON (HsWildCardBndrs GhcRn (LHsType GhcRn))
instance FromJSON (Match GhcTc (LHsExpr GhcTc))
instance FromJSON (MatchGroup GhcTc (LHsExpr GhcTc))
instance FromJSON (RuleDecls GhcRn)
instance FromJSON (RuleDecls GhcTc)
instance FromJSON (StmtLR GhcRn GhcRn (LHsExpr GhcRn))
instance FromJSON (StmtLR GhcTc GhcTc (LHsExpr GhcTc))
instance FromJSON (VarBndr TyCoVar ArgFlag)
instance FromJSON (WarnDecl GhcTc)
instance FromJSON (WarnDecls GhcTc)
instance FromJSON AnonArgFlag
instance FromJSON ArgFlag
instance FromJSON CoAxBranch
instance FromJSON Coercion
instance FromJSON ForeignImport
instance FromJSON NoExtField
instance FromJSON Role
instance FromJSON SourceText
instance FromJSON SrcSpan
instance FromJSON StringLiteral
instance FromJSON TyLit
instance FromJSON Type
instance FromJSON WarningTxt

-- Non-generic instances, a mixture of:
-- 1. Those that shouldn't be derived generically (e.g., FastString)
-- 2. Those that will need access to the constructors (e.g., TyCon)
instance FromJSON RealSrcSpan where parseJSON = undefined
instance FromJSON FastString where parseJSON = undefined
instance FromJSON a => FromJSON (UniqSet a) where parseJSON = undefined
instance FromJSON Var where parseJSON = undefined
instance FromJSON NoExtCon where parseJSON = undefined
instance (FromJSON i, FromJSON e) => FromJSON (Array.Array i e) where parseJSON = undefined
instance FromJSON TyCon where parseJSON = undefined
instance FromJSON Unique where parseJSON = undefined
instance FromJSON Name where parseJSON = undefined

Answer 2

“Scrap-your-boilerplate”（syb）库具有“gshow”和“gread”函数，可以读取和加载 Haskell 中的大多数数据类，但具有私有字段或构造函数的数据类除外。