覆蓋實例行爲

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

我可以看到如何使用它的缺點更改每個幾個選項：

1. 根據我的格式做一個函數序列化Entity，但隨後將不可能序列化List的Entity。我將結束編寫多個函數來將它碰巧屬於的任何結構序列化爲Entity。

2. 爲Entity創建一種新類型，但在序列化之前，我應該將所有Entity轉換爲MyNewEntity。這對我來說很醜陋，會導致不必要的轉換噪音。

總之，我的問題是，我不能改變EntityToJSON實現了，我不能讓耶索德返回的東西比Entity不同。我不得不進行轉換，但什麼是最透明的方式呢？

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