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

FromJSON make a list from multiple fields

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

{
  "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 对象中直接拥有的那些随机字段解析为列表?

如果如您所说只有 9 个 virtio 和 2 个 ide,一种简单但可能不太优雅的方法是使用 Data.Foldable 中的 asum 函数(这是来自各种解析库)

import Control.Applicative


instance FromJSON VM where
  parseJSON = withObject "VM" $ \o -> do
    cores <- o .: "cores"
    mem   <- o .: "mem"
    disk  <- optional $ asum [
      o .: "virtio0",
      o .: "virtio1",
      o .: "virtio2",
    return VM{..}

我还没有尝试过代码。如需进一步参考,请参阅此 link 以获得使用 Aeson 库解析 haskell JSON 的综合 guide。

虽然我不认为自己是 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

ObjectHashMap Text Value 的类型别名,因此此函数采用 Object 作为输入,returns 是 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 属性 中,但如果您需要帮助,我认为这应该是一个单独的问题:)