Haskell 重写实例行为

Yesod包含

实体

数据类型，即带有数据库id的模型。Yesod还使

Entity

成为Aeson的

ToJSON

类的实例，因此可以轻松地将其序列化为json。更棒的是，

实体

可以被包装在任何结构中，它也将被序列化。有许多类型支持

ToJSON

协议。它非常方便，我非常喜欢它

不幸的是，Yesod提供的

实体

序列化格式不符合我的需要，我正在寻找一种简单透明的方法来更改它

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

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"}]

我可以看到几个关于如何更改的选项，每个选项都有其缺点：

根据我的格式创建一个函数来序列化

实体

，但是这样就不可能序列化

实体

的

列表

。我将结束编写多个函数来序列化它所属的任何结构中的

实体

为

实体

创建一个新类型，但在序列化之前，我应该将所有

实体

转换为

MyNewEntity

ie。我觉得它很难看，它会导致不必要的转换噪音

---

总而言之，我的问题是我无法将

实体
更改为JSON
实现，并且我无法使YesSOD返回与
实体
不同的内容。我被迫进行转换，但最透明的转换方式是什么呢？
Haskell的类型类很好，因为您知道，您将永远只有一个实例。但有时需要将同一结构序列化为不同的表示形式。这正是你面临的问题

我可以提出下一个解决方案：使用两个参数创建类型类（需要
multiparamtypeclass
extension）。其中一个是要序列化的结构；第二个是选择特定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"}]

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

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

注意：
重载字符串
并非绝对必要
FlexibleInstances
已经在
数据中使用。Aeson
如果您需要多个表示，这绝对是一个好办法。这不完全是我的问题，因为我只需要一个自定义表示。我想出了一个更简单的解决办法，但你的更一般。非常感谢。