json - 使用 aeson 解析 JSON 以获得复合数据类型

Question

我有以下数据类型:

data DocumentOrDirectory = Document DocumentName DocumentContent 
                         | Directory DirectoryName [DocumentOrDirectory]

我为 toJSON 提供了以下代码。它有效，但需要改进。它应该分别转换文档和目录，但我不知道该怎么做。

instance JSON.ToJSON DocumentOrDirectory where
    toJSON (Document documentName documentContent) = JSON.object
        [ "document" JSON..= JSON.object 
            [ "name" JSON..= (T.pack $ id documentName)
            , "content" JSON..= (T.pack $ id documentContent)
            ]
        ]
    toJSON (Directory dirName dirContent) = JSON.object
        [ "directory" JSON..= JSON.object 
            [ "name" JSON..= (T.pack $ id dirName)
            , "content" JSON..= JSON.toJSON dirContent
            ]
        ]

我需要能够从 JSON 中解析 DocumentOrDirectory 对象。这是我想出的(不起作用):

instance JSON.FromJSON DocumentOrDirectory where
    parseJSON (Object v@(Document documentName documentContent)) = 
        DocumentOrDirectory <$> documentName .: "name"
                            <*> documentContent .: "content"
    parseJSON (Object v@(Directory dirName dirContent) = 
        DocumentOrDirectory <$> dirName .: "name"
                            <*> dirContent .: "content"
    parseJSON _ = mzero

我应该如何修改现有代码才能将数据与 JSON 相互转换？

Answer 1

让我们逐步解决这个问题。

首先，为了示例的缘故，我假设名称和内容只是 String:

type DirectoryName = String
type DocumentName = String
type DocumentContent = String

您提到要分别序列化 Document 和 Directory。也许你也想单独与他们一起工作。让我们将它们设为不同的类型:

data Document = Document DocumentName DocumentContent deriving Show
data Directory = Directory DirectoryName [DocumentOrDirectory] deriving Show
newtype DocumentOrDirectory = DocumentOrDirectory (Either Document Directory) deriving Show

现在 DocumentOrDirectory 是类型别名或 Either Document Directory。我们使用了 newtype，因为我们想为它编写自己的实例。默认的 Either 实例对我们不起作用。

然后定义几个辅助函数:

liftDocument :: Document -> DocumentOrDirectory
liftDocument = DocumentOrDirectory . Left

liftDirectory :: Directory -> DocumentOrDirectory
liftDirectory = DocumentOrDirectory . Right

有了这个定义，我们可以编写单独的 ToJSON 实例:

instance ToJSON Document where
  toJSON (Document name content) = object [ "document" .= object [
    "name"    .= name,
    "content" .= content ]]

instance ToJSON Directory where
  toJSON (Directory name content) = object [ "directory" .= object [
    "name"    .= name,
    "content" .= content ]]

instance ToJSON DocumentOrDirectory where
  toJSON (DocumentOrDirectory (Left d))  = toJSON d
  toJSON (DocumentOrDirectory (Right d)) = toJSON d

我们应该检查 Document 和 Directory 是如何序列化的(我美化了 JSON 输出):

*Main> let document = Document "docname" "lorem"
*Main> B.putStr (encode document)

{
  "document": {
    "content": "lorem",
    "name": "docname"
  }
}

*Main> let directory = Directory "dirname" [Left document, Left document]
*Main> B.putStr (encode directory) >> putChar '\n'

{
  "directory": {
    "content": [
      {
        "document": {
          "content": "lorem",
          "name": "docname"
        }
      },
      {
        "document": {
          "content": "lorem",
          "name": "docname"
        }
      }
    ],
    "name": "directory"
  }
}

B.putStr (encode $ liftDirectory directory) 的结果是一样的!

下一步是编写解码器，FromJSON 实例。我们看到键(directory 或 document)显示了底层数据是Directory 还是Document。因此 JSON 格式是非重叠的(明确的)，因此我们可以尝试解析 Document 然后是 Directory。

instance FromJSON Document where
  parseJSON (Object v) = maybe mzero parser $ HashMap.lookup "document" v
    where parser (Object v') = Document <$> v' .: "name"
                                        <*> v' .: "content"
          parser _           = mzero
  parseJSON _          = mzero

instance FromJSON Directory where
  parseJSON (Object v) = maybe mzero parser $ HashMap.lookup "directory" v
    where parser (Object v') = Directory <$> v' .: "name"
                                         <*> v' .: "content"
          parser _           = mzero
  parseJSON _          = mzero

instance FromJSON DocumentOrDirectory where
  parseJSON json = (liftDocument <$> parseJSON json) <|> (liftDirectory <$> parseJSON json)

检查:

*Main> decode $ encode directory :: Maybe DocumentOrDirectory
Just (DocumentOrDirectory (Right (Directory "directory" [DocumentOrDirectory (Left (Document "docname" "lorem")),DocumentOrDirectory (Left (Document "docname" "lorem"))])))

---

我们可以在对象数据中使用 type 标记 序列化数据，然后序列化和反序列化看起来会更好一些:

instance ToJSON Document where
  toJSON (Document name content) = object [
    "type"    .= ("document" :: Text),
    "name"    .= name,
    "content" .= content ]

生成的文档将是:

{
  "type": "document",
  "name": "docname",
  "content": "lorem"
}

和解码:

instance FromJSON Document where
  -- We could have guard here
  parseJSON (Object v) = Document <$> v .: "name"
                                  <*> v .= "content" 

instance FromJSON DocumentOrDirectory where
  -- Here we check the type, and dynamically select appropriate subparser
  parseJSON (Object v) = do typ <- v .= "type"
                            case typ of
                              "document"  -> liftDocument $ parseJSON v
                              "directory" -> liftDirectory $ parseJSON v
                              _           -> mzero

---

在具有子类型的语言中，您可以拥有这样的 scala:

sealed trait DocumentOrDirectory
case class Document(name: String, content: String) extends DocumentOrDirectory
case class Directory(name: String, content: Seq[DocumentOrDirectory]) extends DocumentOrDirectory

有人可能会争辩说这种方法(依赖于子类型)更方便。在 Haskell 中，我们更明确:liftDocument 和 liftDirectory 可以被认为是显式类型强制转换/向上转换，如果你喜欢考虑对象。

---

编辑: the working code as gist