th-utilities-0.2.4.0: Collection of useful functions for use with Template Haskell
Safe HaskellNone
LanguageHaskell2010

TH.ReifySimple

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

reifyType :: Name -> Q TypeInfo Source #

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) Source #

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

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

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

infoToTypeNoDataKinds :: Info -> Maybe TypeInfo Source #

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 Source #

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

Constructors

DataType 

Fields

Instances

Instances details
Eq DataType Source # 
Instance details

Defined in TH.ReifySimple

Methods

(==) :: DataType -> DataType -> Bool

(/=) :: DataType -> DataType -> Bool

Data DataType Source # 
Instance details

Defined in TH.ReifySimple

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 -> DataType0

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 :: forall r r'. (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 Source # 
Instance details

Defined in TH.ReifySimple

Methods

compare :: DataType -> DataType -> Ordering

(<) :: DataType -> DataType -> Bool

(<=) :: DataType -> DataType -> Bool

(>) :: DataType -> DataType -> Bool

(>=) :: DataType -> DataType -> Bool

max :: DataType -> DataType -> DataType

min :: DataType -> DataType -> DataType

Show DataType Source # 
Instance details

Defined in TH.ReifySimple

Methods

showsPrec :: Int -> DataType -> ShowS

show :: DataType -> String

showList :: [DataType] -> ShowS

Generic DataType Source # 
Instance details

Defined in TH.ReifySimple

Associated Types

type Rep DataType :: Type -> Type

Methods

from :: DataType -> Rep DataType x

to :: Rep DataType x -> DataType

type Rep DataType Source # 
Instance details

Defined in TH.ReifySimple

