Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Data.Matchable.TH
Contents
Synopsis
- deriveInstances :: Q [Dec] -> Q [Dec]
- deriveMatchable :: Name -> Q [Dec]
- deriveBimatchable :: Name -> Q [Dec]
- makeZipMatchWith :: Name -> ExpQ
- makeBizipMatchWith :: Name -> ExpQ
- makeLiftEq :: Name -> Q Exp
- makeLiftEq2 :: Name -> Q Exp
derive
functions
deriveInstances :: Q [Dec] -> Q [Dec] Source #
Derive multiple instances of Matchable
, Bimatchable
, or their superclasses,
each written in StandaloneDeriving
syntax.
Passing declarations other than standalone deriving instances is an error.
Also, passing any instances other than Matchable
, Bimatchable
or their superclasses is an error.
Explicitly, it accepts standalone deriving declarations of the following types:
Passing an Eq
or Functor
instance declarations does not cause a compilation error
and generates the same standalone deriving declaration passed in, but also causes
a warning telling you that you can use stock deriving for them.
Example
{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE StandaloneDeriving #-} [-# LANGUAGE TemplateHaskell #-} data Foo a b = Foo a b (Either a b) deriving (Show, Eq, Functor)
To use deriveInstances
for Foo
, write as below:
deriveInstances [d| deriving instance Eq a => Eq1 (Foo a) deriving instance Eq a => Matchable (Foo a) deriving instance Eq2 Foo deriving instance Bifunctor Foo deriving instance Bimatchable Foo |]
deriveMatchable :: Name -> Q [Dec] Source #
Build an instance of Matchable
for a data type.
Note that deriveMatchable
generates the Matchable
instance only. Because Matchable
requires Functor
and Eq1
(and Eq
transitively) as its superclasses, to actually use the generated instance,
it's necessary to provide them too.
Use deriveInstances
to generate both Matchable
and Eq1
instances at once.
Example
data Exp a = Plus a a | Times a a
deriveMatchable
''Exp
will generate the following instance.
instance Matchable Exp where zipMatchWith f (Plus l1 l2) (Plus r1 r2) = pure Plus * f l1 r1 * f l2 r2 zipMatchWith f (Times l1 l2) (Times r1 r2) = pure Times * f l1 r1 * f l2 r2 zipMatchWith _ _ _ = Nothing
deriveBimatchable :: Name -> Q [Dec] Source #
Build an instance of Bimatchable
for a data type.
Note that deriveBimatchable
generates the Bimatchable
instance only. Because Bimatchable
requires Bifunctor
and Eq2
(and Functor
, Eq
, Eq1
transitively) as its superclasses,
to actually use the generated instance, it's necessary to provide them too.
Use deriveInstances
to generate all of these instances at once.
Example
data Sum a b = InL a | InR b
deriveBimatchable
''Sum
will create
instance Bimatchable Sum where bizipMatchWith f _ (InL l1) (InL r1) = pure InL $ f l1 r1 bizipMatchWith _ g (InR l1) (InR r1) = pure InR $ g l1 r1
make-
functions
makeZipMatchWith :: Name -> ExpQ Source #
Generates an expression which behaves like zipMatchWith
for the given data type.
makeBizipMatchWith :: Name -> ExpQ Source #
Generates an expression which behaves like bizipMatchWith
for the given data type.