{-# LANGUAGE Safe #-}
module Language.Haskell.TH.Lib (
InfoQ, ExpQ, TExpQ, CodeQ, DecQ, DecsQ, ConQ, TypeQ, KindQ,
TyLitQ, CxtQ, PredQ, DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ,
StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ,
BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ,
ArgPatQ, FieldPatQ, RuleBndrQ, TySynEqnQ, PatSynDirQ, PatSynArgsQ,
FamilyResultSigQ, DerivStrategyQ,
TyVarBndrUnit, TyVarBndrSpec, TyVarBndrVis,
intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,
charL, stringL, stringPrimL, charPrimL, bytesPrimL, mkBytes,
litP, varP, tupP, unboxedTupP, unboxedSumP, conP, uInfixP, parensP,
infixP, tildeP, bangP, asP, wildP, recP,
listP, sigP, viewP, typeP,
fieldPat,
visAP, invisAP,
normalB, guardedB, normalG, normalGE, patG, patGE, match, clause,
dyn, varE, unboundVarE, labelE, implicitParamVarE, conE, litE, staticE,
appE, appTypeE, uInfixE, parensE, infixE, infixApp, sectionL, sectionR,
lamE, lam1E, lamCaseE, lamCasesE, tupE, unboxedTupE, unboxedSumE, condE,
multiIfE, letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE,
fieldExp, getFieldE, projectionE, typedSpliceE, typedBracketE, typeE,
fromE, fromThenE, fromToE, fromThenToE,
arithSeqE,
fromR, fromThenR, fromToR, fromThenToR,
doE, mdoE, compE,
bindS, letS, noBindS, parS, recS,
forallT, forallVisT, varT, conT, appT, appKindT, arrowT, mulArrowT,
infixT, uInfixT, promotedInfixT, promotedUInfixT,
parensT, equalityT, listT, tupleT, unboxedTupleT, unboxedSumT,
sigT, litT, wildCardT, promotedT, promotedTupleT, promotedNilT,
promotedConsT, implicitParamT,
numTyLit, strTyLit, charTyLit,
noSourceUnpackedness, sourceNoUnpack, sourceUnpack,
noSourceStrictness, sourceLazy, sourceStrict,
isStrict, notStrict, unpacked,
bang, bangType, varBangType, strictType, varStrictType,
cxt, classP, equalP,
normalC, recC, infixC, forallC, gadtC, recGadtC,
varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,
DefaultBndrFlag(defaultBndrFlag),
plainTV, kindedTV,
plainInvisTV, kindedInvisTV,
plainBndrTV, kindedBndrTV,
specifiedSpec, inferredSpec,
bndrReq, bndrInvis,
nominalR, representationalR, phantomR, inferR,
valD, funD, tySynD, dataD, newtypeD, typeDataD,
derivClause, DerivClause(..),
stockStrategy, anyclassStrategy, newtypeStrategy,
viaStrategy, DerivStrategy(..),
classD, instanceD, instanceWithOverlapD, Overlap(..),
sigD, kiSigD, standaloneDerivD, standaloneDerivWithStrategyD, defaultSigD,
roleAnnotD,
dataFamilyD, openTypeFamilyD, closedTypeFamilyD, dataInstD,
newtypeInstD, tySynInstD,
tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig,
infixLD, infixRD, infixND,
defaultD,
cCall, stdCall, cApi, prim, javaScript,
unsafe, safe, interruptible, forImpD,
funDep,
ruleVar, typedRuleVar,
valueAnnotation, typeAnnotation, moduleAnnotation,
pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD,
pragLineD, pragCompleteD,
patSynD, patSynSigD, unidir, implBidir, explBidir, prefixPatSyn,
infixPatSyn, recordPatSyn,
implicitParamBindD,
thisModule,
withDecDoc, withDecsDoc, funD_doc, dataD_doc, newtypeD_doc,
typeDataD_doc, dataInstD_doc, newtypeInstD_doc, patSynD_doc
) where
import Language.Haskell.TH.Lib.Internal hiding
( tySynD
, dataD
, newtypeD
, typeDataD
, classD
, pragRuleD
, dataInstD
, newtypeInstD
, dataFamilyD
, openTypeFamilyD
, closedTypeFamilyD
, tySynEqn
, forallC
, forallT
, sigT
, plainTV
, kindedTV
, starK
, constraintK
, noSig
, kindSig
, tyVarSig
, derivClause
, standaloneDerivWithStrategyD
, doE
, mdoE
, tupE
, unboxedTupE
, conP
, Role
, InjectivityAnn
)
import qualified Language.Haskell.TH.Lib.Internal as Internal
import Language.Haskell.TH.Syntax
import Control.Applicative (Applicative(..))
import Foreign.ForeignPtr
import Data.Word
import Prelude hiding (Applicative(..))
tySynD :: Quote m => Name -> [TyVarBndr BndrVis] -> m Type -> m Dec
tySynD :: forall (m :: * -> *).
Quote m =>
Name -> [TyVarBndr BndrVis] -> m Type -> m Dec
tySynD Name
tc [TyVarBndr BndrVis]
tvs m Type
rhs = do { rhs1 <- m Type
rhs; return (TySynD tc tvs rhs1) }
dataD :: Quote m => m Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [m Con] -> [m DerivClause]
-> m Dec
dataD :: forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Type
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD m Cxt
ctxt Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
ksig [m Con]
cons [m DerivClause]
derivs =
do
ctxt1 <- m Cxt
ctxt
cons1 <- sequenceA cons
derivs1 <- sequenceA derivs
return (DataD ctxt1 tc tvs ksig cons1 derivs1)
newtypeD :: Quote m => m Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> m Con -> [m DerivClause]
-> m Dec
newtypeD :: forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Type
-> m Con
-> [m DerivClause]
-> m Dec
newtypeD m Cxt
ctxt Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
ksig m Con
con [m DerivClause]
derivs =
do
ctxt1 <- m Cxt
ctxt
con1 <- con
derivs1 <- sequenceA derivs
return (NewtypeD ctxt1 tc tvs ksig con1 derivs1)
typeDataD :: Quote m => Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [m Con]
-> m Dec
typeDataD :: forall (m :: * -> *).
Quote m =>
Name -> [TyVarBndr BndrVis] -> Maybe Type -> [m Con] -> m Dec
typeDataD Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
ksig [m Con]
cons =
do
cons1 <- [m Con] -> m [Con]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Con]
cons
return (TypeDataD tc tvs ksig cons1)
classD :: Quote m => m Cxt -> Name -> [TyVarBndr BndrVis] -> [FunDep] -> [m Dec] -> m Dec
classD :: forall (m :: * -> *).
Quote m =>
m Cxt
-> Name -> [TyVarBndr BndrVis] -> [FunDep] -> [m Dec] -> m Dec
classD m Cxt
ctxt Name
cls [TyVarBndr BndrVis]
tvs [FunDep]
fds [m Dec]
decs =
do
decs1 <- [m Dec] -> m [Dec]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Dec]
decs
ctxt1 <- ctxt
return $ ClassD ctxt1 cls tvs fds decs1
pragRuleD :: Quote m => String -> [m RuleBndr] -> m Exp -> m Exp -> Phases -> m Dec
pragRuleD :: forall (m :: * -> *).
Quote m =>
String -> [m RuleBndr] -> m Exp -> m Exp -> Phases -> m Dec
pragRuleD String
n [m RuleBndr]
bndrs m Exp
lhs m Exp
rhs Phases
phases
= do
bndrs1 <- [m RuleBndr] -> m [RuleBndr]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m RuleBndr]
bndrs
lhs1 <- lhs
rhs1 <- rhs
return $ PragmaD $ RuleP n Nothing bndrs1 lhs1 rhs1 phases
dataInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> [m Con] -> [m DerivClause]
-> m Dec
dataInstD :: forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [m Type]
-> Maybe Type
-> [m Con]
-> [m DerivClause]
-> m Dec
dataInstD m Cxt
ctxt Name
tc [m Type]
tys Maybe Type
ksig [m Con]
cons [m DerivClause]
derivs =
do
ctxt1 <- m Cxt
ctxt
ty1 <- foldl appT (conT tc) tys
cons1 <- sequenceA cons
derivs1 <- sequenceA derivs
return (DataInstD ctxt1 Nothing ty1 ksig cons1 derivs1)
newtypeInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> m Con -> [m DerivClause]
-> m Dec
newtypeInstD :: forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [m Type]
-> Maybe Type
-> m Con
-> [m DerivClause]
-> m Dec
newtypeInstD m Cxt
ctxt Name
tc [m Type]
tys Maybe Type
ksig m Con
con [m DerivClause]
derivs =
do
ctxt1 <- m Cxt
ctxt
ty1 <- foldl appT (conT tc) tys
con1 <- con
derivs1 <- sequenceA derivs
return (NewtypeInstD ctxt1 Nothing ty1 ksig con1 derivs1)
dataFamilyD :: Quote m => Name -> [TyVarBndr BndrVis] -> Maybe Kind -> m Dec
dataFamilyD :: forall (m :: * -> *).
Quote m =>
Name -> [TyVarBndr BndrVis] -> Maybe Type -> m Dec
dataFamilyD Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
kind
= Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> m Dec) -> Dec -> m Dec
forall a b. (a -> b) -> a -> b
$ Name -> [TyVarBndr BndrVis] -> Maybe Type -> Dec
DataFamilyD Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
kind
openTypeFamilyD :: Quote m => Name -> [TyVarBndr BndrVis] -> FamilyResultSig
-> Maybe InjectivityAnn -> m Dec
openTypeFamilyD :: forall (m :: * -> *).
Quote m =>
Name
-> [TyVarBndr BndrVis]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> m Dec
openTypeFamilyD Name
tc [TyVarBndr BndrVis]
tvs FamilyResultSig
res Maybe InjectivityAnn
inj
= Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> m Dec) -> Dec -> m Dec
forall a b. (a -> b) -> a -> b
$ TypeFamilyHead -> Dec
OpenTypeFamilyD (Name
-> [TyVarBndr BndrVis]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> TypeFamilyHead
TypeFamilyHead Name
tc [TyVarBndr BndrVis]
tvs FamilyResultSig
res Maybe InjectivityAnn
inj)
closedTypeFamilyD :: Quote m => Name -> [TyVarBndr BndrVis] -> FamilyResultSig
-> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec
closedTypeFamilyD :: forall (m :: * -> *).
Quote m =>
Name
-> [TyVarBndr BndrVis]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> [m TySynEqn]
-> m Dec
closedTypeFamilyD Name
tc [TyVarBndr BndrVis]
tvs FamilyResultSig
result Maybe InjectivityAnn
injectivity [m TySynEqn]
eqns =
do eqns1 <- [m TySynEqn] -> m [TySynEqn]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m TySynEqn]
eqns
return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)
tySynEqn :: Quote m => (Maybe [TyVarBndr ()]) -> m Type -> m Type -> m TySynEqn
tySynEqn :: forall (m :: * -> *).
Quote m =>
Maybe [TyVarBndr ()] -> m Type -> m Type -> m TySynEqn
tySynEqn Maybe [TyVarBndr ()]
tvs m Type
lhs m Type
rhs =
do
lhs1 <- m Type
lhs
rhs1 <- rhs
return (TySynEqn tvs lhs1 rhs1)
forallC :: Quote m => [TyVarBndr Specificity] -> m Cxt -> m Con -> m Con
forallC :: forall (m :: * -> *).
Quote m =>
[TyVarBndr Specificity] -> m Cxt -> m Con -> m Con
forallC [TyVarBndr Specificity]
ns m Cxt
ctxt m Con
con = (Cxt -> Con -> Con) -> m Cxt -> m Con -> m Con
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ([TyVarBndr Specificity] -> Cxt -> Con -> Con
ForallC [TyVarBndr Specificity]
ns) m Cxt
ctxt m Con
con
forallT :: Quote m => [TyVarBndr Specificity] -> m Cxt -> m Type -> m Type
forallT :: forall (m :: * -> *).
Quote m =>
[TyVarBndr Specificity] -> m Cxt -> m Type -> m Type
forallT [TyVarBndr Specificity]
tvars m Cxt
ctxt m Type
ty = do
ctxt1 <- m Cxt
ctxt
ty1 <- ty
return $ ForallT tvars ctxt1 ty1
sigT :: Quote m => m Type -> Kind -> m Type
sigT :: forall (m :: * -> *). Quote m => m Type -> Type -> m Type
sigT m Type
t Type
k
= do
t' <- m Type
t
return $ SigT t' k
class DefaultBndrFlag flag where
defaultBndrFlag :: flag
instance DefaultBndrFlag () where
defaultBndrFlag :: ()
defaultBndrFlag = ()
instance DefaultBndrFlag Specificity where
defaultBndrFlag :: Specificity
defaultBndrFlag = Specificity
SpecifiedSpec
instance DefaultBndrFlag BndrVis where
defaultBndrFlag :: BndrVis
defaultBndrFlag = BndrVis
BndrReq
plainTV :: DefaultBndrFlag flag => Name -> TyVarBndr flag
plainTV :: forall flag. DefaultBndrFlag flag => Name -> TyVarBndr flag
plainTV Name
n = Name -> flag -> TyVarBndr flag
forall flag. Name -> flag -> TyVarBndr flag
PlainTV Name
n flag
forall flag. DefaultBndrFlag flag => flag
defaultBndrFlag
kindedTV :: DefaultBndrFlag flag => Name -> Kind -> TyVarBndr flag
kindedTV :: forall flag. DefaultBndrFlag flag => Name -> Type -> TyVarBndr flag
kindedTV Name
n Type
k = Name -> flag -> Type -> TyVarBndr flag
forall flag. Name -> flag -> Type -> TyVarBndr flag
KindedTV Name
n flag
forall flag. DefaultBndrFlag flag => flag
defaultBndrFlag Type
k
starK :: Kind
starK :: Type
starK = Type
StarT
constraintK :: Kind
constraintK :: Type
constraintK = Type
ConstraintT
noSig :: FamilyResultSig
noSig :: FamilyResultSig
noSig = FamilyResultSig
NoSig
kindSig :: Kind -> FamilyResultSig
kindSig :: Type -> FamilyResultSig
kindSig = Type -> FamilyResultSig
KindSig
tyVarSig :: TyVarBndr () -> FamilyResultSig
tyVarSig :: TyVarBndr () -> FamilyResultSig
tyVarSig = TyVarBndr () -> FamilyResultSig
TyVarSig
derivClause :: Quote m => Maybe DerivStrategy -> [m Pred] -> m DerivClause
derivClause :: forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Type] -> m DerivClause
derivClause Maybe DerivStrategy
mds [m Type]
p = do
p' <- [m Type] -> m Cxt
forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt [m Type]
p
return $ DerivClause mds p'
standaloneDerivWithStrategyD :: Quote m => Maybe DerivStrategy -> m Cxt -> m Type -> m Dec
standaloneDerivWithStrategyD :: forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> m Cxt -> m Type -> m Dec
standaloneDerivWithStrategyD Maybe DerivStrategy
mds m Cxt
ctxt m Type
ty = do
ctxt' <- m Cxt
ctxt
ty' <- ty
return $ StandaloneDerivD mds ctxt' ty'
mkBytes
:: ForeignPtr Word8
-> Word
-> Word
-> Bytes
mkBytes :: ForeignPtr Word8 -> Word -> Word -> Bytes
mkBytes = ForeignPtr Word8 -> Word -> Word -> Bytes
Bytes
tupE :: Quote m => [m Exp] -> m Exp
tupE :: forall (m :: * -> *). Quote m => [m Exp] -> m Exp
tupE [m Exp]
es = do { es1 <- [m Exp] -> m [Exp]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Exp]
es; return (TupE $ map Just es1)}
unboxedTupE :: Quote m => [m Exp] -> m Exp
unboxedTupE :: forall (m :: * -> *). Quote m => [m Exp] -> m Exp
unboxedTupE [m Exp]
es = do { es1 <- [m Exp] -> m [Exp]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Exp]
es; return (UnboxedTupE $ map Just es1)}
doE :: Quote m => [m Stmt] -> m Exp
doE :: forall (m :: * -> *). Quote m => [m Stmt] -> m Exp
doE = Maybe ModName -> [m Stmt] -> m Exp
forall (m :: * -> *). Quote m => Maybe ModName -> [m Stmt] -> m Exp
Internal.doE Maybe ModName
forall a. Maybe a
Nothing
mdoE :: Quote m => [m Stmt] -> m Exp
mdoE :: forall (m :: * -> *). Quote m => [m Stmt] -> m Exp
mdoE = Maybe ModName -> [m Stmt] -> m Exp
forall (m :: * -> *). Quote m => Maybe ModName -> [m Stmt] -> m Exp
Internal.mdoE Maybe ModName
forall a. Maybe a
Nothing
conP :: Quote m => Name -> [m Pat] -> m Pat
conP :: forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
n [m Pat]
xs = Name -> [m Type] -> [m Pat] -> m Pat
forall (m :: * -> *).
Quote m =>
Name -> [m Type] -> [m Pat] -> m Pat
Internal.conP Name
n [] [m Pat]
xs