Question

Yesod包含Entity数据类型，即带有来自数据库的id的模型。 Yesod还使Entity成为Aeson ToJSON类的一个实例，因此可以很容易地将其序列化为json。什么更棒，Entity可以包装在任何结构中，它也将被序列化。有许多类型支持ToJSON协议。它非常方便，我非常喜欢它。

不幸的是，序列化格式Yesod规定Entity不符合我的需求，我正在寻找一种简单透明的方法来改变它。

这是一个例子。我有简单的模型

data Company = Company
  { companyName :: Text
  }

相应的实体将是

Entity CompanyId Company

现在，代码从数据库中获取实体并将其作为json返回，如

getCompanyR = do

    -- fetch companies from database
    -- `companies` contains list of `Entity CompanyId Company`
    companies <- runDB $ selectList ([] :: [Filter Company]) []

    -- return it as json
    -- List is also an instance of `ToJSON` so it could be serialized too
    return . toJSON $ companies

序列化列表看起来像

[{"key":"o52553881f14995dade000000","value":{"name":"Pizza World"}}]

我希望它是

[{"id":"o52553881f14995dade000000","name":"Pizza World"}]

我可以看到几个如何改变它的选项，每个选项都有它的缺点：

根据我的格式创建一个序列化Entity的函数，但是不可能序列化List Entity个Entity。我将结束编写多个函数来序列化它恰好属于它的任何结构中的Entity。
为Entity创建一个新类型，但之后我应该在序列化之前将所有MyNewEntity转换为Entity。这对我来说似乎很难看，它会导致不必要的转换噪音。

总结一下，我的问题是我无法更改ToJSON Entity实施，我不能让Yesod返回与{{1}}不同的内容。我被迫进行转换，但是最透明的方式是什么？

Answer 1

Haskell的类型类很好，如果你知道，你将只有一个实例。但有时您需要将相同的结构序列化为不同的表示形式。这正是你的问题。

我可以提出下一个解决方案：使用两个参数创建类型类（需要MultiParamTypeClasses扩展名）。其中一个将是您要序列化的结构;第二个将是一个标签来选择特定的json格式。例如：

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

import Data.Aeson
import qualified Data.Vector as Vector
import Data.Text (Text)
import qualified Data.ByteString.Lazy as BSL

-- our custom variant on ToJSON
class ToJSON' tag a where
  toJSON' :: tag -> a -> Value

-- instance for lists, requires FlexibleInstances
instance ToJSON' tag a => ToJSON' tag [a] where
  toJSON' tag l = Array $ Vector.fromList $ map (toJSON' tag) l

-- our data type
data Test = Test {
  testString :: Text,
  testBool :: Bool
  }

-- the tag for the first json format
data TestToJSON1 = TestToJSON1

-- the first json format definition
instance ToJSON' TestToJSON1 Test where
  toJSON' _ test = object [
    "string1" .= String (testString test),
    "bool1" .= Bool (testBool test)
    ]

-- the tag for the second json format
data TestToJSON2 = TestToJSON2

-- the second json format definition
instance ToJSON' TestToJSON2 Test where
  toJSON' _ test = object [
    "string2" .= String (testString test),
    "bool2" .= Bool (testBool test)
    ]

-- usage example
main :: IO ()
main = do
  let test = Test {
    testString = "hello",
    testBool = False
    }
  BSL.putStr $ encode $ toJSON' TestToJSON1 test
  putStrLn ""
  BSL.putStr $ encode $ toJSON' TestToJSON1 [test, test]
  putStrLn ""
  BSL.putStr $ encode $ toJSON' TestToJSON2 test
  putStrLn ""
  BSL.putStr $ encode $ toJSON' TestToJSON2 [test, test]
  putStrLn ""

输出：

{"string1":"hello","bool1":false}
[{"string1":"hello","bool1":false},{"string1":"hello","bool1":false}]
{"bool2":false,"string2":"hello"}
[{"bool2":false,"string2":"hello"},{"bool2":false,"string2":"hello"}]

这样你需要为每种数据类型为每个json格式定义一个ToJSON'实例，并为每个容器定义一个实例（在我只为列表实现它的示例中）

如果您不喜欢MultiParamTypeClasses，则可以向toJSON'传递一个知道如何序列化数据类型的函数。

注意：OverloadedStrings并非绝对必要。已在FlexibleInstances

中使用Data.Aeson

覆盖实例行为

1 个答案: