Переопределение поведения экземпляра

Question

Yesod содержит Entity тип данных, то есть модель с ее идентификатором из базы данных. Yesod также делает Entity экземпляром класса Aeson ToJSON, поэтому его можно легко сериализовать как json. Что более удивительно, Entity может быть обернуто в любую структуру, и оно также будет сериализовано. Существует много типов, поддерживающих протокол ToJSON. Это очень удобно, и мне это очень нравится.

К сожалению, формат сериализации Yesod обеспечивает для Entity не соответствует моим потребностям, я ищу простой и прозрачный способ его изменения.

Вот пример. У меня есть простая модель

data Company = Company 
    { companyName :: Text 
    } 

И соответствующая Entity будет

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 

Serialized список выглядит

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

И я хотел бы, чтобы это было

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

Я вижу несколько вариантов, как изменить его каждый со своими недостатками:

1. Сделать функцию упорядочивания Entity по моему формату, но потом будет невозможно сериализовать List из Entity. Я закончу писать несколько функций для сериализации Entity внутри любой структуры, частью которой она является.

2. Сделать NewType для 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"}] 

Таким образом, вы должны определить один ToJSON' экземпляр каждого формата JSON для каждого типа данных, и один экземпляр за контейнер (в данном примере я реализовал это только для списки)

Если вам не нравится MultiParamTypeClasses, вы можете перейти к toJSON' функции, которая знает, как сериализовать ваш тип данных.

Примечание: OverloadedStrings не является обязательным требованием. FlexibleInstances уже используется внутри Data.Aeson