th-abstraction-0.2.8.0: Nicer interface for reified information about data types

Maintaineremertens@gmail.com
Safe HaskellNone

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 versions of the template-haskell package.

Sample output for reifyDatatype ''Maybe

DatatypeInfo
 { datatypeContext = []
 , datatypeName    = GHC.Base.Maybe
 , datatypeVars    = [ SigT (VarT a_3530822107858468866) StarT ]
 , datatypeVariant = Datatype
 , datatypeCons    =
     [ ConstructorInfo
         { constructorName       = GHC.Base.Nothing
         , constructorVars       = []
         , constructorContext    = []
         , constructorFields     = []
         , constructorStrictness = []
         , constructorVariant    = NormalConstructor
         }
     , ConstructorInfo
         { constructorName       = GHC.Base.Just
         , constructorVars       = []
         , constructorContext    = []
         , constructorFields     = [ VarT a_3530822107858468866 ]
         , constructorStrictness = [ FieldStrictness
                                         UnspecifiedUnpackedness
                                         Lazy
                                     ]
         , constructorVariant    = NormalConstructor
         }
     ]
 }

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

Synopsis

Types

data DatatypeInfo

Normalized information about newtypes and data types.

datatypeVars types will have an outermost SigT to indicate the parameter's kind. These types will be simple variables for ADTs declared with data and newtype, but can be more complex for types declared with data instance and newtype instance.

Constructors

DatatypeInfo 

Fields

datatypeContext :: Cxt

Data type context (deprecated)

datatypeName :: Name

Type constructor

datatypeVars :: [Type]

Type parameters

datatypeVariant :: DatatypeVariant

Extra information

datatypeCons :: [ConstructorInfo]

Normalize constructor information

Instances

Eq DatatypeInfo 
Data DatatypeInfo 
Show DatatypeInfo 
Typeable DatatypeInfo 
Generic DatatypeInfo 

data ConstructorInfo

Normalized information about constructors associated with newtypes and data types.

Constructors

ConstructorInfo 

Fields

constructorName :: Name

Constructor name

constructorVars :: [TyVarBndr]

Constructor type parameters

constructorContext :: Cxt

Constructor constraints

constructorFields :: [Type]

Constructor fields

constructorStrictness :: [FieldStrictness]

Constructor fields' strictness (Invariant: has the same length as constructorFields)

constructorVariant :: ConstructorVariant

Extra information

data DatatypeVariant

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

data ConstructorVariant

Possible variants of data constructors.

Constructors

NormalConstructor

Constructor without field names

InfixConstructor

Constructor without field names that is declared infix

RecordConstructor [Name]

Constructor with field names

data FieldStrictness

Normalized information about a constructor field's UNPACK and strictness annotations.

Note that the interface for reifying strictness in Template Haskell changed considerably in GHC 8.0. The presentation in this library mirrors that which can be found in GHC 8.0 or later, whereas previously, unpackedness and strictness were represented with a single data type:

 data Strict
   = IsStrict
   | NotStrict
   | Unpacked -- On GHC 7.4 or later

For backwards compatibility, we retrofit these constructors onto the following three values, respectively:

 isStrictAnnot  = FieldStrictness UnspecifiedUnpackedness Strict
 notStrictAnnot = FieldStrictness UnspecifiedUnpackedness UnspecifiedStrictness
 unpackedAnnot  = FieldStrictness Unpack Strict

data Unpackedness

Information about a constructor field's unpackedness annotation.

Constructors

UnspecifiedUnpackedness

No annotation whatsoever

NoUnpack

