如何解决是否可以将变化的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)
直接解析名称相同的字段的元组和变量键下的对象。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。