(Note: support for generic classes is currently broken in GHC 5.02).
The ideas behind this extension are described in detail in "Derivable type classes", Ralf Hinze and Simon Peyton Jones, Haskell Workshop, Montreal Sept 2000, pp94-105. An example will give the idea:
import Generics class Bin a where toBin :: a -> [Int] fromBin :: [Int] -> (a, [Int]) toBin {| Unit |} Unit = [] toBin {| a :+: b |} (Inl x) = 0 : toBin x toBin {| a :+: b |} (Inr y) = 1 : toBin y toBin {| a :*: b |} (x :*: y) = toBin x ++ toBin y fromBin {| Unit |} bs = (Unit, bs) fromBin {| a :+: b |} (0:bs) = (Inl x, bs') where (x,bs') = fromBin bs fromBin {| a :+: b |} (1:bs) = (Inr y, bs') where (y,bs') = fromBin bs fromBin {| a :*: b |} bs = (x :*: y, bs'') where (x,bs' ) = fromBin bs (y,bs'') = fromBin bs' |
This class declaration explains how toBin and fromBin work for arbitrary data types. They do so by giving cases for unit, product, and sum, which are defined thus in the library module Generics:
data Unit = Unit data a :+: b = Inl a | Inr b data a :*: b = a :*: b |
Now you can make a data type into an instance of Bin like this:
instance (Bin a, Bin b) => Bin (a,b) instance Bin a => Bin [a] |
To use generics you need to
Use the flags -fglasgow-exts (to enable the extra syntax), -fgenerics (to generate extra per-data-type code), and -package lang (to make the Generics library available.
Import the module Generics from the lang package. This import brings into scope the data types Unit, :*:, and :+:. (You don't need this import if you don't mention these types explicitly; for example, if you are simply giving instance declarations.)
Note that the type constructors :+: and :*: can be written infix (indeed, you can now use any operator starting in a colon as an infix type constructor). Also note that the type constructors are not exactly as in the paper (Unit instead of 1, etc). Finally, note that the syntax of the type patterns in the class declaration uses "{|" and "|}" brackets; curly braces alone would ambiguous when they appear on right hand sides (an extension we anticipate wanting).
Terminology. A "generic default method" in a class declaration is one that is defined using type patterns as above. A "polymorphic default method" is a default method defined as in Haskell 98. A "generic class declaration" is a class declaration with at least one generic default method.
Restrictions:
Alas, we do not yet implement the stuff about constructor names and field labels.
A generic class can have only one parameter; you can't have a generic multi-parameter class.
A default method must be defined entirely using type patterns, or entirely without. So this is illegal:
class Foo a where op :: a -> (a, Bool) op {| Unit |} Unit = (Unit, True) op x = (x, False) |
The type variable(s) in the type pattern for a generic method declaration scope over the right hand side. So this is legal (note the use of the type variable ``p'' in a type signature on the right hand side:
class Foo a where op :: a -> Bool op {| p :*: q |} (x :*: y) = op (x :: p) ... |
The type patterns in a generic default method must take one of the forms:
a :+: b a :*: b Unit |
class Foo a where op :: a -> Bool op {| a :+: b |} (Inl x) = True op {| p :+: q |} (Inr y) = False |
class Foo a where op1 :: a -> Bool op1 {| a :*: b |} (x :*: y) = True op2 :: a -> Bool op2 {| p :*: q |} (x :*: y) = False |
A generic method declaration must give a case for each of the three type constructors.
The type for a generic method can be built only from:
Function arrows
Type variables
Tuples
Arbitrary types not involving type variables
op1 :: a -> Bool op2 :: Bool -> (a,Bool) op3 :: [Int] -> a -> a op4 :: [a] -> Bool |
This restriction is an implementation restriction: we just havn't got around to implementing the necessary bidirectional maps over arbitrary type constructors. It would be relatively easy to add specific type constructors, such as Maybe and list, to the ones that are allowed.
In an instance declaration for a generic class, the idea is that the compiler will fill in the methods for you, based on the generic templates. However it can only do so if
The instance type is simple (a type constructor applied to type variables, as in Haskell 98).
No constructor of the instance type has unboxed fields.
The option -ddump-deriv dumps incomprehensible stuff giving details of what the compiler does with generic declarations.
Just to finish with, here's another example I rather like:
class Tag a where nCons :: a -> Int nCons {| Unit |} _ = 1 nCons {| a :*: b |} _ = 1 nCons {| a :+: b |} _ = nCons (bot::a) + nCons (bot::b) tag :: a -> Int tag {| Unit |} _ = 1 tag {| a :*: b |} _ = 1 tag {| a :+: b |} (Inl x) = tag x tag {| a :+: b |} (Inr y) = nCons (bot::a) + tag y |