Override instance behaviour

Question

Yesod contains Entity data type, i.e. model with its id from database. Yesod also makes Entity an instance of Aeson's ToJSON class, so it could be easily serialized as json. What is more awesome, Entity could be wrapped in any structure and it will be serialized as well. There are many types supporting ToJSON protocol. It is very handy and I like it a lot.

Unfortunately, serialization format Yesod provides for an Entity doesn't fit my needs, I'm looking for an easy and transparent way to change it.

Here is an example. I have simple model

data Company = Company
  { companyName :: Text
  }

And corresponding Entity would be

Entity CompanyId Company

Now, code to fetch entities from database and return it as json looks like

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 list looks like

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

And I would like it to be

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

I can see several options on how to change it each with its drawbacks:

1. Make a function to serialize Entity according to my format, but then it will be impossible to serialize List of Entityies. I will end writing multiple functions to serialize Entity inside any structure it happens to be part of.

2. Make a newtype for an Entity, but then I should convert all Entityies to MyNewEntityies prior to serializing. It seems ugly to me, it will result in unnecessary conversion noise.

To summarize, my problem is that I can't change Entity ToJSON implementation, and I can't make Yesod to return something different than Entity. I'm forced to make a conversion, but what is a most transparent way to do it?

Answer 1

Haskell's type classes are good when you know, that you'll ever have only one instance. But sometimes you need to serialize the same structure into different representations. That is exactly the issue you have.

I can propose the next solution: Create type class with two parameters (requires MultiParamTypeClasses extension). One of them will be the structure you are going to serialize; the second will be a tag to select specific json format. Example:

{-# 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 ""

The output:

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

That way you need to define one ToJSON' instance per json format for every data type, and one instance per container (in the example I implemented it only for lists)

If you don't like MultiParamTypeClasses, you can pass to toJSON' a function that knows how to serialize your data type.

Note: OverloadedStrings is not strictly necessary. FlexibleInstances is already used inside Data.Aeson