是否可以将变化的JSON键与具有较大记录类型的aeson的求和类型数据构造函数匹配？

问题描述

因此，我具有此数据类型ItemType，该数据类型使用其数据构造函数名称进行解码（请参见FromJSON实例）。

import           Data.Aeson
import           Data.Aeson.Types
import           Data.Char (toLower)
import           GHC.Generics

data ItemType =
    MkLogin Login
  | MkCard Card
  | MkIdentity Identity
  | MkSecureNote Note
  deriving (Generic,Show)

lowercase :: String -> String
lowercase "" = ""
lowercase (s:ss) = toLower s : ss

stripPrefix :: String -> String
stripPrefix ('M':'k':ss) = ss
stripPrefix str = str

-- | Decode value using ItemType data constructor names
instance FromJSON ItemType where
  parseJSON = genericParseJSON defaultOptions
    { constructorTagModifier = lowercase . stripPrefix,sumEncoding = ObjectWithSingleField }

我想做的就是将此类型作为字段添加到名为Item的较大记录类型中

data Item =
  Item { _object :: String,_id :: String,_organizationId :: Maybe Int,_folderId :: Maybe Int,_type :: Int,_name :: String,_notes :: String,_favorite :: Bool,??? :: ItemType -- don't know how to add this without a different field name,_collectionIds :: [Int],_revisionDate :: Maybe String
       } deriving (Generic,Show)

instance FromJSON Item where
  parseJSON =
    genericParseJSON defaultOptions { fieldLabelModifier = stripUnderscore }

但是，我不想为该类型创建新的字段名称。相反，我想使用在ItemType上与aeson匹配的数据构造函数作为字段名称，因为我要建模的JSON对象中的ItemType字段的关键字取决于{{1} } 它是。因此，在这种情况下，密钥为“登录”，“卡”，“身份”，“ secureNote”。也许我应该为ItemType使用TaggedObject，但是我不确定它是如何工作的。

sumEncoding对象的示例JSON列表：https://i.imgur.com/xzHy9MU.png。在这里，您可以通过键“登录”，“卡”，“身份”来查看Item字段，具体取决于它们的类型。

解决方法

您可以使用一个相当丑陋的技巧来预处理传入的JSON Value，以使实际的JSON输入像：

{
  "id": "foo","bool": false
}

就像被解析过一样：

{
  "id": "foo","itemtype": {"bool" : false}
}

可以由通用解析器使用ObjectWithSingleField和编码方法直接处理。

作为简化示例，给出：

data ItemType =
    MkInt Int
  | MkBool Bool
  deriving (Generic,Show)

instance FromJSON ItemType where
  parseJSON = genericParseJSON defaultOptions
    { constructorTagModifier = map toLower . \('M':'k':ss) -> ss,sumEncoding = ObjectWithSingleField }

和：

data Item =
  Item { _id :: String,_itemtype :: ItemType
       }
  deriving (Generic,Show)

您可以为FromJSON编写一个Item实例，该实例将"int"或"bool"字段嵌套在"itemtype"字段内。 （原始字段的副本保留在原处，但被通用解析器忽略。）

instance FromJSON Item where
  parseJSON v = do
    v' <- withObject "Item" nest v
    genericParseJSON defaultOptions { fieldLabelModifier = \('_':ss) -> ss } v'
    where nest o = Object <$> (HM.insert "itemtype" <$> item <*> pure o)
            where item = subObj "int" <|> subObj "bool" <|> fail "no item type field"
                  subObj k = (\v -> object [(k,v)]) <$> o .: k

完整代码：

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

import           Control.Applicative
import           Data.Aeson
import           Data.Aeson.Types
import           Data.Char (toLower)
import           GHC.Generics
import qualified Data.HashMap.Strict as HM

data ItemType =
    MkInt Int
  | MkBool Bool
  deriving (Generic,sumEncoding = ObjectWithSingleField }

data Item =
  Item { _id :: String,Show)

instance FromJSON Item where
  parseJSON v = do
    v' <- withObject "Item" nest v
    genericParseJSON defaultOptions { fieldLabelModifier = \('_':ss) -> ss } v'
    where nest o = Object <$> (HM.insert "itemtype" <$> item <*> pure o)
            where item = subObj "int" <|> subObj "bool" <|> fail "no item type field"
                  subObj k = (\v -> object [(k,v)]) <$> o .: k

test1,test2,test3 :: Either String Item
test1 = eitherDecode "{\"id\":\"foo\",\"bool\":false}"
test2 = eitherDecode "{\"id\":\"foo\",\"int\":10}"
test3 = eitherDecode "{\"id\":\"foo\"}"

main = do
  print test1
  print test2
  print test3

尽管如此，通常来说，除非您经常这样做，否则为了清楚起见和易于阅读，最好放弃泛型并编写必要的样板。即使您的原始示例也不是那么麻烦。是的，您必须保持类型和实例同步，但是几个简单的测试应该可以解决所有问题。因此，例如：

instance FromJSON Item where
  parseJSON = withObject "Item" $ \o ->
    Item <$> o .: "object"
         <*> o .: "id"
         <*> o .:? "organizationId"
         <*> o .:? "folderId"
         <*> o .: "type"
         <*> o .: "name"
         <*> o .: "notes"
         <*> o .: "favorite"
         <*> parseItemType o
         <*> o .: "collectionIds"
         <*> o .:? "revisionDate"
    where parseItemType o =
                MkLogin <$> o .: "login"
            <|> MkCard <$> o .: "card"
            <|> MkIdentity <$> o .: "identity"
            <|> MkSecureNote <$> o .: "securenote"

,

一种方法是在ItemType数据声明中完全没有Item的字段。然后使用元组或自定义对类型来容纳这两块；所以：

data ItemWithType = ItemWithType ItemType Item

instance FromJSON ItemWithType where
    parseJSON v = liftA2 ItemWithType (parseJSON v) (parseJSON v)

您也可以跳过定义ItemWithType并仅使用

\o -> liftA2 (,) (parseJSON o) (parseJSON o)

直接解析名称相同的字段的元组和变量键下的对象。