解析同质多态 json 数组

Parsing a homogenous polymorphic json array

我有一个数据类型,其中一个字段是 一个 n 其他数据类型的列表(n 很小,类型提前知道)。我想制作一个 JSON 解析器,但我不太明白。我已经尝试创建一个 Pet 类型 class 并使它们成为它的两个实例,但这似乎是一个死胡同。如有任何帮助,我们将不胜感激!

作为一个简化示例 - 我有一个 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"

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

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

此外,您可能对使用 GHC 泛型自动派生 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

其中 agerbilamouseRodent 值。

我正在修改@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