使用通用解码使用所有 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

使至少一个构造函数为非零也可以使事情正常进行，就像我这样做一样：

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或更早的版本中，only objects and arrays were parsed at the root level.

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)

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

Parsing data types with all nullary constructors using generic decode

generics

haskell

aeson