Associativity of the generic representation of sum types
Bas van Dijk
v.dijk.bas at gmail.com
Thu Sep 22 12:55:53 CEST 2011
Hi José,
I have another related question: (Excuse me for the big email, I had
trouble making it smaller)
I discovered a bug in my code that converts a product into a JSON
value. I would like to convert products without field selectors into
Arrays (type Array = Vector Value) and products with field selectors
(records) into Objects (type Object = Map Text Value). Currently my
code makes the wrong assumption that product types are build in a
right associative way so that I can simply do this:
---------------------------------------------------------------------
-- Products without field selectors:
instance (GToJSON a, Flatten b) => GToJSON (S1 NoSelector a :*: b) where
gToJSON = toJSON . flatten
-- Other products, so products with field selectors (records):
instance (GObject a, GObject b) => GToJSON (a :*: b) where
gToJSON = Object . gObject
---------------------------------------------------------------------
Note that flatten converts the product into a list of Values:
---------------------------------------------------------------------
class Flatten f where
flatten :: f a -> [Value]
instance (GToJSON a, Flatten b) => Flatten (S1 NoSelector a :*: b) where
flatten (m1 :*: r) = gToJSON m1 : flatten r
instance (GToJSON a) => Flatten (S1 NoSelector a) where
flatten m1 = [gToJSON $ unM1 m1]
---------------------------------------------------------------------
and gObject convert the product into an Object:
---------------------------------------------------------------------
class GObject f where
gObject :: f a -> Object
instance (GObject a, GObject b) => GObject (a :*: b) where
gObject (a :*: b) = gObject a `M.union` gObject b
instance (Selector s, GToJSON a) => GObject (S1 s a) where
gObject = M.singleton (pack (selName m1)) (gToJSON (unM1 m1))
---------------------------------------------------------------------
The problem of course is that products have a tree-shape (as in: (a
:*: b) :*: (c :*: d)) which causes the wrong instance to be selected.
I tried to solve it in the following way:
There's only one GToJSON instance for products:
---------------------------------------------------------------------
instance (ToValue (ProdRes (a :*: b)), GProductToJSON a, GProductToJSON b)
=> GToJSON (a :*: b) where
gToJSON = toValue . gProductToJSON
---------------------------------------------------------------------
It uses the overloaded helper function gProductToJSON which converts a
product into a ProdRes. A ProdRes is an associated type family which
for products without field selectors equals a difference list of
Values and for records equals an Object:
---------------------------------------------------------------------
class GProductToJSON f where
type ProdRes f :: *
gProductToJSON :: f a -> ProdRes f
instance GToJSON a => GProductToJSON (S1 NoSelector a) where
type ProdRes (S1 NoSelector a) = DList Value
gProductToJSON = singleton . gToJSON
instance (Selector s, GToJSON a) => GProductToJSON (S1 s a) where
type ProdRes (S1 s a) = Object
gProductToJSON m1 = M.singleton (pack (selName m1)) (gToJSON (unM1 m1))
---------------------------------------------------------------------
The gProductToJSON for products recursively converts the left and
right branches to a ProdRes and unifies them using 'union':
---------------------------------------------------------------------
instance (GProductToJSON a, GProductToJSON b, ProdRes a ~ ProdRes b)
=> GProductToJSON (a :*: b) where
type ProdRes (a :*: b) = ProdRes a -- or b
gProductToJSON (a :*: b) = gProductToJSON a `union` gProductToJSON b
class Union r where
union :: r -> r -> r
instance Union (DList Value) where
union = append
instance Union Object where
union = M.union
---------------------------------------------------------------------
Finally, the overloaded toValue turns the ProdRes into a JSON value.
---------------------------------------------------------------------
class ToValue r where
toValue :: r -> Value
instance ToValue (DList Value) where toValue = toJSON . toList
instance ToValue Object where toValue = Object
---------------------------------------------------------------------
Difference lists are simply:
---------------------------------------------------------------------
type DList a = [a] -> [a]
toList :: DList a -> [a]
toList = ($ [])
singleton :: a -> DList a
singleton = (:)
append :: DList a -> DList a -> DList a
append = (.)
---------------------------------------------------------------------
The problem with this code is that I get the following error:
Conflicting family instance declarations:
type ProdRes (S1 NoSelector a)
type ProdRes (S1 s a)
I was under the impression that GHC would be able to resolve this
simply by choosing the most specific type (just as it does with type
classes). Unfortunately it doesn't.
So I'm a bit stuck now. How would you solve it?
What would make all this much easier is if the meta-information of
constructors had a flag which indicated if it was a record or not.
Could this be added?
Regards,
Bas
More information about the Glasgow-haskell-users
mailing list