generic-deriving-1.10.7: Generic programming library for generalised deriving.

Copyright(c) 2008--2009 Universiteit Utrecht
LicenseBSD3
Maintainergenerics@haskell.org
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell98

Generics.Deriving.TH

Contents

Description

This module contains Template Haskell code that can be used to automatically generate the boilerplate code for the generic deriving library.

To use these functions, pass the name of a data type as an argument:

{-# LANGUAGE TemplateHaskell #-}

data Example a = Example Int Char a
$(deriveAll0     ''Example) -- Derives Generic instance
$(deriveAll1     ''Example) -- Derives Generic1 instance
$(deriveAll0And1 ''Example) -- Derives Generic and Generic1 instances

On GHC 7.4 or later, this code can also be used with data families. To derive for a data family instance, pass the name of one of the instance's constructors:

{-# LANGUAGE FlexibleInstances, TemplateHaskell, TypeFamilies #-}

data family Family a b
newtype instance Family Char x = FamilyChar Char
data    instance Family Bool x = FamilyTrue | FamilyFalse

$(deriveAll0 'FamilyChar) -- instance Generic (Family Char b) where ...
$(deriveAll1 'FamilyTrue) -- instance Generic1 (Family Bool) where ...
-- Alternatively, one could type $(deriveAll1 'FamilyFalse)

Synopsis

Documentation

deriveMeta :: Name -> Q [Dec] Source #

Given the type and the name (as string) for the type to derive, generate the Data instance, the Constructor instances, and the Selector instances.

On GHC 7.11 and up, this functionality is no longer used in GHC generics, so this function generates no declarations.

deriveData :: Name -> Q [Dec] Source #

Given a datatype name, derive a datatype and instance of class Datatype.

On GHC 7.11 and up, this functionality is no longer used in GHC generics, so this function generates no declarations.

deriveConstructors :: Name -> Q [Dec] Source #

Given a datatype name, derive datatypes and instances of class Constructor.

On GHC 7.11 and up, this functionality is no longer used in GHC generics, so this function generates no declarations.

deriveSelectors :: Name -> Q [Dec] Source #

Given a datatype name, derive datatypes and instances of class Selector.

On GHC 7.11 and up, this functionality is no longer used in GHC generics, so this function generates no declarations.

deriveAll :: Name -> Q [Dec] Source #

A backwards-compatible synonym for deriveAll0.

deriveAll0 :: Name -> Q [Dec] Source #

Given the type and the name (as string) for the type to derive, generate the Data instance, the Constructor instances, the Selector instances, and the Representable0 instance.

deriveAll1 :: Name -> Q [Dec] Source #

Given the type and the name (as string) for the type to derive, generate the Data instance, the Constructor instances, the Selector instances, and the Representable1 instance.

deriveAll0And1 :: Name -> Q [Dec] Source #

Given the type and the name (as string) for the type to derive, generate the Data instance, the Constructor instances, the Selector instances, the Representable0 instance, and the Representable1 instance.

deriveRepresentable0 :: Name -> Q [Dec] Source #

Given the type and the name (as string) for the Representable0 type synonym to derive, generate the Representable0 instance.

deriveRepresentable1 :: Name -> Q [Dec] Source #

Given the type and the name (as string) for the Representable1 type synonym to derive, generate the Representable1 instance.

deriveRep0 :: Name -> Q [Dec] Source #

Derive only the Rep0 type synonym. Not needed if deriveRepresentable0 is used.

deriveRep1 :: Name -> Q [Dec] Source #

Derive only the Rep1 type synonym. Not needed if deriveRepresentable1 is used.

simplInstance :: Name -> Name -> Name -> Name -> Q [Dec] Source #

Given the names of a generic class, a type to instantiate, a function in the class and the default implementation, generates the code for a basic generic instance.

-WithSigs functions

By default, deriveRep0, deriveRep1, and functions that invoke it generate type synonyms whose type variable binders do not have explicit kind binders for polykinded type variables. This is a pretty reasonable default, since puts less of a burden on the Template Haskell machinery to get the kinds just right, and lets the kind inferencer do more work. However, there are times when you want to have explicit kind signatures, such as if you have a datatype that uses -XTypeInType. For example:

data Prox (a :: k) (b :: *) = Prox k
$(deriveRep0WithKindSigs ''Prox)

will result in something like:

type Rep0Prox (a :: k) (b :: *) = Rec0 k

Whereas if you had used deriveRep0, you would have something like:

type Rep0Prox a (b :: *) = Rec0 k

which will fail to compile, since k is out-of-scope!

deriveAll0WithKindSigs :: Name -> Q [Dec] Source #

Like deriveAll0, except that the type variable binders in the Rep type synonym will have explicit kind signatures.

deriveAll1WithKindSigs :: Name -> Q [Dec] Source #

Like deriveAll1, except that the type variable binders in the Rep1 type synonym will have explicit kind signatures.

deriveAll0And1WithKindSigs :: Name -> Q [Dec] Source #

Like deriveAll0And1, except that the type variable binders in the Rep and Rep1 type synonyms will have explicit kind signatures.

deriveRepresentable0WithKindSigs :: Name -> Q [Dec] Source #

Like deriveRepresentable0, except that the type variable binders in the Rep type synonym will have explicit kind signatures.

deriveRepresentable1WithKindSigs :: Name -> Q [Dec] Source #

Like deriveRepresentable1, except that the type variable binders in the Rep1 type synonym will have explicit kind signatures.

deriveRep0WithKindSigs :: Name -> Q [Dec] Source #

Like deriveRep0, except that the type variable binders in the Rep type synonym will have explicit kind signatures.

deriveRep1WithKindSigs :: Name -> Q [Dec] Source #

Like deriveRep1, except that the type variable binders in the Rep1 type synonym will have explicit kind signatures.

make- functions

There are some data types for which the Template Haskell deriver functions in this module are not sophisticated enough to infer the correct Generic or Generic1 instances. As an example, consider this data type:

data Fix f a = Fix (f (Fix f a))

A proper Generic1 instance would look like this:

instance Functor f => Generic1 (Fix f) where ...

Unfortunately, deriveRepresentable1 cannot infer the Functor f constraint. One can still define a Generic1 instance for Fix, however, by using the functions in this module that are prefixed with make-. For example:

$(deriveMeta ''Fix)
$(deriveRep1 ''Fix)
instance Functor f => Generic1 (Fix f) where
  type Rep1 (Fix f) = $(makeRep1FromType ''Fix [t| Fix f |])
  from1 = $(makeFrom1 ''Fix)
  to1   = $(makeTo1   ''Fix)

Note that due to the lack of type-level lambdas in Haskell, one must manually apply makeRep1FromType ''Fix to the type Fix f.

Be aware that there is a bug on GHC 7.0, 7.2, and 7.4 which might prevent you from using makeRep0FromType and makeRep1FromType. In the Fix example above, you would experience the following error:

    Kinded thing f used as a type
    In the Template Haskell quotation [t| Fix f |]

Then a workaround is to use makeRep1 instead, which requires you to pass as arguments the type variables that occur in the instance, in order from left to right, excluding duplicates. (Normally, makeRep1FromType would figure this out for you.) Using the above example:

$(deriveMeta ''Fix)
$(deriveRep1 ''Fix)
instance Functor f => Generic1 (Fix f) where
  type Rep1 (Fix f) = $(makeRep1 ''Fix) f
  from1 = $(makeFrom1 ''Fix)
  to1   = $(makeTo1   ''Fix)

On GHC 7.4, you might encounter more complicated examples involving data families. For instance:

data family Fix a b c d
newtype instance Fix b (f c) (g b) a = Fix (f (Fix b (f c) (g b) a))

$(deriveMeta ''Fix)
$(deriveRep1 ''Fix)
instance Functor f => Generic1 (Fix b (f c) (g b)) where
  type Rep1 (Fix b (f c) (g b)) = $(makeRep1 'Fix) b f c g
  from1 = $(makeFrom1 'Fix)
  to1   = $(makeTo1   'Fix)

Note that you don't pass b twice, only once.

makeRep0 :: Name -> Q Type Source #

Generates the Rep type synonym constructor (as opposed to deriveRep0, which generates the type synonym declaration). After splicing it into Haskell source, it expects types as arguments. For example:

type Rep (Foo a b) = $(makeRep0 ''Foo) a b

makeRep0FromType :: Name -> Q Type -> Q Type Source #

Generates the Rep type synonym constructor (as opposed to deriveRep0, which generates the type synonym declaration) applied to its type arguments. Unlike makeRep0, this also takes a quoted Type as an argument, e.g.,

type Rep (Foo a b) = $(makeRep0FromType ''Foo [t| Foo a b |])

makeFrom :: Name -> Q Exp Source #

A backwards-compatible synonym for makeFrom0.

makeFrom0 :: Name -> Q Exp Source #

Generates a lambda expression which behaves like from.

makeTo :: Name -> Q Exp Source #

A backwards-compatible synonym for makeTo0.

makeTo0 :: Name -> Q Exp Source #

Generates a lambda expression which behaves like to.

makeRep1 :: Name -> Q Type Source #

Generates the Rep1 type synonym constructor (as opposed to deriveRep1, which generates the type synonym declaration). After splicing it into Haskell source, it expects types as arguments. For example:

type Rep1 (Foo a b) = $(makeRep1 ''Foo) a b

makeRep1FromType :: Name -> Q Type -> Q Type Source #

Generates the Rep1 type synonym constructor (as opposed to deriveRep1, which generates the type synonym declaration) applied to its type arguments. Unlike makeRep1, this also takes a quoted Type as an argument, e.g.,

type Rep1 (Foo a b) = $(makeRep1FromType ''Foo [t| Foo a b |])

makeFrom1 :: Name -> Q Exp Source #

Generates a lambda expression which behaves like from1.

makeTo1 :: Name -> Q Exp Source #

Generates a lambda expression which behaves like to1.