Associativity of the generic representation of sum types

[Bas van Dijk]

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