th-utilities-0.2.0.1: Collection of useful functions for use with Template Haskell

Safe HaskellNone
LanguageHaskell2010

TH.ReifySimple

Contents

Description

Utilities for reifying simplified datatype info. It omits details that aren't usually relevant to generating instances that work with the datatype. This makes it easier to use TH to derive instances.

The "Simple" in the module name refers to the simplicity of the datatypes, not the module itself, which exports quite a few things which are useful in some circumstance or another. I anticipate that the most common uses of this will be the following APIs:

  • Getting info about a data or newtype declaration, via DataType, reifyDataType, and DataCon. This is useful for writing something which generates declarations based on a datatype, one of the most common uses of Template Haskell.
  • Getting nicely structured info about a named type. See TypeInfo and reifyType. This does not yet support reifying typeclasses, primitive type constructors, or type variables (TyVarI).

Currently, this module supports reifying simplified versions of the following Info constructors:

In the future it will hopefully also have support for the remaining Info constructors, ClassI, ClassOpI, PrimTyConI, VarI, and TyVarI.

Synopsis

Reifying simplified type info

data TypeInfo #

reifyType :: Name -> Q TypeInfo #

Reifies a Name as a TypeInfo, and calls fail if this doesn't work. Use reify with infoToType if you want to handle the failure case more gracefully.

This does not yet support reifying typeclasses, primitive type constructors, or type variables (TyVarI).

infoToType :: Info -> Q (Maybe TypeInfo) #

Convert an Info into a TypeInfo if possible, and otherwise yield Nothing. Needs to run in Q so that

reifyTypeNoDataKinds :: Name -> Q (Maybe TypeInfo) #

Reifies type info, but instead of yielding a LiftedDataConInfo, will instead yield Nothing.

infoToTypeNoDataKinds :: Info -> Maybe TypeInfo #

Convert an 'Info into a TypeInfo if possible. If it's a data constructor, instead of yielding LiftedDataConInfo, it will instead yield Nothing.

Reifying simplified info for specific declaration varieties

Datatype info

data DataType #

Simplified info about a DataD. Omits deriving, strictness, kind info, and whether it's data or newtype.

Constructors

DataType 

Fields

Instances

Eq DataType # 
Data DataType # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> DataType -> c DataType #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c DataType #

toConstr :: DataType -> Constr #

dataTypeOf :: DataType -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c DataType) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataType) #

gmapT :: (forall b. Data b => b -> b) -> DataType -> DataType #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DataType -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DataType -> r #

gmapQ :: (forall d. Data d => d -> u) -> DataType -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> DataType -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> DataType -> m DataType #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> DataType -> m DataType #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> DataType -> m DataType #

Ord DataType # 
Show DataType # 
Generic DataType # 

Associated Types

type Rep DataType :: * -> * #

Methods

from :: DataType -> Rep DataType x #

to :: Rep DataType x -> DataType #

type Rep DataType # 

reifyDataType :: Name -> Q DataType #

Reify the given data or newtype declaration, and yields its DataType representation.

Data constructor info

data DataCon #

Simplified info about a Con. Omits deriving, strictness, and kind info. This is much nicer than consuming Con directly, because it unifies all the constructors into one.

Constructors

DataCon 

Fields

Instances

Eq DataCon # 

Methods

(==) :: DataCon -> DataCon -> Bool #

(/=) :: DataCon -> DataCon -> Bool #

Data DataCon # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> DataCon -> c DataCon #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c DataCon #

toConstr :: DataCon -> Constr #

dataTypeOf :: DataCon -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c DataCon) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataCon) #

gmapT :: (forall b. Data b => b -> b) -> DataCon -> DataCon #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DataCon -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DataCon -> r #

gmapQ :: (forall d. Data d => d -> u) -> DataCon -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> DataCon -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> DataCon -> m DataCon #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> DataCon -> m DataCon #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> DataCon -> m DataCon #

Ord DataCon # 
Show DataCon # 
Generic DataCon # 

Associated Types

type Rep DataCon :: * -> * #

Methods

from :: DataCon -> Rep DataCon x #

to :: Rep DataCon x -> DataCon #

type Rep DataCon # 

reifyDataCon :: Name -> Q DataCon #

Reify the given data constructor.

typeToDataCon :: Name -> Type -> DataCon #

Creates a DataCon given the Name and Type of a data-constructor. Note that the result the function type is *not* checked to match the provided Name.

Data family info

data DataFamily #

Simplified info about a data family. Omits deriving, strictness, and kind info.

Constructors

DataFamily 

Fields

Instances

Eq DataFamily # 
Data DataFamily # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> DataFamily -> c DataFamily #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c DataFamily #

toConstr :: DataFamily -> Constr #

dataTypeOf :: DataFamily -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c DataFamily) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataFamily) #

gmapT :: (forall b. Data b => b -> b) -> DataFamily -> DataFamily #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DataFamily -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DataFamily -> r #

gmapQ :: (forall d. Data d => d -> u) -> DataFamily -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> DataFamily -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> DataFamily -> m DataFamily #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> DataFamily -> m DataFamily #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> DataFamily -> m DataFamily #

