Question

我有一种数据类型，其中一个字段是一个 n个其他数据类型的列表（n很小，且类型事先已知）。我想制作一个JSON解析器，但我无法弄明白。我已经尝试创建一个Pet类类并使它们成为它的实例，但它似乎是一个死胡同。任何帮助将不胜感激！

作为一个简单的例子 - 我有一个Person数据类型，可以有宠物列表，狗或猫 - 但不是两者兼而有之。

以下是示例：

{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Data.Aeson
import Data.ByteString.Lazy as L
import Data.Aeson.Types (Parser)
import Control.Monad (mzero)

data Person = Person {
  name :: String,
  species :: String,
  pets :: [?] -- a list of dogs OR cats
} deriving Show

instance FromJSON (Person a) where
  parseJSON (Object v) = ???

data Dog = Dog {
  dogField :: String
} deriving Show

 instance FromJSON Dog where
  parseJSON (Object v) = Dog <$>
    v .: "dogField"

data Cat = Cat {
  catField :: String
} deriving Show

instance FromJSON Cat where
  parseJSON (Object v) = Cat <$>
    v .: "catField"

Answer 1

表示一种或另一种类型的标准方法是使用Either类型，例如：

data Person { ..., pets :: Either [Dog] [Cat] }

此外，您可能有兴趣使用GHC Generics自动派生To / FromJSON实例。

使用Either的数据结构的示例：

{-# LANGUAGE DeriveGeneric #-}

import Data.Aeson
import GHC.Generics

data Person = Person {
  name :: String,
  species :: String,
  pets :: Either [String] [Int]
} deriving (Show,Generic)

instance ToJSON Person    -- instances are auto-derived    
instance FromJSON Person

doit = do
  let me = Person "user5402" "Human" (Right [42])
  print $ encode me

如果您有两个以上的选择，您可以轻松创建自己的总和类型：

-- assume the possible pet types are: Dog, Cat, Rodent, Reptile
data Pets = Dogs [Dog] | Cats [Cat] | Rodents [Rodent] | Reptiles [Reptile]
  deriving (Show, Generic)

data Person { ..., pets :: Pets }
  deriving (Show, Generic)

doit = do
  let me = Person "user5402" "Human" (Rodents [agerbil, amouse])
  print $ encode me

其中agerbil和amouse为Rodent值。

Answer 2

我正在修改@ user5402的答案，因为我不喜欢Generics添加的“tag”和“contents”字段。也接受了他的答案，因为他给了我关于如何构造总和类型的关键见解

instance FromJSON Pets where
  parseJSON (Object o) = (parsePets o "pets")
  parseJSON _ = mzero

parsePets :: Object -> T.Text -> Parser Pets
parsePets o key = case H.lookup key o of
               Nothing -> fail $ "key " ++ show key ++ " not present"
               Just v  -> parseToCatsOrDogs (o .: "species") v
{-# INLINE parsePets #-}

parseToCatsOrDogs :: Parser String -> Value -> Parser Pets
parseToCatsOrDogs speciesParser (Array v) = speciesParser >>= \species -> case species of
  "dog" -> (V.mapM (\x -> parseJSON $ x) v) >>= \ dogVector -> return $ Dogs (V.toList dogVector)
  "cat" -> (V.mapM (\x -> parseJSON $ x) v) >>= \ catVector -> return $ Cats (V.toList catVector)
  _ -> mzero
parseToCatsOrDogs _ _ = mzero

解析同构的多态json数组

2 个答案: