使用通用解碼解析所有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)