Ord DataFamily # 
Show DataFamily # 
Generic DataFamily # 

Associated Types

type Rep DataFamily :: * -> * #

type Rep DataFamily # 
type Rep DataFamily = D1 (MetaData "DataFamily" "TH.ReifySimple" "th-utilities-0.2.0.1-4DGv9CGkbDC6AUbo7gIKYW" False) (C1 (MetaCons "DataFamily" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "dfName") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Name)) ((:*:) (S1 (MetaSel (Just Symbol "dfTvs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Name])) (S1 (MetaSel (Just Symbol "dfInsts") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [DataInst])))))

data DataInst #

Simplified info about a data family instance. Omits deriving, strictness, and kind info.

Constructors

DataInst 

Fields

Instances

Eq DataInst # 
Data DataInst # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> DataInst -> c DataInst #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c DataInst #

toConstr :: DataInst -> Constr #

dataTypeOf :: DataInst -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c DataInst) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataInst) #

gmapT :: (forall b. Data b => b -> b) -> DataInst -> DataInst #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DataInst -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DataInst -> r #

gmapQ :: (forall d. Data d => d -> u) -> DataInst -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> DataInst -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> DataInst -> m DataInst #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> DataInst -> m DataInst #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> DataInst -> m DataInst #

Ord DataInst # 
Show DataInst # 
Generic DataInst # 

Associated Types

type Rep DataInst :: * -> * #

Methods

from :: DataInst -> Rep DataInst x #

to :: Rep DataInst x -> DataInst #

type Rep DataInst # 

reifyDataFamily :: Name -> Q DataFamily #

Reify the given data family, and yield its DataFamily representation.

Type family info

data TypeFamily #

Simplified info about a type family. Omits kind info and injectivity info.

Constructors

TypeFamily 

Fields

Instances

Eq TypeFamily # 
Data TypeFamily # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> TypeFamily -> c TypeFamily #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c TypeFamily #

toConstr :: TypeFamily -> Constr #

dataTypeOf :: TypeFamily -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c TypeFamily) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeFamily) #

gmapT :: (forall b. Data b => b -> b) -> TypeFamily -> TypeFamily #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TypeFamily -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TypeFamily -> r #

gmapQ :: (forall d. Data d => d -> u) -> TypeFamily -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> TypeFamily -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> TypeFamily -> m TypeFamily #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> TypeFamily -> m TypeFamily #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> TypeFamily -> m TypeFamily #

Ord TypeFamily # 
Show TypeFamily # 
Generic TypeFamily # 

Associated Types

type Rep TypeFamily :: * -> * #

type Rep TypeFamily # 
type Rep TypeFamily = D1 (MetaData "TypeFamily" "TH.ReifySimple" "th-utilities-0.2.0.1-4DGv9CGkbDC6AUbo7gIKYW" False) (C1 (MetaCons "TypeFamily" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "tfName") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Name)) ((:*:) (S1 (MetaSel (Just Symbol "tfTvs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Name])) (S1 (MetaSel (Just Symbol "tfInsts") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [TypeInst])))))

data TypeInst #

Simplified info about a type family instance. Omits nothing.

Constructors

TypeInst 

Fields

Instances

Eq TypeInst # 
Data TypeInst # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> TypeInst -> c TypeInst #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c TypeInst #

toConstr :: TypeInst -> Constr #

dataTypeOf :: TypeInst -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c TypeInst) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeInst) #

gmapT :: (forall b. Data b => b -> b) -> TypeInst -> TypeInst #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TypeInst -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TypeInst -> r #

gmapQ :: (forall d. Data d => d -> u) -> TypeInst -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> TypeInst -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> TypeInst -> m TypeInst #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> TypeInst -> m TypeInst #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> TypeInst -> m TypeInst #

Ord TypeInst # 
Show TypeInst # 
Generic TypeInst # 

Associated Types

type Rep TypeInst :: * -> * #

Methods

from :: TypeInst -> Rep TypeInst x #

to :: Rep TypeInst x -> TypeInst #

type Rep TypeInst # 
type Rep TypeInst = D1 (MetaData "TypeInst" "TH.ReifySimple" "th-utilities-0.2.0.1-4DGv9CGkbDC6AUbo7gIKYW" False) (C1 (MetaCons "TypeInst" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "tiName") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Name)) ((:*:) (S1 (MetaSel (Just Symbol "tiParams") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Type])) (S1 (MetaSel (Just Symbol "tiType") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Type)))))

reifyTypeFamily :: Name -> Q TypeFamily #

Reify the given type family instance declaration, and yields its TypeInst representation.

Other utilities

conToDataCons :: Con -> [DataCon] #

Convert a Con to a list of DataCon. The result is a list because GadtC and RecGadtC can define multiple constructors.

reifyDataTypeSubstituted :: Type -> Q DataType #

Like reifyDataType, but takes a Type instead of just the Name of the datatype. It expects a normal datatype argument (see typeToNamedCon).