[Haskell-cafe] Helper classes for Generics

Reiner Pope reiner.pope at gmail.com
Mon Mar 12 04:27:06 CET 2012


Hi all,

I've been playing with GHC's new generics features (see http://www.haskell.org/ghc/docs/latest/html/users_guide/generic-programming.html). All the documentation I've seen suggests creating a "helper class" -- for instance, the GSerialize class in the above link -- on which one defines generic instances. 

It seems to me that this isn't necessary. For example, here's the the example from the GHC docs, but without a helper class:

> -- set the phantom type of Rep to (), to avoid ambiguity
> from0 :: Generic a => a -> Rep a ()
> from0 = from
> 
> data Bit = O | I
> 
> class Serialize a where
>   put :: a -> [Bit]
> 
>   default put :: (Generic a, Serialize (Rep a ())) => a -> [Bit]
>   put = put . from0
> 
> instance Serialize (U1 x) where
>   put U1 = []
> 
> instance (Serialize (a x), Serialize (b x)) => Serialize ((a :*: b) x) where
>   put (x :*: y) = put x ++ put y
> 
> instance (Serialize (a x), Serialize (b x)) => Serialize ((a :+: b) x) where
>   put (L1 x) = O : put x
>   put (R1 x) = I : put x
> 
> instance (Serialize (a x)) => Serialize (M1 i c a x) where
>   put (M1 x) = put x
> 
> instance (Serialize a) => Serialize (K1 i a x) where
>   put (K1 x) = put x

Is there a reason to prefer using helper classes? Or perhaps we should update the wiki page (http://www.haskell.org/haskellwiki/Generics) to avoid using helper classes?

Regards,
Reiner
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120312/31023434/attachment.htm>


More information about the Haskell-Cafe mailing list