json - FromJSON 从多个字段创建一个列表

Question

我有一个对象要解析，看起来有点像这样:

{
  "data":
  [
    {
      "virtio0": "some text",
      "virtio1": "blah",
      "ide2": "some other text",
      "cores": 1,
      "mem": 512,
      ...
    },
    {
      // The same ...
    }
  ]
}

现在我基本上想将其解析为 [VM]，但我的问题是那些编号字段。根据 VM 配置，它可能有也可能没有 virtioX 字段、ideX 字段……而且我没有看到提前知道的方法，也没有猜测数字。我在想最好的方法可能是定义一个包含 Virtio | 之类的磁盘类型。萨塔 | IDE 等用于类型，文本字段用于值，然后让每个 VM 在其类型中有一个 [Disk]。像这样:

data DiskType = Virtio | Sata | IDE
data Disk     = Disk {diskType :: DiskType, diskPath :: Text}
data VM       = VM {cores :: Int, disks :: [Disk], mem :: Int, ...}

那太好了，但是我如何将 VM json 对象中直接包含的那些随机字段解析为列表？

Answer 1

虽然我不认为自己是 Haskell 专家，更不是 Aeson 专家，但我认为我找到了一些有用的东西。接受它本来的样子。

以下代码都使用了这个模块声明和这些导入:

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Applicative ((<$>), (<|>))
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Data.HashMap.Lazy (HashMap, foldlWithKey')
import Data.Foldable (toList)
import Data.Text (Text, stripPrefix, unpack)
import Text.Read (readMaybe)

我稍微更改了类型声明:

data DiskType = Virtio | Sata | IDE deriving (Show)
data Disk =
  Disk { diskType :: DiskType, diskNumber :: Int, diskPath :: Text }
  deriving (Show)
data VM = VM { cores :: Int, disks :: [Disk], mem :: Int } deriving (Show)

最显着的区别是我在 Disk 类型中添加了 diskNumber ，这样它既可以捕获磁盘类型之后的数字，也可以捕获相关的文本具有磁盘属性。

另一个变化是我将所有类型都设为 Show 的实例。这只是为了能够测试我的代码是否有效。

首先，我定义了一个小辅助函数，可以找到给定前缀后的数字:

findNumber :: Read a => Text -> Text -> Maybe a
findNumber prefix candidate =
  stripPrefix prefix candidate >>= (readMaybe . unpack)

例子:

*Main Data.Text> findNumber (pack "ide") (pack "ide2") :: Maybe Int
Just 2
*Main Data.Text> findNumber (pack "sata") (pack "sata0") :: Maybe Int
Just 0
*Main Data.Text> findNumber (pack "foo") (pack "bar") :: Maybe Int
Nothing

这使我能够编写一个函数来查找 Object 中的所有磁盘:

findDisks :: HashMap Text Value -> [Disk]
findDisks = foldlWithKey' folder []
  where
    findVirtio k s = flip (Disk Virtio) s <$> findNumber "virtio" k
    findSata   k s = flip (Disk Sata)   s <$> findNumber "sata"   k
    findIde    k s = flip (Disk IDE)    s <$> findNumber "ide"    k
    folder acc k (String s) =
      acc ++ toList (findVirtio k s <|> findSata k s <|> findIde k s)
    folder acc _ _ = acc

Object 是 HashMap Text Value 的类型别名，因此此函数将 Object 作为输入，并返回 的列表code>Disk 它可以找到的值。

这足以为 VM 定义一个 FromJSON 实例:

instance FromJSON VM where
  parseJSON = withObject "VM" $ \o -> do
    let disks = findDisks o
    cores <- o .: "cores"
    mem   <- o .: "mem"
    return $ VM cores disks mem

为了测试它是否有效，我创建了这个 JSON 字符串:

myJson :: ByteString
myJson =
  "[\
    \{\
      \\"virtio0\": \"some text\",\
      \\"virtio1\": \"blah\",\
      \\"ide2\": \"some other text\",\
      \\"cores\": 1,\
      \\"mem\": 512\
    \}\
  \]"

并从 main 使用它:

main :: IO ()
main = do
  let vms = decode myJson :: Maybe [VM]
  print vms

执行时，它会打印解码后的值:

Just [VM {cores = 1, disks = [Disk {diskType = IDE, diskNumber = 2, diskPath = "some other text"},Disk {diskType = Virtio, diskNumber = 1, diskPath = "blah"},Disk {diskType = Virtio, diskNumber = 0, diskPath = "some text"}], mem = 512}]

请注意，此处解析的 JSON 只是一组 VM 对象。我没有将外部容器对象包含在 data 属性中，但如果您需要这方面的帮助，我认为这应该是一个单独的问题:)