使用通用解码解析所有nullary构造函数的数据类型

Question

我有以下代码：

{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}

import Data.Aeson
import GHC.Generics

data CharClass = Fighter | Rogue | Wizard deriving (Generic, Show)

instance FromJSON CharClass
instance ToJSON CharClass

我可以编码这种类型的值：

*Main> encode Fighter
"\"Fighter\""

但是往返不起作用：

*Main> eitherDecode $ encode Fighter
Left "Failed reading: satisfy"
*Main> :t eitherDecode $ encode Fighter
eitherDecode $ encode Fighter :: FromJSON a => Either String a

它看起来很像这个回答的问题 ，但添加预期的类型不起作用：

*Main> eitherDecode $ encode Fighter :: Either String CharClass 
Left "Failed reading: satisfy"

有趣的是，它确实适用于fromJSON / toJSON ：

*Main> fromJSON $ toJSON Fighter :: Result CharClass
Success Fighter

使至少一个构造函数非nullary也使事情有效，就像我这样做：

data CharClass = Fighter Int | Rogue | Wizard deriving (Generic, Show)

然后尝试再次往返：

*Main> decode $ encode (Fighter 0) :: Maybe CharClass
Just (Fighter 0)

我确定我错过了一些简单的东西，但试图通过通用代码追踪这一点让我头晕目眩。

Answer 1

JSON基本上是键值对的集合，其中值可以是一些基本类型或另一组键值对。 Nullary类型本身并不适合作为JSON实体的整体想法。 但是，当它们放置在与JSON概念很好地融合的其他类型中时，它们可以正常工作。

data F = F { a :: CharClass, b :: CharClass }
    deriving (Generic, Show)

instance FromJSON F
instance ToJSON F

这看起来更像是JSON设计的键值集合。

*Main> let x = F Fighter Rogue
*Main> x
F {a = Fighter, b = Rogue}
*Main> decode $ encode x :: Maybe F
Just (F {a = Fighter, b = Rogue})

Answer 2

安装在我的机器上的stack的aeson版本来自0.8系列，在aeson 0.8或更早版本中， 只有对象和数组在根级别进行了解析 。

Answer 3

在aeson 0.9中， decode使用value解析器。 因此，顶级的可空对象（表示为字符串）将起作用。

对于0.8，以下示例有效。 我不知道为什么decodeWith没有曝光。

{-# LANGUAGE DeriveGeneric #-}

import Control.Applicative
import GHC.Generics
import Data.Aeson
import Data.Aeson.Parser
import Data.ByteString.Lazy as L
import Data.Attoparsec.ByteString.Char8 (endOfInput, skipSpace)
import qualified Data.Attoparsec.Lazy as L

data CharClass = Fighter | Rogue | Wizard deriving (Generic, Show)

instance ToJSON CharClass
instance FromJSON CharClass

decodeWith p to s =
    case L.parse p s of
      L.Done _ v -> case to v of
                      Success a -> Just a
                      _         -> Nothing
      _          -> Nothing
{-# INLINE decodeWith #-}

valueEOF = value <* skipSpace <* endOfInput

decodeValue :: (FromJSON a) => L.ByteString -> Maybe a
decodeValue = decodeWith valueEOF fromJSON

main :: IO ()
main = print (decodeValue (encode Fighter) :: Maybe CharClass)