FromJSON make a list from multiple fields

I have an object to parse that looks a bit like this :

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

Now I basically want to parse that into a [VM], but my problem is those numbered fields. Depending on the VM config, it might or might not have virtioX fields, ideX fields .. and I don't see a way to know in advance, nor to guess the numbers. I was thinking the best might be to define a Disk type that would contain something like Virtio | Sata | IDE and so on for the type, and a Text field for the value, then have each VM have a [Disk] in it's type. Something like this :

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

That would be great, but how do I parse those random fields that I have directly inside the VM json object into a list ?

回答1:

While I don't consider myself a Haskell expert, and even less of an Aeson expert, I think I've found something that works. Take it for what it is.

The following code all makes use of this module declaration and these imports:

{-# 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)

I changed the type declarations slightly:

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)

The most notable difference is that I added diskNumber to the Disk type, so that it can capture both the number after the disk type, as well as the text associated with the disk property.

The other change was that I made all types be instances of Show. This was only to be able to test whether or not my code works.

First, I defined a little helper function that can find the number after a given prefix:

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

Examples:

*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

This enabled me to write a function that finds all the disks in an 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 is a type alias for HashMap Text Value, so this function takes an Object as input, and returns a list of the Disk values that it could find.

This is enough to define an instance of FromJSON for VM:

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

In order to test that this works, I created this JSON string:

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

and used it from main:

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

When executed, it prints the decoded value:

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}]

Notice that the JSON parsed here is simply an array of VM objects. I didn't include the outer container object with the data property, but if you need help with that, I think that ought to be a separate question :)

回答2:

If as you said there are only 9 virtio and 2 ide, one simple and perhaps not so elegent way to do is to use the asum function from Data.Foldable (which is generalised choice from various parsing libraries)

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{..}

I haven't tried the code yet. For further reference, see this link for a comprehensive guide of haskell JSON parsing with the Aeson library.