| Copyright | (c) Galois Inc 2013-2014 |
|---|---|
| Maintainer | Joe Hendrix <jhendrix@galois.com> |
| Safe Haskell | None |
| Language | Haskell98 |
Data.Parameterized.TH.GADT
Description
This module declares template Haskell primitives so that it is easier to work with GADTs that have many constructors.
- structuralEquality :: TypeQ -> [(TypePat, ExpQ)] -> ExpQ
- structuralTypeEquality :: TypeQ -> [(TypePat, ExpQ)] -> ExpQ
- structuralTypeOrd :: TypeQ -> [(TypePat, ExpQ)] -> ExpQ
- structuralTraversal :: TypeQ -> [(TypePat, ExpQ)] -> ExpQ
- structuralShowsPrec :: TypeQ -> ExpQ
- structuralHash :: TypeQ -> ExpQ
- class PolyEq u v where
- type DataD = DatatypeInfo
- lookupDataType' :: Name -> Q DatatypeInfo
- asTypeCon :: Monad m => String -> Type -> m Name
- conPat :: ConstructorInfo -> String -> Q (Pat, [Name])
- data TypePat
- dataParamTypes :: DatatypeInfo -> [Type]
- assocTypePats :: [Type] -> [(TypePat, v)] -> Type -> Q (Maybe v)
Documentation
structuralEquality :: TypeQ -> [(TypePat, ExpQ)] -> ExpQ Source #
declareStructuralEquality declares a structural equality predicate.
structuralTypeEquality :: TypeQ -> [(TypePat, ExpQ)] -> ExpQ Source #
structuralTypeEquality f returns a function with the type:
forall x y . f x -> f y -> Maybe (x :~: y)
structuralTypeEquality f returns a function with the type:
forall x y . f x -> f y -> OrderingF x y
This implementation avoids matching on both the first and second parameters in a simple case expression in order to avoid stressing GHC's coverage checker. In the case that the first and second parameters have unique constructors, a simple numeric comparison is done to compute the result.
structuralTraversal :: TypeQ -> [(TypePat, ExpQ)] -> ExpQ Source #
structuralTraversal tp generates a function that applies
a traversal f to the subterms with free variables in tp.
structuralShowsPrec :: TypeQ -> ExpQ Source #
structuralShow tp generates a function with the type
tp -> ShowS that shows the constructor.
structuralHash :: TypeQ -> ExpQ Source #
structuralHash tp generates a function with the type
Int -> tp -> Int that hashes type.
class PolyEq u v where Source #
A polymorphic equality operator that generalizes TestEquality.
Minimal complete definition
Instances
| PolyEq (NatRepr m) (NatRepr n) Source # | |
| TestEquality k f => PolyEq (Assignment k f x) (Assignment k f y) Source # | |
Template haskell utilities that may be useful in other contexts.
type DataD = DatatypeInfo Source #
lookupDataType' :: Name -> Q DatatypeInfo Source #
Arguments
| :: ConstructorInfo | constructor information |
| -> String | generated name prefix |
| -> Q (Pat, [Name]) | pattern and bound names |
Given a constructor and string, this generates a pattern for matching the expression, and the names of variables bound by pattern in order they appear in constructor.
dataParamTypes :: DatatypeInfo -> [Type] Source #