type Rep DataType = D1 ('MetaData "DataType" "TH.ReifySimple" "th-utilities-0.2.4.0-JLztyn5PyLgGEB3zgsxvs0" 'False) (C1 ('MetaCons "DataType" 'PrefixI 'True) ((S1 ('MetaSel ('Just "dtName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Just "dtTvs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Name])) :*: (S1 ('MetaSel ('Just "dtCxt") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Cxt) :*: S1 ('MetaSel ('Just "dtCons") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [DataCon]))))

reifyDataType :: Name -> Q DataType Source #

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

infoToDataType :: Info -> Maybe DataType Source #

Data constructor info

data DataCon Source #

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

Instances details
Eq DataCon Source # 
Instance details

Defined in TH.ReifySimple

Methods

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

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

Data DataCon Source # 
Instance details

Defined in TH.ReifySimple

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 :: forall r r'. (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 Source # 
Instance details

Defined in TH.ReifySimple

Methods

compare :: DataCon -> DataCon -> Ordering

(<) :: DataCon -> DataCon -> Bool

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

(>) :: DataCon -> DataCon -> Bool

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

max :: DataCon -> DataCon -> DataCon

min :: DataCon -> DataCon -> DataCon

Show DataCon Source # 
Instance details

Defined in TH.ReifySimple

Methods

showsPrec :: Int -> DataCon -> ShowS

show :: DataCon -> String

showList :: [DataCon] -> ShowS

Generic DataCon Source # 
Instance details

Defined in TH.ReifySimple

Associated Types

type Rep DataCon :: Type -> Type

Methods

from :: DataCon -> Rep DataCon x

to :: Rep DataCon x -> DataCon

type Rep DataCon Source # 
Instance details

Defined in TH.ReifySimple

type Rep DataCon = D1 ('MetaData "DataCon" "TH.ReifySimple" "th-utilities-0.2.4.0-JLztyn5PyLgGEB3zgsxvs0" 'False) (C1 ('MetaCons "DataCon" 'PrefixI 'True) ((S1 ('MetaSel ('Just "dcName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Just "dcTvs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Name])) :*: (S1 ('MetaSel ('Just "dcCxt") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Cxt) :*: S1 ('MetaSel ('Just "dcFields") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [(Maybe Name, Type)]))))

reifyDataCon :: Name -> Q DataCon Source #

Reify the given data constructor.

infoToDataCon :: Info -> Maybe DataCon Source #

typeToDataCon :: Name -> Type -> DataCon Source #

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 Source #

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

Constructors

DataFamily 

Fields

Instances

Instances details
Eq DataFamily Source # 
Instance details

Defined in TH.ReifySimple

Methods

(==) :: DataFamily -> DataFamily -> Bool

(/=) :: DataFamily -> DataFamily -> Bool

Data DataFamily Source # 
Instance details

Defined in TH.ReifySimple

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 :: forall r r'. (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 Source # 
Instance details

Defined in TH.ReifySimple

Show DataFamily Source # 
Instance details

Defined in TH.ReifySimple

Methods

showsPrec :: Int -> DataFamily -> ShowS

show :: DataFamily -> String

showList :: [DataFamily] -> ShowS

Generic DataFamily Source # 
Instance details

Defined in TH.ReifySimple

Associated Types

type Rep DataFamily :: Type -> Type

Methods

from :: DataFamily -> Rep DataFamily x

to :: Rep DataFamily x -> DataFamily

type Rep DataFamily Source # 
Instance details

Defined in TH.ReifySimple

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

data DataInst Source #

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

Constructors

DataInst 

Fields

Instances

Instances details
Eq DataInst Source # 
Instance details

Defined in TH.ReifySimple

Methods

(==) :: DataInst -> DataInst -> Bool

(/=) :: DataInst -> DataInst -> Bool

Data DataInst Source # 
Instance details

Defined in TH.ReifySimple

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 :: forall r r'. (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 Source # 
Instance details

Defined in TH.ReifySimple

Methods

compare :: DataInst -> DataInst -> Ordering

(<) :: DataInst -> DataInst -> Bool

(<=) :: DataInst -> DataInst -> Bool

(>) :: DataInst -> DataInst -> Bool

(>=) :: DataInst -> DataInst -> Bool

max :: DataInst -> DataInst -> DataInst

min :: DataInst -> DataInst -> DataInst

Show DataInst Source # 
Instance details

Defined in TH.ReifySimple

Methods

showsPrec :: Int -> DataInst -> ShowS

show :: DataInst -> String

showList :: [DataInst] -> ShowS

Generic DataInst Source # 
Instance details

Defined in TH.ReifySimple

Associated Types

type Rep DataInst :: Type -> Type

Methods

from :: DataInst -> Rep DataInst x

to :: Rep DataInst x -> DataInst

type Rep DataInst Source # 
Instance details

Defined in TH.ReifySimple

type Rep DataInst = D1 ('MetaData "DataInst" "TH.ReifySimple" "th-utilities-0.2.4.0-JLztyn5PyLgGEB3zgsxvs0" 'False) (C1 ('MetaCons "DataInst" 'PrefixI 'True) ((S1 ('MetaSel ('Just "diName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Just "diCxt") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Cxt)) :*: (S1 ('MetaSel ('Just "diParams") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Type]) :*: S1 ('MetaSel ('Just "diCons") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [DataCon]))))

reifyDataFamily :: Name -> Q DataFamily Source #

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

Type family info

data TypeFamily Source #

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

Constructors

TypeFamily 

Fields

Instances

Instances details
Eq TypeFamily Source # 
Instance details

Defined in TH.ReifySimple

Methods

(==) :: TypeFamily -> TypeFamily -> Bool

(/=) :: TypeFamily -> TypeFamily -> Bool

Data TypeFamily Source # 
Instance details

Defined in TH.ReifySimple

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 :: forall r r'. (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 Source # 
Instance details

Defined in TH.ReifySimple

Show TypeFamily Source # 
Instance details

Defined in TH.ReifySimple

Methods

showsPrec :: Int -> TypeFamily -> ShowS

show :: TypeFamily -> String

showList :: [TypeFamily] -> ShowS

Generic TypeFamily Source # 
Instance details

Defined in TH.ReifySimple

Associated Types

type Rep TypeFamily :: Type -> Type

Methods

from :: TypeFamily -> Rep TypeFamily x

to :: Rep TypeFamily x -> TypeFamily

type Rep TypeFamily Source # 
Instance details

Defined in TH.ReifySimple

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

data TypeInst Source #

Simplified info about a type family instance. Omits nothing.

Constructors

TypeInst 

Fields

Instances

Instances details
Eq TypeInst Source # 
Instance details

Defined in TH.ReifySimple

Methods

(==) :: TypeInst -> TypeInst -> Bool

(/=) :: TypeInst -> TypeInst -> Bool

Data TypeInst Source # 
Instance details

Defined in TH.ReifySimple

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 :: forall r r'. (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 Source # 
Instance details

Defined in TH.ReifySimple

Methods

compare :: TypeInst -> TypeInst -> Ordering

(<) :: TypeInst -> TypeInst -> Bool

(<=) :: TypeInst -> TypeInst -> Bool

(>) :: TypeInst -> TypeInst -> Bool

(>=) :: TypeInst -> TypeInst -> Bool

max :: TypeInst -> TypeInst -> TypeInst

min :: TypeInst -> TypeInst -> TypeInst

Show TypeInst Source # 
Instance details

Defined in TH.ReifySimple

Methods

showsPrec :: Int -> TypeInst -> ShowS

show :: TypeInst -> String

showList :: [TypeInst] -> ShowS

Generic TypeInst Source # 
Instance details

Defined in TH.ReifySimple

Associated Types

type Rep TypeInst :: Type -> Type

Methods

from :: TypeInst -> Rep TypeInst x

to :: Rep TypeInst x -> TypeInst

type Rep TypeInst Source # 
Instance details

Defined in TH.ReifySimple

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

reifyTypeFamily :: Name -> Q TypeFamily Source #

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

Other utilities

conToDataCons :: Con -> [DataCon] Source #

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 Source #

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