th-abstraction-0.1.0.0: Nicer interface to reified information about data types

CopyrightEric Mertens 2017
LicenseISC
Maintaineremertens@gmail.com
Safe HaskellNone
LanguageHaskell2010

Language.Haskell.TH.Datatype

Contents

Description

This module provides a flattened view of information about data types and newtypes that can be supported uniformly across multiple verisons of the template-haskell package.

Sample output for reifyDatatype ''Maybe

DatatypeInfo
 { datatypeContext = []
 , datatypeName = GHC.Base.Maybe
 , datatypeVars = [ VarT a_3530822107858468866 ]
 , datatypeVariant = Datatype
 , datatypeCons =
     [ ConstructorInfo
         { constructorName = GHC.Base.Nothing
         , constructorVars = []
         , constructorContext = []
         , constructorFields = []
         , constructorVariant = NormalConstructor
         }
     , ConstructorInfo
         { constructorName = GHC.Base.Just
         , constructorVars = []
         , constructorContext = []
         , constructorFields = [ VarT a_3530822107858468866 ]
         , constructorVariant = NormalConstructor
         }
     ]
 }

Datatypes declared with GADT syntax are normalized to constructors with existentially quantified type variables and equality constraints.

Synopsis

Types

data DatatypeInfo Source #

Normalized information about newtypes and data types.

Constructors

DatatypeInfo 

Fields

Instances

Eq DatatypeInfo Source # 
Data DatatypeInfo Source # 

Methods

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

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

toConstr :: DatatypeInfo -> Constr #

dataTypeOf :: DatatypeInfo -> DataType #

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

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

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

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

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

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

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

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

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

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

Show DatatypeInfo Source # 
Generic DatatypeInfo Source # 

Associated Types

type Rep DatatypeInfo :: * -> * #

type Rep DatatypeInfo Source # 

data ConstructorInfo Source #

Normalized information about constructors associated with newtypes and data types.

Constructors

ConstructorInfo 

Fields

Instances

Eq ConstructorInfo Source # 
Data ConstructorInfo Source # 

Methods

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

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

toConstr :: ConstructorInfo -> Constr #

dataTypeOf :: ConstructorInfo -> DataType #

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

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

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

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

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

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

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

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

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

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

Show ConstructorInfo Source # 
Generic ConstructorInfo Source # 
TypeSubstitution ConstructorInfo Source # 
type Rep ConstructorInfo Source # 
type Rep ConstructorInfo = D1 (MetaData "ConstructorInfo" "Language.Haskell.TH.Datatype" "th-abstraction-0.1.0.0-2XiZxdVTYK6B4lHXVGoWsL" False) (C1 (MetaCons "ConstructorInfo" PrefixI True) ((:*:) ((:*:) (S1 (MetaSel (Just Symbol "constructorName") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Name)) (S1 (MetaSel (Just Symbol "constructorVars") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [TyVarBndr]))) ((:*:) (S1 (MetaSel (Just Symbol "constructorContext") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Cxt)) ((:*:) (S1 (MetaSel (Just Symbol "constructorFields") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Type])) (S1 (MetaSel (Just Symbol "constructorVariant") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ConstructorVariant))))))

data DatatypeVariant Source #

Possible variants of data type declarations.

Constructors

Datatype

Type declared with data

Newtype

Type declared with newtype

DataInstance

Type declared with data instance

NewtypeInstance

Type declared with newtype instance

Instances

Eq DatatypeVariant Source # 
Data DatatypeVariant Source # 

Methods

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

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

toConstr :: DatatypeVariant -> Constr #

dataTypeOf :: DatatypeVariant -> DataType #

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

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

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

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

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

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

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

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

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

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