Annotated with {-# NOUNPACK #-}

Unpack

Annotated with {-# UNPACK #-}

Instances

data Strictness

Information about a constructor field's strictness annotation.

Constructors

UnspecifiedStrictness

No annotation whatsoever

Lazy

Annotated with ~

Strict

Annotated with !

Instances

Eq Strictness 
Data Strictness 
Ord Strictness 
Show Strictness 
Typeable Strictness 
Generic Strictness 

Normalization functions

reifyDatatype

Arguments

:: Name

data type or constructor name

-> Q DatatypeInfo 

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

This function will accept any constructor (value or type) for a type declared with newtype or data. Value constructors must be used to lookup datatype information about data instances and newtype instances, as giving the type constructor of a data family is often not enough to determine a particular data family instance.

In addition, this function will also accept a record selector for a data type with a constructor which uses that record.

GADT constructors are normalized into datatypes with explicit equality constraints. Note that no effort is made to distinguish between equalities of the same (homogeneous) kind and equalities between different (heterogeneous) kinds. For instance, the following GADT's constructors:

 data T (a :: k -> *) where
   MkT1 :: T Proxy
   MkT2 :: T Maybe

will be normalized to the following equality constraints:

 AppT (AppT EqualityT (VarT a)) (ConT Proxy) -- MkT1
 AppT (AppT EqualityT (VarT a)) (ConT Maybe) -- MkT2

But only the first equality constraint is well kinded, since in the second constraint, the kinds of (a :: k -> *) and (Maybe :: * -> *) are different. Trying to categorize which constraints need homogeneous or heterogeneous equality is tricky, so we leave that task to users of this library.

This function will apply various bug-fixes to the output of the underlying template-haskell library in order to provide a view of datatypes in as uniform a way as possible.

reifyConstructor

Arguments

:: Name

constructor name

-> Q ConstructorInfo 

Compute a normalized view of the metadata about a constructor given its Name. This is useful for scenarios when you don't care about the info for the enclosing data type.

reifyRecord

Arguments

:: Name

record name

-> Q ConstructorInfo 

Compute a normalized view of the metadata about a constructor given the Name of one of its record selectors. This is useful for scenarios when you don't care about the info for the enclosing data type.

normalizeInfo :: Info -> Q DatatypeInfo

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

normalizeDec :: Dec -> Q DatatypeInfo

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

Beware: normalizeDec can have surprising behavior when it comes to fixity. For instance, if you have this quasiquoted data declaration:

 [d| infix 5 :^^:
     data Foo where
       (:^^:) :: Int -> Int -> Foo |]

Then if you pass the Dec for Foo to normalizeDec without splicing it in a previous Template Haskell splice, then (:^^:) will be labeled a NormalConstructor instead of an InfixConstructor. This is because Template Haskell has no way to reify the fixity declaration for (:^^:), so it must assume there isn't one. To work around this behavior, use reifyDatatype instead.

normalizeCon

Arguments

:: Name

Type constructor

-> [Type]

Type parameters

-> DatatypeVariant

Extra information

-> Con

Constructor

-> Q [ConstructorInfo] 

Normalize a Con into a ConstructorInfo. This requires knowledge of the type and parameters of the constructor, as well as whether the constructor is for a data family instance, as extracted from the outer Dec.

DatatypeInfo lookup functions

lookupByConstructorName

Arguments

:: Name

constructor name

-> DatatypeInfo

info for the datatype which has that constructor

-> ConstructorInfo 

Given a DatatypeInfo, find the ConstructorInfo corresponding to the Name of one of its constructors.

lookupByRecordName

Arguments

:: Name

record name

-> DatatypeInfo

info for the datatype which has that constructor

-> ConstructorInfo 

Given a DatatypeInfo, find the ConstructorInfo corresponding to the Name of one of its constructors.

Type variable manipulation

class TypeSubstitution a where

Class for types that support type variable substitution.

Methods

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

Apply a type variable substitution.

Note that applySubstitution is not capture-avoiding. To illustrate this, observe that if you call this function with the following substitution:

  • b :-> a

On the following Type:

  • forall a. b

Then it will return:

  • forall a. a

However, because the same a type variable was used in the range of the substitution as was bound by the forall, the substituted a is now captured by the forall, resulting in a completely different function.

For th-abstraction's purposes, this is acceptable, as it usually only deals with globally unique type variable Names. If you use applySubstitution in a context where the Names aren't globally unique, however, be aware of this potential problem.

freeVariables :: a -> [Name]

Compute the free type variables

quantifyType :: Type -> Type

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 signature. (In contrast with being dependent upon the Ord instance for Name)

freshenFreeVariables :: Type -> Q Type

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

Pred functions

equalPred :: Type -> Type -> Pred

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

classPred

Arguments

:: Name

class

-> [Type]

parameters

-> Pred 

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

asEqualPred :: Pred -> Maybe (Type, Type)

Match a Pred representing an equality constraint. Returns arguments to the equality constraint if successful.

asClassPred :: Pred -> Maybe (Name, [Type])

Match a Pred representing a class constraint. Returns the classname and parameters if successful.

Backward compatible data definitions

dataDCompat

Arguments

:: CxtQ

context

-> Name

type constructor

-> [TyVarBndr]

type parameters

-> [ConQ]

constructor definitions

-> [Name]

derived class names

-> DecQ 

Backward compatible version of dataD

newtypeDCompat

Arguments

:: CxtQ

context

-> Name

type constructor

-> [TyVarBndr]

type parameters

-> ConQ

constructor definition

-> [Name]

derived class names

-> DecQ 

Backward compatible version of newtypeD

tySynInstDCompat

Arguments

:: Name

type family name

-> [TypeQ]

instance parameters

-> TypeQ

instance result

-> DecQ 

Backward compatible version of tySynInstD

pragLineDCompat

Arguments

:: Int

line number

-> String

file name

-> Maybe DecQ 

Backward compatible version of pragLineD. Returns Nothing if line pragmas are not suported.

arrowKCompat :: Kind -> Kind -> Kind

Strictness annotations

Type simplification

resolveTypeSynonyms :: Type -> Q Type

Expand all of the type synonyms in a type.

resolvePredSynonyms :: Pred -> Q Pred

Expand all of the type synonyms in a Pred.

resolveInfixT :: Type -> Q Type

Resolve any infix type application in a type using the fixities that are currently available. Starting in `template-haskell-2.11` types could contain unresolved infix applications.

Fixities

reifyFixityCompat :: Name -> Q (Maybe Fixity)

Backwards compatibility wrapper for Fixity lookup.

In template-haskell-2.11.0.0 and later, the answer will always be Just of a fixity.

Before template-haskell-2.11.0.0 it was only possible to determine fixity information for variables, class methods, and data constructors. In this case for type operators the answer could be Nothing, which indicates that the answer is unavailable.

showFixity :: Fixity -> String

Render a Fixity as it would appear in Haskell source.

Example: infixl 5

showFixityDirection :: FixityDirection -> String

Render a FixityDirection like it would appear in Haskell source.

Examples: infixl infixr infix

Convenience functions

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

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

All infix issue should be resolved before using unifyTypes

Alpha equivalent quantified types are not unified.

tvName :: TyVarBndr -> Name

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

tvKind :: TyVarBndr -> Kind

Extract the kind from a TyVarBndr. Assumes PlainTV has kind *.

datatypeType :: DatatypeInfo -> Type

Construct a Type using the datatype's type constructor and type parameters. Kind signatures are removed.