| Copyright | (C) 2015-2017 Ryan Scott |
|---|---|
| License | BSD-style (see the file LICENSE) |
| Maintainer | Ryan Scott |
| Safe Haskell | None |
| Language | Haskell2010 |
Language.Haskell.TH.Lift.Generics
Contents
- Friendly GHC.Generics-based
liftimplementations - Less friendly and unfriendly GHC.Generics-based
lift GenericclassesLiftreexport
Description
GHC.Generics-based approach to implementing lift. Different sets of
functions are available for use with different GHC and template-haskell
versions.
General recommendations
- If you only need to support GHC 8.0 (
base4.9.0) and later, then you may either use the "friendly" functions here or skip this package entirely and use the built-inDeriveLiftmechanism, which has the advantage of working for GADTs and existential types. - If you only need to support GHC 7.4 (
base4.5) and later, and you haveTypeableinstances for the relevant type constructors (or can derive them), then you should use the "friendly" functions here. If you must support GHC versions before 7.4 (
base4.5), or types in other packages withoutTypeableinstances, then you should seriously consider using the th-lift package to deriveLiftinstances. If you choose to continue with this package:- If you have
Typeableinstances, then you should use the "less friendly" functions here. These take an argument for the package name, but they ignore it (acting just like the friendly ones) for GHC 7.4 (base4.5) and later. - If you lack a
Typeableinstance for a type constructor, then you'll need to use the "unfriendly" functions. These rely solely on the user-provided package name. On GHC 7.10, it is extremely difficult to obtain the correct package name for an external package.
- If you have
A note on Typeable constraints
For relevant versions, the "friendly" and "less friendly" functions require
the type to satisfy an OuterTypeable constraint. A type is OuterTypable if
its type constructor (applied to any kind arguments) is Typeable. For
example, is only Maybe aTypeable if a is Typeable, but it is always
OuterTypeable. For to be Const a bOuterTypeable,
the kinds of a and b must be Typeable.
Before GHC 7.8, Typeable can only be derived for types with seven
or fewer parameters, all of kind *. Types with more parameters that
manually instantiate the now-defunct Typeable7 class should work,
but there may be some loss of polymorphism in the first arguments.
Types whose Typeable instances can't be derived because of kind issues
will not work with these GHC versions.
Synopsis
- genericLift :: (Quote m, Generic a, GLift (Rep a)) => a -> m Exp
- genericLiftTyped :: (Quote m, Generic a, GLift (Rep a)) => a -> Code m a
- genericLiftTypedTExp :: (Quote m, Generic a, GLift (Rep a)) => a -> m (TExp a)
- genericLiftTypedCompat :: (Quote m, Generic a, GLift (Rep a)) => a -> Splice m a
- genericLiftWithPkgFallback :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> m Exp
- genericLiftTypedWithPkgFallback :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> Code m a
- genericLiftTypedTExpWithPkgFallback :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> m (TExp a)
- genericLiftTypedCompatWithPkgFallback :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> Splice m a
- genericLiftWithPkg :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> m Exp
- genericLiftTypedWithPkg :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> Code m a
- genericLiftTypedTExpWithPkg :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> m (TExp a)
- genericLiftTypedCompatWithPkg :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> Splice m a
- class GLift f where
- class GLiftDatatype f where
- class GLiftArgs f where
- class Lift (t :: TYPE r) where
Friendly GHC.Generics-based lift implementations
The functions in this section are nice and simple, but are only available on
GHC 7.4.1 (base 4.5) and later due to API limitations of earlier GHC
versions. The types of these functions depend slightly on the GHC version.
In particular, before GHC 8.0 (base 4.9), these functions have
Typeable constraints in addition to Generic
ones.
These functions do all of the work for you:
{-# LANGUAGE DeriveGeneric #-}
module Foo where
import GHC.Generics
import Language.Haskell.Lift.Generics
data Foo = Foo Int Char String
deriving Generic
instance Lift Foo where
lift = genericLift
#if MIN_VERSION_template_haskell(2,9,0)
liftTyped = genericLiftTypedCompat
#endif
Now you can splice Foo values directly into Haskell source code:
{-# LANGUAGE TemplateHaskell #-}
module Bar where
import Foo
import Language.Haskell.TH.Syntax
foo :: Foo
foo = $(lift (Foo 1 'a' "baz"))
genericLiftTyped :: (Quote m, Generic a, GLift (Rep a)) => a -> Code m a Source #
Like genericLift, but returns a Code instead of an Exp.
genericLiftTypedTExp :: (Quote m, Generic a, GLift (Rep a)) => a -> m (TExp a) Source #
Like genericLift, but returns a TExp instead of an Exp.
genericLiftTypedCompat :: (Quote m, Generic a, GLift (Rep a)) => a -> Splice m a Source #
Lift genericLift, but returns:
- A
Code(if usingtemplate-haskell-2.17.0.0or later), or - A
TExp(if using an older version oftemplate-haskell)
This function is ideal for implementing the liftTyped method of Lift
directly, as its type changed in template-haskell-2.17.0.0.
Less friendly and unfriendly GHC.Generics-based lift
API limitations of early versions of GHC (7.2 and earlier) require the user
to produce the package name themselves. This is also occasionally necessary
for later versions of GHC when dealing with types from other packages that
lack Typeable instances. The package name isn't always as easy to come
up with as it sounds, especially because GHC 7.10 uses a hashed package ID
for that name. To make things worse, if you produce the wrong package name,
you might get bizarre compilation errors!
There's no need to fear, though—in most cases it's possible to obtain the
correct package name anyway, at least for types defined in the current package.
When compiling a library with Cabal, the current package
name is obtained using the CPP macro CURRENT_PACKAGE_KEY. When compiling
an application, or compiling without Cabal, it takes a bit more work to get
the name. The code sample below shows an example of how to
properly use genericLiftWithPkgFallback or genericLiftWithPkg without
shooting yourself in the foot:
{-# LANGUAGE CPP, DeriveGeneric, DeriveDataTypeable #-}
-- part of package foobar
module Foo where
import GHC.Generics
import Data.Typeable
import Language.Haskell.Lift.Generics
#ifndef CURRENT_PACKAGE_KEY
import Data.Version (showVersion)
import Paths_foobar (version)
#endif
pkgName :: String
#ifdef CURRENT_PACKAGE_KEY
pkgName = CURRENT_PACKAGE_KEY
#else
pkgName = "foobar-" ++ showVersion version
#endif
data Foo = Foo Int Char String
deriving (Generic, Typeable)
instance Lift Foo where
lift = genericLiftWithPkgFallback pkgName
#if MIN_VERSION_template_haskell(2,9,0)
liftTyped = genericLiftTypedCompatWithPkgFallback pkgName
#endif
As you can see, this trick only works if (1) the current package key is known
(i.e., the Lift instance is defined in the same package as the datatype), or
(2) you're dealing with a package that has a fixed package name (e.g., base,
ghc-prim, template-haskell, etc.).
Once the Lift Foo instance is defined, you can splice Foo values directly
into Haskell source code:
{-# LANGUAGE TemplateHaskell #-}
module Bar where
import Foo
import Language.Haskell.TH.Syntax
foo :: Foo
foo = $(lift (Foo 1 'a' "baz"))
Less friendly implementations
These implementations should be used when support for versions
before GHC 7.4 (base 4.5) is required, but a Typeable
instance is available. The Typeable instance will be used
to get the package name for GHC 7.4 and later.
genericLiftTypedWithPkgFallback :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> Code m a Source #
Like genericLiftWithPkgFallback, but returns a Code instead of an Exp.
Since: 0.2.1
genericLiftTypedTExpWithPkgFallback :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> m (TExp a) Source #
Like genericLiftWithPkgFallback, but returns a TExp instead of an Exp.
Since: 0.2.1
genericLiftTypedCompatWithPkgFallback :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> Splice m a Source #
Like genericLiftWithPkg, but returns:
- A
Code(if usingtemplate-haskell-2.17.0.0or later), or - A
TExp(if using an older version oftemplate-haskell)
This function is ideal for implementing the liftTyped method of Lift
directly, as its type changed in template-haskell-2.17.0.0.
Since: 0.2.1
Unfriendly implementations
These implementations should be used when support for versions
before GHC 8.0 (base 4.9) is required and a Typeable instance
is not available. These functions are termed "unfriendly" because
they're extremely hard to use under GHC 7.10 when working with types
defined in other packages. The only way to do so is to use a Typeable
type in the same package to get the "package name", which will be a
hash value.
genericLiftWithPkg :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> m Exp Source #
Generically produce an implementation of lift, given a user-provided
(but correct!) package name. The provided package name is ignored for
GHC 8.0 (base 4.9) and later.
genericLiftTypedWithPkg :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> Code m a Source #
Like genericLiftWithPkg, but returns a Code instead of an Exp.
genericLiftTypedTExpWithPkg :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> m (TExp a) Source #
Like genericLiftWithPkg, but returns a TExp instead of an Exp.
genericLiftTypedCompatWithPkg :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> Splice m a Source #
Like genericLiftWithPkg, but returns:
- A
Code(if usingtemplate-haskell-2.17.0.0or later), or - A
TExp(if using an older version oftemplate-haskell)
This function is ideal for implementing the liftTyped method of Lift
directly, as its type changed in template-haskell-2.17.0.0.
Generic classes
You shouldn't need to use any of these classes directly; they are only exported for educational purposes.
Class of generic representation types which can be converted to Template Haskell expressions.
Methods
class GLiftDatatype f where Source #
Class of generic representation types which can be converted to Template Haskell expressions, given a package and module name.
Methods
Instances
| GLiftDatatype (V1 :: Type -> Type) Source # | |
| (GLiftDatatype f, GLiftDatatype g) => GLiftDatatype (f :+: g) Source # | |
| (Constructor c, GLiftArgs f) => GLiftDatatype (C1 c f) Source # | |
class GLiftArgs f where Source #
Class of generic representation types which can conceptually be converted to a list of Template Haskell expressions (which represent a constructors' arguments).
Methods
gliftArgs :: Quote m => f a -> Exp -> m Exp Source #
gliftArgs e f applies f to the zero or more arguments represented
by e.
Instances
| GLiftArgs (U1 :: Type -> Type) Source # | |
| GLiftArgs (UAddr :: Type -> Type) Source # | |
| GLiftArgs (UChar :: Type -> Type) Source # | |
| GLiftArgs (UDouble :: Type -> Type) Source # | |
| GLiftArgs (UFloat :: Type -> Type) Source # | |
| GLiftArgs (UInt :: Type -> Type) Source # | |
| GLiftArgs (UWord :: Type -> Type) Source # | |
| Lift c => GLiftArgs (K1 i c :: Type -> Type) Source # | |
| (GLiftArgs f, GLiftArgs g) => GLiftArgs (f :*: g) Source # | |
| GLiftArgs f => GLiftArgs (S1 s f) Source # | |
Lift reexport
class Lift (t :: TYPE r) where #
A Lift instance can have any of its values turned into a Template
Haskell expression. This is needed when a value used within a Template
Haskell quotation is bound outside the Oxford brackets ([| ... |] or
[|| ... ||]) but not at the top level. As an example:
add1 :: Int -> Q (TExp Int) add1 x = [|| x + 1 ||]
Template Haskell has no way of knowing what value x will take on at
splice-time, so it requires the type of x to be an instance of Lift.
A Lift instance must satisfy $(lift x) ≡ x and $$(liftTyped x) ≡ x
for all x, where $(...) and $$(...) are Template Haskell splices.
It is additionally expected that .lift x ≡ unTypeQ (liftTyped x)
Lift instances can be derived automatically by use of the -XDeriveLift
GHC language extension:
{-# LANGUAGE DeriveLift #-}
module Foo where
import Language.Haskell.TH.Syntax
data Bar a = Bar1 a (Bar a) | Bar2 String
deriving LiftLevity-polymorphic since template-haskell-2.16.0.0.
Minimal complete definition
Methods
Turn a value into a Template Haskell expression, suitable for use in a splice.
liftTyped :: t -> Q (TExp t) #
Turn a value into a Template Haskell typed expression, suitable for use in a typed splice.
Since: template-haskell-2.16.0.0
Instances
| Lift Bool | |
| Lift Char | |
| Lift Double | |
| Lift Float | |
| Lift Int | |
| Lift Int8 | |
| Lift Int16 | |
| Lift Int32 | |
| Lift Int64 | |
| Lift Integer | |
| Lift Natural | |
| Lift Word | |
| Lift Word8 | |
| Lift Word16 | |
| Lift Word32 | |
| Lift Word64 | |
| Lift () | |
| Lift Void | Since: template-haskell-2.15.0.0 |
| Lift Int# | Since: template-haskell-2.16.0.0 |
| Lift Char# | Since: template-haskell-2.16.0.0 |
| Lift Word# | Since: template-haskell-2.16.0.0 |
| Lift Addr# | Produces an Since: template-haskell-2.16.0.0 |
| Lift Float# | Since: template-haskell-2.16.0.0 |
| Lift Double# | Since: template-haskell-2.16.0.0 |
| Lift a => Lift ([a] :: Type) | |
| Lift a => Lift (Maybe a :: Type) | |
| Integral a => Lift (Ratio a :: Type) | |
| Lift a => Lift (NonEmpty a :: Type) | Since: template-haskell-2.15.0.0 |
| (Lift a, Lift b) => Lift (Either a b :: Type) | |
| (Lift a, Lift b) => Lift ((a, b) :: Type) | |
| (Lift a, Lift b, Lift c) => Lift ((a, b, c) :: Type) | |
| (Lift a, Lift b, Lift c, Lift d) => Lift ((a, b, c, d) :: Type) | |
| (Lift a, Lift b, Lift c, Lift d, Lift e) => Lift ((a, b, c, d, e) :: Type) | |
| (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f) => Lift ((a, b, c, d, e, f) :: Type) | |
| (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g) => Lift ((a, b, c, d, e, f, g) :: Type) | |
| Lift (# #) | Since: template-haskell-2.16.0.0 |
| Lift a => Lift ((# a #) :: TYPE ('TupleRep '['LiftedRep])) | Since: template-haskell-2.16.0.0 |
| (Lift a, Lift b) => Lift ((# a, b #) :: TYPE ('TupleRep '['LiftedRep, 'LiftedRep])) | Since: template-haskell-2.16.0.0 |
| (Lift a, Lift b) => Lift ((# a | b #) :: TYPE ('SumRep '['LiftedRep, 'LiftedRep])) | Since: template-haskell-2.16.0.0 |
| (Lift a, Lift b, Lift c) => Lift ((# a, b, c #) :: TYPE ('TupleRep '['LiftedRep, 'LiftedRep, 'LiftedRep])) | Since: template-haskell-2.16.0.0 |
| (Lift a, Lift b, Lift c) => Lift ((# a | b | c #) :: TYPE ('SumRep '['LiftedRep, 'LiftedRep, 'LiftedRep])) | Since: template-haskell-2.16.0.0 |
| (Lift a, Lift b, Lift c, Lift d) => Lift ((# a, b, c, d #) :: TYPE ('TupleRep '['LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep])) | Since: template-haskell-2.16.0.0 |
| (Lift a, Lift b, Lift c, Lift d) => Lift ((# a | b | c | d #) :: TYPE ('SumRep '['LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep])) | Since: template-haskell-2.16.0.0 |
| (Lift a, Lift b, Lift c, Lift d, Lift e) => Lift ((# a, b, c, d, e #) :: TYPE ('TupleRep '['LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep])) | Since: template-haskell-2.16.0.0 |
| (Lift a, Lift b, Lift c, Lift d, Lift e) => Lift ((# a | b | c | d | e #) :: TYPE ('SumRep '['LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep])) | Since: template-haskell-2.16.0.0 |
| (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f) => Lift ((# a, b, c, d, e, f #) :: TYPE ('TupleRep '['LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep])) | Since: template-haskell-2.16.0.0 |
| (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f) => Lift ((# a | b | c | d | e | f #) :: TYPE ('SumRep '['LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep])) | Since: template-haskell-2.16.0.0 |
| (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g) => Lift ((# a, b, c, d, e, f, g #) :: TYPE ('TupleRep '['LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep])) | Since: template-haskell-2.16.0.0 |
| (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g) => Lift ((# a | b | c | d | e | f | g #) :: TYPE ('SumRep '['LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep, 'LiftedRep])) | Since: template-haskell-2.16.0.0 |