Copyright | (C) 2012-2017 Nicolas Frisby (C) 2015-2017 Ryan Scott |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Ryan Scott |
Portability | Template Haskell |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Functions to mechanically derive Invariant
or Invariant2
instances,
or to splice invmap
or
invmap2
into Haskell source code. You need to enable
the TemplateHaskell
language extension in order to use this module.
Synopsis
- deriveInvariant :: Name -> Q [Dec]
- deriveInvariantOptions :: Options -> Name -> Q [Dec]
- deriveInvariant2 :: Name -> Q [Dec]
- deriveInvariant2Options :: Options -> Name -> Q [Dec]
- makeInvmap :: Name -> Q Exp
- makeInvmapOptions :: Options -> Name -> Q Exp
- makeInvmap2 :: Name -> Q Exp
- makeInvmap2Options :: Options -> Name -> Q Exp
- newtype Options = Options {}
- defaultOptions :: Options
deriveInvariant(2)
deriveInvariant
automatically generates an Invariant
instance declaration for a data type, newtype, or data family instance that has
at least one type variable. This emulates what would (hypothetically) happen
if you could attach a deriving
clause to
the end of a data declaration. Examples:Invariant
{-# LANGUAGE TemplateHaskell #-} import Data.Functor.Invariant.TH data Pair a = Pair a a $(deriveInvariant
''Pair) -- instance Invariant Pair where ... newtype Alt f a = Alt (f a) $(deriveInvariant
''Alt) -- instance Invariant f => Invariant (Alt f) where ...
If you are using template-haskell-2.7.0.0
or later (i.e., GHC 7.4 or later),
deriveInvariant
can also be used to derive Invariant
instances for data family
instances (which requires the -XTypeFamilies
extension). To do so, pass the name of
a data or newtype instance constructor to deriveInvariant
. Note that the generated
code may require the -XFlexibleInstances
extension. Some examples:
{-# LANGUAGE FlexibleInstances, TemplateHaskell, TypeFamilies #-} import Data.Functor.Invariant.TH class AssocClass a b where data AssocData a b instance AssocClass Int b where data AssocData Int b = AssocDataInt1 Int | AssocDataInt2 b Int $(deriveInvariant
'AssocDataInt1) -- instance Invariant (AssocData Int) where ... -- Alternatively, one could use $(deriveInvariant 'AssocDataInt2) data family DataFam a b newtype instance DataFam () b = DataFamB b $(deriveInvariant
'DataFamB) -- instance Invariant (DataFam ())
Note that there are some limitations:
- The
Name
argument toderiveInvariant
must not be a type synonym. - With
deriveInvariant
, the argument's last type variable must be of kind*
. For other ones, type variables of kind* -> *
are assumed to require anInvariant
context. For more complicated scenarios, usemakeInvmap
. - If using the
-XDatatypeContexts
,-XExistentialQuantification
, or-XGADTs
extensions, a constraint cannot mention the last type variable. For example,data Illegal a where I :: Ord a => a -> Illegal a
cannot have a derivedInvariant
instance. - If the last type variable is used within a data field of a constructor, it must only
be used in the last argument of the data type constructor. For example,
data Legal a = Legal (Either Int a)
can have a derivedInvariant
instance, butdata Illegal a = Illegal (Either a a)
cannot. - Data family instances must be able to eta-reduce the last type variable. In other words, if you have a instance of the form:
data family Family a1 ... an t data instance Family e1 ... e2 v = ...
Then the following conditions must hold:
v
must be a type variable.v
must not be mentioned in any ofe1
, ...,e2
.
deriveInvariant :: Name -> Q [Dec] Source #
Generates an Invariant
instance declaration for the given
data type or data family instance.
deriveInvariantOptions :: Options -> Name -> Q [Dec] Source #
Like deriveInvariant
, but takes an Options
argument.
deriveInvariant2
automatically generates an
Invariant2
instance declaration for a data type,
newtype, or data family instance that has at least two type variables. This
emulates what would (hypothetically) happen if you could attach a deriving
clause to the end of a data declaration.
Examples:Invariant2
{-# LANGUAGE TemplateHaskell #-} import Data.Functor.Invariant.TH data OneOrNone a b = OneL a | OneR b | None $(deriveInvariant2
''OneOrNone) -- instance Invariant2 OneOrNone where ... newtype Alt2 f a b = Alt2 (f a b) $(deriveInvariant2
''Alt2) -- instance Invariant2 f => Invariant2 (Alt2 f) where ...
The same restrictions that apply to deriveInvariant
also apply to deriveInvariant2
,
with some caveats:
- With
deriveInvariant2
, the last type variables must both be of kind*
. For other ones, type variables of kind* -> *
are assumed to require anInvariant
constraint, and type variables of kind* -> * -> *
are assumed to require anInvariant2
constraint. For more complicated scenarios, usemakeInvmap2
. - If using the
-XDatatypeContexts
,-XExistentialQuantification
, or-XGADTs
extensions, a constraint cannot mention either of the last two type variables. For example,data Illegal2 a b where I2 :: Ord a => a -> b -> Illegal2 a b
cannot have a derivedInvariant2
instance. - If either of the last two type variables is used within a data field of a constructor,
it must only be used in the last two arguments of the data type constructor. For
example,
data Legal a b = Legal (Int, Int, a, b)
can have a derivedInvariant2
instance, butdata Illegal a b = Illegal (a, b, a, b)
cannot. - Data family instances must be able to eta-reduce the last two type variables. In other words, if you have a instance of the form:
data family Family a1 ... an t1 t2 data instance Family e1 ... e2 v1 v2 = ...
Then the following conditions must hold:
v1
andv2
must be distinct type variables.- Neither
v1
notv2
must be mentioned in any ofe1
, ...,e2
.
deriveInvariant2 :: Name -> Q [Dec] Source #
Generates an Invariant2
instance declaration for
the given data type or data family instance.
deriveInvariant2Options :: Options -> Name -> Q [Dec] Source #
Like deriveInvariant2
, but takes an Options
argument.
makeInvmap(2)
There may be scenarios in which you want to invmap
over an arbitrary data
type or data family instance without having to make the type an instance of
Invariant
. For these cases, this module provides
several functions (all prefixed with make-
) that splice the appropriate
lambda expression into your source code. Example:
This is particularly useful for creating instances for sophisticated data
types. For example, deriveInvariant
cannot infer the correct type context for
newtype HigherKinded f a b c = HigherKinded (f a b c)
, since f
is of kind
* -> * -> * -> *
. However, it is still possible to create an
Invariant
instance for HigherKinded
without too much
trouble using makeInvmap
:
{-# LANGUAGE FlexibleContexts, TemplateHaskell #-} import Data.Functor.Invariant import Data.Functor.Invariant.TH newtype HigherKinded f a b c = HigherKinded (f a b c) instance Invariant (f a b) => Invariant (HigherKinded f a b) where invmap = $(makeInvmap ''HigherKinded)
makeInvmapOptions :: Options -> Name -> Q Exp Source #
Like makeInvmap
, but takes an Options
argument.
makeInvmap2 :: Name -> Q Exp Source #
Generates a lambda expression which behaves like
invmap2
(without requiring an
Invariant2
instance).
makeInvmap2Options :: Options -> Name -> Q Exp Source #
Like makeInvmap2
, but takes an Options
argument.
Options
Options that further configure how the functions in Data.Functor.Invariant.TH should behave.
defaultOptions :: Options Source #
Conservative Options
that doesn't attempt to use EmptyCase
(to
prevent users from having to enable that extension at use sites.)