Ord DatatypeVariant Source # 
Read DatatypeVariant Source # 
Show DatatypeVariant Source # 
Generic DatatypeVariant Source # 
type Rep DatatypeVariant Source # 
type Rep DatatypeVariant = D1 (MetaData "DatatypeVariant" "Language.Haskell.TH.Datatype" "th-abstraction-0.1.0.0-2XiZxdVTYK6B4lHXVGoWsL" False) ((:+:) ((:+:) (C1 (MetaCons "Datatype" PrefixI False) U1) (C1 (MetaCons "Newtype" PrefixI False) U1)) ((:+:) (C1 (MetaCons "DataInstance" PrefixI False) U1) (C1 (MetaCons "NewtypeInstance" PrefixI False) U1)))

data ConstructorVariant Source #

Possible variants of data constructors.

Constructors

NormalConstructor

Constructor without field names

RecordConstructor [Name]

Constructor with field names

Instances

Eq ConstructorVariant Source # 
Data ConstructorVariant Source # 

Methods

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

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

toConstr :: ConstructorVariant -> Constr #

dataTypeOf :: ConstructorVariant -> DataType #

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

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

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

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

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

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

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

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

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

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

Ord ConstructorVariant Source # 
Show ConstructorVariant Source # 
Generic ConstructorVariant Source # 
type Rep ConstructorVariant Source # 
type Rep ConstructorVariant = D1 (MetaData "ConstructorVariant" "Language.Haskell.TH.Datatype" "th-abstraction-0.1.0.0-2XiZxdVTYK6B4lHXVGoWsL" False) ((:+:) (C1 (MetaCons "NormalConstructor" PrefixI False) U1) (C1 (MetaCons "RecordConstructor" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Name]))))

Normalization functions

reifyDatatype Source #

Arguments

:: Name

type constructor

-> Q DatatypeInfo 

Compute a normalized view of the metadata about a data type or newtype given a type constructor.

normalizeInfo :: Info -> Q DatatypeInfo Source #

Normalize Info for a newtype or datatype into a DatatypeInfo. Fail in Q otherwise.

normalizeDec :: Dec -> Q DatatypeInfo Source #

Normalize Dec for a newtype or datatype into a DatatypeInfo. Fail in Q otherwise.

normalizeCon Source #

Arguments

:: Name

Type constructor

-> [Name]

Type parameters

-> Con

Constructor

-> Q [ConstructorInfo] 

Normalize a Con into a ConstructorInfo. This requires knowledge of the type and parameters of the constructor as extracted from the outer Dec.

Type variable manipulation

class TypeSubstitution a where Source #

Class for types that support type variable substitution.

Minimal complete definition

applySubstitution, freeVariables

Methods

applySubstitution :: Map Name Type -> a -> a Source #

Apply a type variable substitution

freeVariables :: a -> [Name] Source #

Compute the free type variables

quantifyType :: Type -> Type Source #

Add universal quantifier for all free variables in the type. This is useful when constructing a type signature for a declaration. This code is careful to ensure that the order of the variables quantified is determined by their order of appearance in the type singnature. (In contrast with being dependent upon the Ord instance for Name)

freshenFreeVariables :: Type -> Q Type Source #

Substitute all of the free variables in a type with fresh ones

Pred functions

equalPred :: Type -> Type -> Pred Source #

Construct an equality constraint. The implementation of Pred varies across versions of Template Haskell.

classPred Source #

Arguments

:: Name

class

-> [Type]

parameters

-> Pred 

Construct a typeclass constraint. The implementation of Pred varies across versions of Template Haskell.

Convenience functions

resolveTypeSynonyms :: Type -> Q Type Source #

Expand all of the type synonyms in a type.

unifyTypes :: [Type] -> Q (Map Name Type) Source #

Compute the type variable substitution that unifies a list of types, or fail in Q.

tvName :: TyVarBndr -> Name Source #

Extract the type variable name from a TyVarBndr ignoring the kind signature if one exists.

datatypeType :: DatatypeInfo -> Type Source #

Construct a Type using the datatype's type constructor and type parameteters.