Generics - create a product of records that combine all the fields

Question

At work, I use generics to easily derive instances for Data.Aeson.ToJSON and Database.Selda.SqlRow for my API and database types. It's very useful, but I often wish I could compose types.

As a simple example, perhaps a user wants to create a new account. They provide the basic information, which doesn't include a database id. But I need to send it back to them with an id.

data AccountInfo = AccountInfo
    { firstName :: Text
    , lastName :: Text
    } deriving (Show, Eq, Generic)

data Account = Account
    { accountId :: Id Account
    , firstName :: Text
    , lastName :: Text
    } deriving (Show, Eq, Generic)

I can't simply nest AccountInfo inside of Account, because I want the Aeson instance to be flat (all fields at the top level), and Selda requires it to be flat to store it in the database.

-- This won't work because the Aeson and Selda outputs aren't flat
data Account = Account
    { accountId :: Id Account
    , info :: AccountInfo
    } deriving (Show, Eq, Generic)

I'd like to create a product type that lets me combine two types, but flattens the fields.

data Aggregate a b = Aggregate a b

data AccountId = AccountId
    { accountId :: Id Account
    } deriving (Show, Eq, Generic)

type Account = Aggregate AccountId AccountInfo

I know how to manually write a ToJSON and FromJSON instance for such a type, but I have no idea how to write a SQLRow instance.

Instead, as an exercise to learn generics, I'd like to write a Generic instance for Aggregate where Aggregate AccountId AccountInfo has the exact same representation as the first definition of Account, above (with all three fields flattened)

How can I do this? I've been reading about generics for a day, and I'm fairly stuck.

trevor cook trevor cook · Accepted Answer · 2019-01-11T20:42:43

With generics, the user defines a data type which will inherit some operation (e.g. toJSON) based on the operation defined over its generically derivered structure. It doesn't create new types based on old. If you are looking for Genrics to create new types based on old, you will be frustrated.

More pointedly, the statement "I'd like to write a Generic instance for Aggregate" doesn't make sense. We make Generic representations instances of classes (class ToJSON), not data structures. And the generic JSON instances are already written...

Luckily, a good solution may be easy. You just need instead a way work with collections of JSON objects. Below I demonstrate how to combine two data types that have JSON.Object representations. Since a JSON.Object is just a hashmap, which can be combined via union, I just convert my haskell values to objects and perform a union. There is room for improvement, but this is the idea.

import qualified Data.Aeson as JSON
import qualified Data.Aeson.Types as JSON
import GHC.Generics
import qualified Data.HashMap.Lazy as HashMap

data A = A { fieldA :: String } deriving (Show,Eq,Generic)
data B = B { fieldB :: String } deriving (Show,Eq,Generic)

instance ToJSON A
instance ToJSON B
instance FromJSON A
instance FromJSON B

toObj :: ToJSON a => a -> Maybe JSON.Object
toObj = JSON.parseMaybe parseJSON . toJSON

toJSONAB :: A -> B -> Maybe JSON.Value
toJSONAB a b = do
   aObj <- toObj a
   bObj <- toObj b
   return . JSON.Value $ HashMap.union aObj bObj

At this point, you would call toJSONAB instead of toJSON when you need to output JSON. Retrieving either an A or B from the output is included. That is,

(toJSONAB a b >>= JSON.parseMaybe parseJSON) :: Maybe <Desired Type>

will parse either an A or a B, depending on the type signature supplied (deduced).

The above is the core of what you want. You can make functions like this for whatever data combinations you like. What's missing is the creation of new types like below:

data AB = AB A B

which lend type safety to your code. Afterall, you are interested in specific types, not an ad-hoc collection of JSON representations of types. To do this via Generics, I suggest a new class such as below (untested and incomplete),

class ToFlatJSON a where
  toFlatJSON :: a -> JSON.Value
  default toFlatJSON :: (Generic a, GToFlatJSON (Rep a)) => a -> JSON.Value
  toFlatJSON = gToFlatJSON . from

class GToFlatJSON a where
  gToFlatJSON :: a p -> JSON.Value

and provide GToFlatJSON instances for any necessary Generic representations found in GHC.Generics.

instance (ToJSON a) => GToFlatJSON (K1 i a) where
  gToFlatJSON (K1 a) = toJSON a

instance (GToFlatJSON a) => GToFlatJSON (a :*: a') where
  gToFlatJSON (a :*: a') = cmb (gToFlatJSON a) (toFlatJSON a')
    where
      cmb = someFunctionLike_toJSONAB

instance (GToFlatJSON a) => GToFlatJSON (M1 t i a) where
  gToFlatJSON (M1 _ _ a) = gToFlatJSON a
    where
      cmb = someFunctionLike_toJSONAB

Then, you will be able to define blank ToFlatJSON instances like you do with ToJSON

instance ToFlatJSON a

and use toFlatJSON instead of toJSON. You could define toJSON in terms toFlatJSON. For each data type, then, you would need:

instance ToFlatJSON AB 
instance ToFlatJSON AB => ToJSON AB where
  toJSON = toFlatJSON

So, in summary, you can easily make your combination type by working with the JSON representations themselves, i.e. a union of their object representations. You can recover your original types directly using their fromJSON. There's no way to overload the To/FromJSON generic instances, but you could make a new similar class and its generic instances. I personally recommend for this application to stay away from the generics. I think custom To/FromJSON for your data types would be the most direct method.

Generics - create a product of records that combine all the fields

1 Answers