How to write a generic function that can serialise/deserialize any record from a map-like structure?

Question

I've been struggling with this using every single Generics library available (EOT, SOP, Data/SYB, and GHC.Generics). I have half-written code samples with every library, which either don't compile, or throw runtime errors.

The core question is this:

type FieldName = String
type FieldValue = String
type MapType = [(String, String)] -- can be an actual HashMap as well, but doesn't really matter
data User = User {name :: String, email :: String}
data Post = User {title :: String, body :: String}

gFromMap :: MapType -> Maybe a
gToMap :: a -> MapType

-- the following should work
gFromMap [("name", "Saurabh"), ("email", "redacted@redacted.com")] :: User -- Just (User{..})
gFromMap [("title", "Will this work?"), ("body", "I hope it does!")] :: Post -- Just (Post{..})

gToMap User{name="Saurabh", email="redacted@redacted.com"} -- [("name", "Saurabh"), ("email", "redacted@redacted.com")]
gToMap Post{title="Will this work?", body="I hope it does!"} -- [("title", "Will this work?"), ("body", "I hope it does!)]

Here is my half-written, non-compiling code, using Generics.EOT:

import Generics.Eot
import Data.String.Conv
import Data.Text

newtype HStoreList = HStoreList [(Text, Text)] deriving (Eq, Show, Generic)

lookupHStore :: HStoreList -> Text -> Maybe Text

class FromHStoreList meta eot where
  fromHStoreList :: meta -> HS.HStoreList -> eot

instance FromHStoreList Datatype (Either a Void) where
  fromHStoreList dtype@Datatype{constructors=[Constructor{fields=(Selectors fields)}]} h = Left $ fromHStoreList fields h
  fromHStoreList dtype@Datatype{constructors=[Constructor{fields=(NoSelectors _)}]} h = error $ "Target data type doesn't seem to have any record selectors, which is not supported: " ++ (show dtype)
  fromHStoreList dtype@Datatype{constructors=[Constructor{fields=(NoFields)}]} h = error $ "Target data type doesn't seem to have any fields, which is not supported: " ++ (show dtype)
  fromHStoreList dtype@Datatype{constructors=constr:_} h = error $ "Multiple constructors found, which is not supported: "  ++ (show $ constructors dtype)


instance FromHStoreList [String] () where
  fromHStoreList _ _ = ()

instance (FromHStoreList [String] xs) => FromHStoreList [String] (Maybe Text, xs) where
  fromHStoreList [] h = error "shouldn't happen"
  fromHStoreList (f:fs) h = (HS.lookupHStore h (toS f), fromHStoreList fs h)

This gives the following compilation error:

   185  99 error           error:
     • No instance for (FromHStoreList [String] a)
         arising from a use of ‘fromHStoreList’
     • In the second argument of ‘($)’, namely ‘fromHStoreList fields h’
       In the expression: Left $ fromHStoreList fields h
       In an equation for ‘fromHStoreList’:
           fromHStoreList
             dtype@(Datatype {constructors = [Constructor {fields = (Selectors fields)}]})
             h
             = Left $ fromHStoreList fields h (intero)

Answer 1

Here's a solution with GHC.Generics following the style of the GHC.Generics tutorial

Prerequisites

To start with, we need a few prerequisites. DefaultSignatures, DeriveGeneric, TypeOperators, FlexibleContexts are normal requirements for GHC.Generics. This particular problem uses MultiParamTypeClasses for a trick to figure out which types can be reliably converted to dictionaries, as well as FlexibleInstances (which follows FlexibleContexts around) and TypeSynonymInstances (because I'm lazy and typed String a few places).

{-# LANGUAGE DeriveGeneric, DefaultSignatures, TypeOperators, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, TypeSynonymInstances #-}

import qualified Data.Map as Map
import GHC.Generics

To keep myself sane I added a class for things that can be serialized to strings. For your example we only need to support Strings, but I suspect you will rapidly encounter Bools or Ints.

Any time we're deserializing (which can usually fail) it's nice to keep track of errors, so we have some idea of why it failed.

class Serializable a where
    serialize :: a -> String
    deserialize :: String -> Either String a   

instance Serializable String where
    serialize = id
    deserialize = Right . id

Generic Class

The GMapSerializable k class represents the class of generic representations that can be converted to and from maps. Converting from maps can fail. The extra k parameter denotes the type of key required for serialization/deserialization to work, and the current key is explicitly passes to both methods.

class GMapSerializable k f where
    gFromMap :: k -> Map.Map String String -> Either String (f a)
    gToMap :: k -> f a -> Map.Map String String

Instances will either use a String key if they need to know where to read or write a field or will by polymorphic over all keys.

For convenience we also make a corresponding non-generic class. It uses () for the key to signify that no key data is provided yet.

class MapSerializable a where
    fromMap :: Map.Map String String -> Either String a
    toMap :: a -> Map.Map String String

    default fromMap :: (Generic a, GMapSerializable () (Rep a)) => Map.Map String String -> Either String a
    fromMap map = to <$> gFromMap () map

    default toMap :: (Generic a, GMapSerializable () (Rep a)) => a -> Map.Map String String
    toMap x = gToMap () (from x)

Generic Instances

On to the instances. We'll start with a good one, K1 a, a value of type a held somewhere in the representation. In order to convert a value to or from a dictionary we'll need to know what key it should be stored in or read from. The GMapSerializable String instance requires that it be passed a String key.

instance Serializable a => GMapSerializable String (K1 i a) where
    gFromMap key map = K1 <$> (lookupE key map >>= deserialize)
    gToMap key (K1 x) = Map.singleton key (serialize x)

lookupE :: (Ord k, Show k) => k -> Map.Map k v -> Either String v
lookupE k = maybe (Left $ "Key not found: " ++ show k) (Right) . Map.lookup k

These keys will be provided when we encounter a metadata node for a selector, M1 S and the metadata c contains the selector name. fixProxy is a hack to get a correctly typed proxy for selName out of the Either String error monad. Usually you pass to selName the whole M1 node that you happen to have around (or are building).

instance (Selector c, GMapSerializable String f) => GMapSerializable k (M1 S 
c f) where
    gFromMap _ map = fixProxy $ \proxy -> M1 <$> gFromMap (selName proxy) map
    gToMap _ m@(M1 x) = gToMap (selName m) x

fixProxy :: (a -> f a) -> f a
fixProxy f = f undefined

The remaining metadata nodes, M1 D for datatypes and M1 C for constructors, don't care what kind of keys they deal with.

instance GMapSerializable k f => GMapSerializable k (M1 D c f) where
    gFromMap key map = M1 <$> gFromMap key map
    gToMap key (M1 x) = gToMap key x

instance GMapSerializable k f => GMapSerializable k (M1 C c f) where
    gFromMap key map = M1 <$> gFromMap key map
    gToMap key (M1 x) = gToMap key x

Dictionaries represent products of many values, indexed by keys. We can provide a GMapSerializable instance for products of two values, f :*: g. When converting to a dictionary it converts each part to a dictionary and takes the union of the dictionaries for each part. When converting from a dictionary it builds each part reading from the same dictionary and then combines the parts into the product.

instance (GMapSerializable k f, GMapSerializable k g) => GMapSerializable k (f :*: g) where
    gFromMap key map = (:*:) <$> gFromMap key map <*> gFromMap key map
    gToMap key (a :*: b) = Map.union (gToMap key a) (gToMap key b)

We can also provide an instance for the unit, U1. It doesn't need to read anything from a dictionary - there's only one possible value. It similarly doesn't need to write anything to a dictionary; the empty dictionary suffices.

instance GMapSerializable k U1 where
    gFromMap _ map = return U1
    gToMap _ U1 = Map.empty

We notably won't be providing instances for composition or for sums. Composition would result in nested keys, which a single dictionary can't represent. Sums would require tags for which branch of the sum is taken; again something a single dictionary can't represent.

Example

Your example compiles and runs, with minor differences because I used a Map instead of a list of key-value pairs.

The data types derive Generic instances, and are given MapSerializable instances with the default implementation.

data User = User {name :: String, email :: String}
  deriving (Generic, Show)
instance MapSerializable User

data Post = Post {title :: String, body :: String}
  deriving (Generic, Show)
instance MapSerializable Post

main = do
    print (fromMap . Map.fromList $ [("name", "Saurabh"), ("email", "redacted@redacted.com")] :: Either String User)
    print (fromMap . Map.fromList $ [("title", "Will this work?"), ("body", "I hope it does!")] :: Either String Post)

    print . Map.toList . toMap $ User{name="Saurabh", email="redacted@redacted.com"} -- [("name", "Saurabh"), ("email", "redacted@redacted.com")]
    print . Map.toList . toMap $ Post{title="Will this work?", body="I hope it does!"}

    print (fromMap . Map.fromList $ [("title", "Will this work?"), ("not-the-body", "I hope it doesn't!")] :: Either String Post)

Running Example