module Language.Haskell.TH.Lib.Internal where
import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)
import qualified Language.Haskell.TH.Syntax as TH
import Control.Applicative(liftA, liftA2)
import qualified Data.Kind as Kind (Type)
import Data.Word( Word8 )
import GHC.Exts (TYPE)
import Prelude
type TExpQ (a :: TYPE r) = Q (TExp a)
type CodeQ = Code Q :: (TYPE r -> Kind.Type)
type InfoQ = Q Info
type PatQ = Q Pat
type FieldPatQ = Q FieldPat
type ExpQ = Q Exp
type DecQ = Q Dec
type DecsQ = Q [Dec]
type Decs = [Dec]
type ConQ = Q Con
type TypeQ = Q Type
type KindQ = Q Kind
type TyLitQ = Q TyLit
type CxtQ = Q Cxt
type PredQ = Q Pred
type DerivClauseQ = Q DerivClause
type MatchQ = Q Match
type ClauseQ = Q Clause
type BodyQ = Q Body
type GuardQ = Q Guard
type StmtQ = Q Stmt
type RangeQ = Q Range
type SourceStrictnessQ = Q SourceStrictness
type SourceUnpackednessQ = Q SourceUnpackedness
type BangQ = Q Bang
type BangTypeQ = Q BangType
type VarBangTypeQ = Q VarBangType
type StrictTypeQ = Q StrictType
type VarStrictTypeQ = Q VarStrictType
type FieldExpQ = Q FieldExp
type RuleBndrQ = Q RuleBndr
type TySynEqnQ = Q TySynEqn
type PatSynDirQ = Q PatSynDir
type PatSynArgsQ = Q PatSynArgs
type FamilyResultSigQ = Q FamilyResultSig
type DerivStrategyQ = Q DerivStrategy
type Role = TH.Role
type InjectivityAnn = TH.InjectivityAnn
type TyVarBndrUnit = TyVarBndr ()
type TyVarBndrSpec = TyVarBndr Specificity
intPrimL :: Integer -> Lit
intPrimL = IntPrimL
wordPrimL :: Integer -> Lit
wordPrimL = WordPrimL
floatPrimL :: Rational -> Lit
floatPrimL = FloatPrimL
doublePrimL :: Rational -> Lit
doublePrimL = DoublePrimL
integerL :: Integer -> Lit
integerL = IntegerL
charL :: Char -> Lit
charL = CharL
charPrimL :: Char -> Lit
charPrimL = CharPrimL
stringL :: String -> Lit
stringL = StringL
stringPrimL :: [Word8] -> Lit
stringPrimL = StringPrimL
bytesPrimL :: Bytes -> Lit
bytesPrimL = BytesPrimL
rationalL :: Rational -> Lit
rationalL = RationalL
litP :: Quote m => Lit -> m Pat
litP l = pure (LitP l)
varP :: Quote m => Name -> m Pat
varP v = pure (VarP v)
tupP :: Quote m => [m Pat] -> m Pat
tupP ps = do { ps1 <- sequenceA ps; pure (TupP ps1)}
unboxedTupP :: Quote m => [m Pat] -> m Pat
unboxedTupP ps = do { ps1 <- sequenceA ps; pure (UnboxedTupP ps1)}
unboxedSumP :: Quote m => m Pat -> SumAlt -> SumArity -> m Pat
unboxedSumP p alt arity = do { p1 <- p; pure (UnboxedSumP p1 alt arity) }
conP :: Quote m => Name -> [m Pat] -> m Pat
conP n ps = do ps' <- sequenceA ps
pure (ConP n ps')
infixP :: Quote m => m Pat -> Name -> m Pat -> m Pat
infixP p1 n p2 = do p1' <- p1
p2' <- p2
pure (InfixP p1' n p2')
uInfixP :: Quote m => m Pat -> Name -> m Pat -> m Pat
uInfixP p1 n p2 = do p1' <- p1
p2' <- p2
pure (UInfixP p1' n p2')
parensP :: Quote m => m Pat -> m Pat
parensP p = do p' <- p
pure (ParensP p')
tildeP :: Quote m => m Pat -> m Pat
tildeP p = do p' <- p
pure (TildeP p')
bangP :: Quote m => m Pat -> m Pat
bangP p = do p' <- p
pure (BangP p')
asP :: Quote m => Name -> m Pat -> m Pat
asP n p = do p' <- p
pure (AsP n p')
wildP :: Quote m => m Pat
wildP = pure WildP
recP :: Quote m => Name -> [m FieldPat] -> m Pat
recP n fps = do fps' <- sequenceA fps
pure (RecP n fps')
listP :: Quote m => [m Pat] -> m Pat
listP ps = do ps' <- sequenceA ps
pure (ListP ps')
sigP :: Quote m => m Pat -> m Type -> m Pat
sigP p t = do p' <- p
t' <- t
pure (SigP p' t')
viewP :: Quote m => m Exp -> m Pat -> m Pat
viewP e p = do e' <- e
p' <- p
pure (ViewP e' p')
fieldPat :: Quote m => Name -> m Pat -> m FieldPat
fieldPat n p = do p' <- p
pure (n, p')
bindS :: Quote m => m Pat -> m Exp -> m Stmt
bindS p e = liftA2 BindS p e
letS :: Quote m => [m Dec] -> m Stmt
letS ds = do { ds1 <- sequenceA ds; pure (LetS ds1) }
noBindS :: Quote m => m Exp -> m Stmt
noBindS e = do { e1 <- e; pure (NoBindS e1) }
parS :: Quote m => [[m Stmt]] -> m Stmt
parS sss = do { sss1 <- traverse sequenceA sss; pure (ParS sss1) }
recS :: Quote m => [m Stmt] -> m Stmt
recS ss = do { ss1 <- sequenceA ss; pure (RecS ss1) }
fromR :: Quote m => m Exp -> m Range
fromR x = do { a <- x; pure (FromR a) }
fromThenR :: Quote m => m Exp -> m Exp -> m Range
fromThenR x y = do { a <- x; b <- y; pure (FromThenR a b) }
fromToR :: Quote m => m Exp -> m Exp -> m Range
fromToR x y = do { a <- x; b <- y; pure (FromToR a b) }
fromThenToR :: Quote m => m Exp -> m Exp -> m Exp -> m Range
fromThenToR x y z = do { a <- x; b <- y; c <- z;
pure (FromThenToR a b c) }
normalB :: Quote m => m Exp -> m Body
normalB e = do { e1 <- e; pure (NormalB e1) }
guardedB :: Quote m => [m (Guard,Exp)] -> m Body
guardedB ges = do { ges' <- sequenceA ges; pure (GuardedB ges') }
normalG :: Quote m => m Exp -> m Guard
normalG e = do { e1 <- e; pure (NormalG e1) }
normalGE :: Quote m => m Exp -> m Exp -> m (Guard, Exp)
normalGE g e = do { g1 <- g; e1 <- e; pure (NormalG g1, e1) }
patG :: Quote m => [m Stmt] -> m Guard
patG ss = do { ss' <- sequenceA ss; pure (PatG ss') }
patGE :: Quote m => [m Stmt] -> m Exp -> m (Guard, Exp)
patGE ss e = do { ss' <- sequenceA ss;
e' <- e;
pure (PatG ss', e') }
match :: Quote m => m Pat -> m Body -> [m Dec] -> m Match
match p rhs ds = do { p' <- p;
r' <- rhs;
ds' <- sequenceA ds;
pure (Match p' r' ds') }
clause :: Quote m => [m Pat] -> m Body -> [m Dec] -> m Clause
clause ps r ds = do { ps' <- sequenceA ps;
r' <- r;
ds' <- sequenceA ds;
pure (Clause ps' r' ds') }
dyn :: Quote m => String -> m Exp
dyn s = pure (VarE (mkName s))
varE :: Quote m => Name -> m Exp
varE s = pure (VarE s)
conE :: Quote m => Name -> m Exp
conE s = pure (ConE s)
litE :: Quote m => Lit -> m Exp
litE c = pure (LitE c)
appE :: Quote m => m Exp -> m Exp -> m Exp
appE x y = do { a <- x; b <- y; pure (AppE a b)}
appTypeE :: Quote m => m Exp -> m Type -> m Exp
appTypeE x t = do { a <- x; s <- t; pure (AppTypeE a s) }
parensE :: Quote m => m Exp -> m Exp
parensE x = do { x' <- x; pure (ParensE x') }
uInfixE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE x s y = do { x' <- x; s' <- s; y' <- y;
pure (UInfixE x' s' y') }
infixE :: Quote m => Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;
pure (InfixE (Just a) s' (Just b))}
infixE Nothing s (Just y) = do { s' <- s; b <- y;
pure (InfixE Nothing s' (Just b))}
infixE (Just x) s Nothing = do { a <- x; s' <- s;
pure (InfixE (Just a) s' Nothing)}
infixE Nothing s Nothing = do { s' <- s; pure (InfixE Nothing s' Nothing) }
infixApp :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
infixApp x y z = infixE (Just x) y (Just z)
sectionL :: Quote m => m Exp -> m Exp -> m Exp
sectionL x y = infixE (Just x) y Nothing
sectionR :: Quote m => m Exp -> m Exp -> m Exp
sectionR x y = infixE Nothing x (Just y)
lamE :: Quote m => [m Pat] -> m Exp -> m Exp
lamE ps e = do ps' <- sequenceA ps
e' <- e
pure (LamE ps' e')
lam1E :: Quote m => m Pat -> m Exp -> m Exp
lam1E p e = lamE [p] e
lamCaseE :: Quote m => [m Match] -> m Exp
lamCaseE ms = LamCaseE <$> sequenceA ms
tupE :: Quote m => [Maybe (m Exp)] -> m Exp
tupE es = do { es1 <- traverse sequenceA es; pure (TupE es1)}
unboxedTupE :: Quote m => [Maybe (m Exp)] -> m Exp
unboxedTupE es = do { es1 <- traverse sequenceA es; pure (UnboxedTupE es1)}
unboxedSumE :: Quote m => m Exp -> SumAlt -> SumArity -> m Exp
unboxedSumE e alt arity = do { e1 <- e; pure (UnboxedSumE e1 alt arity) }
condE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
condE x y z = do { a <- x; b <- y; c <- z; pure (CondE a b c)}
multiIfE :: Quote m => [m (Guard, Exp)] -> m Exp
multiIfE alts = MultiIfE <$> sequenceA alts
letE :: Quote m => [m Dec] -> m Exp -> m Exp
letE ds e = do { ds2 <- sequenceA ds; e2 <- e; pure (LetE ds2 e2) }
caseE :: Quote m => m Exp -> [m Match] -> m Exp
caseE e ms = do { e1 <- e; ms1 <- sequenceA ms; pure (CaseE e1 ms1) }
doE :: Quote m => Maybe ModName -> [m Stmt] -> m Exp
doE m ss = do { ss1 <- sequenceA ss; pure (DoE m ss1) }
mdoE :: Quote m => Maybe ModName -> [m Stmt] -> m Exp
mdoE m ss = do { ss1 <- sequenceA ss; pure (MDoE m ss1) }
compE :: Quote m => [m Stmt] -> m Exp
compE ss = do { ss1 <- sequenceA ss; pure (CompE ss1) }
arithSeqE :: Quote m => m Range -> m Exp
arithSeqE r = do { r' <- r; pure (ArithSeqE r') }
listE :: Quote m => [m Exp] -> m Exp
listE es = do { es1 <- sequenceA es; pure (ListE es1) }
sigE :: Quote m => m Exp -> m Type -> m Exp
sigE e t = do { e1 <- e; t1 <- t; pure (SigE e1 t1) }
recConE :: Quote m => Name -> [m (Name,Exp)] -> m Exp
recConE c fs = do { flds <- sequenceA fs; pure (RecConE c flds) }
recUpdE :: Quote m => m Exp -> [m (Name,Exp)] -> m Exp
recUpdE e fs = do { e1 <- e; flds <- sequenceA fs; pure (RecUpdE e1 flds) }
stringE :: Quote m => String -> m Exp
stringE = litE . stringL
fieldExp :: Quote m => Name -> m Exp -> m (Name, Exp)
fieldExp s e = do { e' <- e; pure (s,e') }
staticE :: Quote m => m Exp -> m Exp
staticE = fmap StaticE
unboundVarE :: Quote m => Name -> m Exp
unboundVarE s = pure (UnboundVarE s)
labelE :: Quote m => String -> m Exp
labelE s = pure (LabelE s)
implicitParamVarE :: Quote m => String -> m Exp
implicitParamVarE n = pure (ImplicitParamVarE n)
fromE :: Quote m => m Exp -> m Exp
fromE x = do { a <- x; pure (ArithSeqE (FromR a)) }
fromThenE :: Quote m => m Exp -> m Exp -> m Exp
fromThenE x y = do { a <- x; b <- y; pure (ArithSeqE (FromThenR a b)) }
fromToE :: Quote m => m Exp -> m Exp -> m Exp
fromToE x y = do { a <- x; b <- y; pure (ArithSeqE (FromToR a b)) }
fromThenToE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
fromThenToE x y z = do { a <- x; b <- y; c <- z;
pure (ArithSeqE (FromThenToR a b c)) }
valD :: Quote m => m Pat -> m Body -> [m Dec] -> m Dec
valD p b ds =
do { p' <- p
; ds' <- sequenceA ds
; b' <- b
; pure (ValD p' b' ds')
}
funD :: Quote m => Name -> [m Clause] -> m Dec
funD nm cs =
do { cs1 <- sequenceA cs
; pure (FunD nm cs1)
}
tySynD :: Quote m => Name -> [m (TyVarBndr ())] -> m Type -> m Dec
tySynD tc tvs rhs =
do { tvs1 <- sequenceA tvs
; rhs1 <- rhs
; pure (TySynD tc tvs1 rhs1)
}
dataD :: Quote m => m Cxt -> Name -> [m (TyVarBndr ())] -> Maybe (m Kind) -> [m Con]
-> [m DerivClause] -> m Dec
dataD ctxt tc tvs ksig cons derivs =
do
ctxt1 <- ctxt
tvs1 <- sequenceA tvs
ksig1 <- sequenceA ksig
cons1 <- sequenceA cons
derivs1 <- sequenceA derivs
pure (DataD ctxt1 tc tvs1 ksig1 cons1 derivs1)
newtypeD :: Quote m => m Cxt -> Name -> [m (TyVarBndr ())] -> Maybe (m Kind) -> m Con
-> [m DerivClause] -> m Dec
newtypeD ctxt tc tvs ksig con derivs =
do
ctxt1 <- ctxt
tvs1 <- sequenceA tvs
ksig1 <- sequenceA ksig
con1 <- con
derivs1 <- sequenceA derivs
pure (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1)
classD :: Quote m => m Cxt -> Name -> [m (TyVarBndr ())] -> [FunDep] -> [m Dec] -> m Dec
classD ctxt cls tvs fds decs =
do
tvs1 <- sequenceA tvs
decs1 <- sequenceA decs
ctxt1 <- ctxt
pure $ ClassD ctxt1 cls tvs1 fds decs1
instanceD :: Quote m => m Cxt -> m Type -> [m Dec] -> m Dec
instanceD = instanceWithOverlapD Nothing
instanceWithOverlapD :: Quote m => Maybe Overlap -> m Cxt -> m Type -> [m Dec] -> m Dec
instanceWithOverlapD o ctxt ty decs =
do
ctxt1 <- ctxt
decs1 <- sequenceA decs
ty1 <- ty
pure $ InstanceD o ctxt1 ty1 decs1
sigD :: Quote m => Name -> m Type -> m Dec
sigD fun ty = liftA (SigD fun) $ ty
kiSigD :: Quote m => Name -> m Kind -> m Dec
kiSigD fun ki = liftA (KiSigD fun) $ ki
forImpD :: Quote m => Callconv -> Safety -> String -> Name -> m Type -> m Dec
forImpD cc s str n ty
= do ty' <- ty
pure $ ForeignD (ImportF cc s str n ty')
infixLD :: Quote m => Int -> Name -> m Dec
infixLD prec nm = pure (InfixD (Fixity prec InfixL) nm)
infixRD :: Quote m => Int -> Name -> m Dec
infixRD prec nm = pure (InfixD (Fixity prec InfixR) nm)
infixND :: Quote m => Int -> Name -> m Dec
infixND prec nm = pure (InfixD (Fixity prec InfixN) nm)
pragInlD :: Quote m => Name -> Inline -> RuleMatch -> Phases -> m Dec
pragInlD name inline rm phases
= pure $ PragmaD $ InlineP name inline rm phases
pragSpecD :: Quote m => Name -> m Type -> Phases -> m Dec
pragSpecD n ty phases
= do
ty1 <- ty
pure $ PragmaD $ SpecialiseP n ty1 Nothing phases
pragSpecInlD :: Quote m => Name -> m Type -> Inline -> Phases -> m Dec
pragSpecInlD n ty inline phases
= do
ty1 <- ty
pure $ PragmaD $ SpecialiseP n ty1 (Just inline) phases
pragSpecInstD :: Quote m => m Type -> m Dec
pragSpecInstD ty
= do
ty1 <- ty
pure $ PragmaD $ SpecialiseInstP ty1
pragRuleD :: Quote m => String -> Maybe [m (TyVarBndr ())] -> [m RuleBndr] -> m Exp -> m Exp
-> Phases -> m Dec
pragRuleD n ty_bndrs tm_bndrs lhs rhs phases
= do
ty_bndrs1 <- traverse sequenceA ty_bndrs
tm_bndrs1 <- sequenceA tm_bndrs
lhs1 <- lhs
rhs1 <- rhs
pure $ PragmaD $ RuleP n ty_bndrs1 tm_bndrs1 lhs1 rhs1 phases
pragAnnD :: Quote m => AnnTarget -> m Exp -> m Dec
pragAnnD target expr
= do
exp1 <- expr
pure $ PragmaD $ AnnP target exp1
pragLineD :: Quote m => Int -> String -> m Dec
pragLineD line file = pure $ PragmaD $ LineP line file
pragCompleteD :: Quote m => [Name] -> Maybe Name -> m Dec
pragCompleteD cls mty = pure $ PragmaD $ CompleteP cls mty
dataInstD :: Quote m => m Cxt -> (Maybe [m (TyVarBndr ())]) -> m Type -> Maybe (m Kind) -> [m Con]
-> [m DerivClause] -> m Dec
dataInstD ctxt mb_bndrs ty ksig cons derivs =
do
ctxt1 <- ctxt
mb_bndrs1 <- traverse sequenceA mb_bndrs
ty1 <- ty
ksig1 <- sequenceA ksig
cons1 <- sequenceA cons
derivs1 <- sequenceA derivs
pure (DataInstD ctxt1 mb_bndrs1 ty1 ksig1 cons1 derivs1)
newtypeInstD :: Quote m => m Cxt -> (Maybe [m (TyVarBndr ())]) -> m Type -> Maybe (m Kind) -> m Con
-> [m DerivClause] -> m Dec
newtypeInstD ctxt mb_bndrs ty ksig con derivs =
do
ctxt1 <- ctxt
mb_bndrs1 <- traverse sequenceA mb_bndrs
ty1 <- ty
ksig1 <- sequenceA ksig
con1 <- con
derivs1 <- sequenceA derivs
pure (NewtypeInstD ctxt1 mb_bndrs1 ty1 ksig1 con1 derivs1)
tySynInstD :: Quote m => m TySynEqn -> m Dec
tySynInstD eqn =
do
eqn1 <- eqn
pure (TySynInstD eqn1)
dataFamilyD :: Quote m => Name -> [m (TyVarBndr ())] -> Maybe (m Kind) -> m Dec
dataFamilyD tc tvs kind =
do tvs' <- sequenceA tvs
kind' <- sequenceA kind
pure $ DataFamilyD tc tvs' kind'
openTypeFamilyD :: Quote m => Name -> [m (TyVarBndr ())] -> m FamilyResultSig
-> Maybe InjectivityAnn -> m Dec
openTypeFamilyD tc tvs res inj =
do tvs' <- sequenceA tvs
res' <- res
pure $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj)
closedTypeFamilyD :: Quote m => Name -> [m (TyVarBndr ())] -> m FamilyResultSig
-> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec
closedTypeFamilyD tc tvs result injectivity eqns =
do tvs1 <- sequenceA tvs
result1 <- result
eqns1 <- sequenceA eqns
pure (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) eqns1)
roleAnnotD :: Quote m => Name -> [Role] -> m Dec
roleAnnotD name roles = pure $ RoleAnnotD name roles
standaloneDerivD :: Quote m => m Cxt -> m Type -> m Dec
standaloneDerivD = standaloneDerivWithStrategyD Nothing
standaloneDerivWithStrategyD :: Quote m => Maybe (m DerivStrategy) -> m Cxt -> m Type -> m Dec
standaloneDerivWithStrategyD mdsq ctxtq tyq =
do
mds <- sequenceA mdsq
ctxt <- ctxtq
ty <- tyq
pure $ StandaloneDerivD mds ctxt ty
defaultSigD :: Quote m => Name -> m Type -> m Dec
defaultSigD n tyq =
do
ty <- tyq
pure $ DefaultSigD n ty
patSynD :: Quote m => Name -> m PatSynArgs -> m PatSynDir -> m Pat -> m Dec
patSynD name args dir pat = do
args' <- args
dir' <- dir
pat' <- pat
pure (PatSynD name args' dir' pat')
patSynSigD :: Quote m => Name -> m Type -> m Dec
patSynSigD nm ty =
do ty' <- ty
pure $ PatSynSigD nm ty'
implicitParamBindD :: Quote m => String -> m Exp -> m Dec
implicitParamBindD n e =
do
e' <- e
pure $ ImplicitParamBindD n e'
tySynEqn :: Quote m => (Maybe [m (TyVarBndr ())]) -> m Type -> m Type -> m TySynEqn
tySynEqn mb_bndrs lhs rhs =
do
mb_bndrs1 <- traverse sequenceA mb_bndrs
lhs1 <- lhs
rhs1 <- rhs
pure (TySynEqn mb_bndrs1 lhs1 rhs1)
cxt :: Quote m => [m Pred] -> m Cxt
cxt = sequenceA
derivClause :: Quote m => Maybe (m DerivStrategy) -> [m Pred] -> m DerivClause
derivClause mds p = do mds' <- sequenceA mds
p' <- cxt p
pure $ DerivClause mds' p'
stockStrategy :: Quote m => m DerivStrategy
stockStrategy = pure StockStrategy
anyclassStrategy :: Quote m => m DerivStrategy
anyclassStrategy = pure AnyclassStrategy
newtypeStrategy :: Quote m => m DerivStrategy
newtypeStrategy = pure NewtypeStrategy
viaStrategy :: Quote m => m Type -> m DerivStrategy
viaStrategy = fmap ViaStrategy
normalC :: Quote m => Name -> [m BangType] -> m Con
normalC con strtys = liftA (NormalC con) $ sequenceA strtys
recC :: Quote m => Name -> [m VarBangType] -> m Con
recC con varstrtys = liftA (RecC con) $ sequenceA varstrtys
infixC :: Quote m => m (Bang, Type) -> Name -> m (Bang, Type) -> m Con
infixC st1 con st2 = do st1' <- st1
st2' <- st2
pure $ InfixC st1' con st2'
forallC :: Quote m => [m (TyVarBndr Specificity)] -> m Cxt -> m Con -> m Con
forallC ns ctxt con = do
ns' <- sequenceA ns
ctxt' <- ctxt
con' <- con
pure $ ForallC ns' ctxt' con'
gadtC :: Quote m => [Name] -> [m StrictType] -> m Type -> m Con
gadtC cons strtys ty = liftA2 (GadtC cons) (sequenceA strtys) ty
recGadtC :: Quote m => [Name] -> [m VarStrictType] -> m Type -> m Con
recGadtC cons varstrtys ty = liftA2 (RecGadtC cons) (sequenceA varstrtys) ty
forallT :: Quote m => [m (TyVarBndr Specificity)] -> m Cxt -> m Type -> m Type
forallT tvars ctxt ty = do
tvars1 <- sequenceA tvars
ctxt1 <- ctxt
ty1 <- ty
pure $ ForallT tvars1 ctxt1 ty1
forallVisT :: Quote m => [m (TyVarBndr ())] -> m Type -> m Type
forallVisT tvars ty = ForallVisT <$> sequenceA tvars <*> ty
varT :: Quote m => Name -> m Type
varT = pure . VarT
conT :: Quote m => Name -> m Type
conT = pure . ConT
infixT :: Quote m => m Type -> Name -> m Type -> m Type
infixT t1 n t2 = do t1' <- t1
t2' <- t2
pure (InfixT t1' n t2')
uInfixT :: Quote m => m Type -> Name -> m Type -> m Type
uInfixT t1 n t2 = do t1' <- t1
t2' <- t2
pure (UInfixT t1' n t2')
parensT :: Quote m => m Type -> m Type
parensT t = do t' <- t
pure (ParensT t')
appT :: Quote m => m Type -> m Type -> m Type
appT t1 t2 = do
t1' <- t1
t2' <- t2
pure $ AppT t1' t2'
appKindT :: Quote m => m Type -> m Kind -> m Type
appKindT ty ki = do
ty' <- ty
ki' <- ki
pure $ AppKindT ty' ki'
arrowT :: Quote m => m Type
arrowT = pure ArrowT
mulArrowT :: Quote m => m Type
mulArrowT = pure MulArrowT
listT :: Quote m => m Type
listT = pure ListT
litT :: Quote m => m TyLit -> m Type
litT l = fmap LitT l
tupleT :: Quote m => Int -> m Type
tupleT i = pure (TupleT i)
unboxedTupleT :: Quote m => Int -> m Type
unboxedTupleT i = pure (UnboxedTupleT i)
unboxedSumT :: Quote m => SumArity -> m Type
unboxedSumT arity = pure (UnboxedSumT arity)
sigT :: Quote m => m Type -> m Kind -> m Type
sigT t k
= do
t' <- t
k' <- k
pure $ SigT t' k'
equalityT :: Quote m => m Type
equalityT = pure EqualityT
wildCardT :: Quote m => m Type
wildCardT = pure WildCardT
implicitParamT :: Quote m => String -> m Type -> m Type
implicitParamT n t
= do
t' <- t
pure $ ImplicitParamT n t'
classP :: Quote m => Name -> [m Type] -> m Pred
classP cla tys
= do
tysl <- sequenceA tys
pure (foldl AppT (ConT cla) tysl)
equalP :: Quote m => m Type -> m Type -> m Pred
equalP tleft tright
= do
tleft1 <- tleft
tright1 <- tright
eqT <- equalityT
pure (foldl AppT eqT [tleft1, tright1])
promotedT :: Quote m => Name -> m Type
promotedT = pure . PromotedT
promotedTupleT :: Quote m => Int -> m Type
promotedTupleT i = pure (PromotedTupleT i)
promotedNilT :: Quote m => m Type
promotedNilT = pure PromotedNilT
promotedConsT :: Quote m => m Type
promotedConsT = pure PromotedConsT
noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: Quote m => m SourceUnpackedness
noSourceUnpackedness = pure NoSourceUnpackedness
sourceNoUnpack = pure SourceNoUnpack
sourceUnpack = pure SourceUnpack
noSourceStrictness, sourceLazy, sourceStrict :: Quote m => m SourceStrictness
noSourceStrictness = pure NoSourceStrictness
sourceLazy = pure SourceLazy
sourceStrict = pure SourceStrict
isStrict, notStrict, unpacked :: Quote m => m Strict
isStrict = bang noSourceUnpackedness sourceStrict
notStrict = bang noSourceUnpackedness noSourceStrictness
unpacked = bang sourceUnpack sourceStrict
bang :: Quote m => m SourceUnpackedness -> m SourceStrictness -> m Bang
bang u s = do u' <- u
s' <- s
pure (Bang u' s')
bangType :: Quote m => m Bang -> m Type -> m BangType
bangType = liftA2 (,)
varBangType :: Quote m => Name -> m BangType -> m VarBangType
varBangType v bt = (\(b, t) -> (v, b, t)) <$> bt
strictType :: Quote m => m Strict -> m Type -> m StrictType
strictType = bangType
varStrictType :: Quote m => Name -> m StrictType -> m VarStrictType
varStrictType = varBangType
numTyLit :: Quote m => Integer -> m TyLit
numTyLit n = if n >= 0 then pure (NumTyLit n)
else error ("Negative type-level number: " ++ show n)
strTyLit :: Quote m => String -> m TyLit
strTyLit s = pure (StrTyLit s)
plainTV :: Quote m => Name -> m (TyVarBndr ())
plainTV n = pure $ PlainTV n ()
plainInvisTV :: Quote m => Name -> Specificity -> m (TyVarBndr Specificity)
plainInvisTV n s = pure $ PlainTV n s
kindedTV :: Quote m => Name -> m Kind -> m (TyVarBndr ())
kindedTV n = fmap (KindedTV n ())
kindedInvisTV :: Quote m => Name -> Specificity -> m Kind -> m (TyVarBndr Specificity)
kindedInvisTV n s = fmap (KindedTV n s)
specifiedSpec :: Specificity
specifiedSpec = SpecifiedSpec
inferredSpec :: Specificity
inferredSpec = InferredSpec
varK :: Name -> Kind
varK = VarT
conK :: Name -> Kind
conK = ConT
tupleK :: Int -> Kind
tupleK = TupleT
arrowK :: Kind
arrowK = ArrowT
listK :: Kind
listK = ListT
appK :: Kind -> Kind -> Kind
appK = AppT
starK :: Quote m => m Kind
starK = pure StarT
constraintK :: Quote m => m Kind
constraintK = pure ConstraintT
noSig :: Quote m => m FamilyResultSig
noSig = pure NoSig
kindSig :: Quote m => m Kind -> m FamilyResultSig
kindSig = fmap KindSig
tyVarSig :: Quote m => m (TyVarBndr ()) -> m FamilyResultSig
tyVarSig = fmap TyVarSig
injectivityAnn :: Name -> [Name] -> InjectivityAnn
injectivityAnn = TH.InjectivityAnn
nominalR, representationalR, phantomR, inferR :: Role
nominalR = NominalR
representationalR = RepresentationalR
phantomR = PhantomR
inferR = InferR
cCall, stdCall, cApi, prim, javaScript :: Callconv
cCall = CCall
stdCall = StdCall
cApi = CApi
prim = Prim
javaScript = JavaScript
unsafe, safe, interruptible :: Safety
unsafe = Unsafe
safe = Safe
interruptible = Interruptible
funDep :: [Name] -> [Name] -> FunDep
funDep = FunDep
ruleVar :: Quote m => Name -> m RuleBndr
ruleVar = pure . RuleVar
typedRuleVar :: Quote m => Name -> m Type -> m RuleBndr
typedRuleVar n ty = TypedRuleVar n <$> ty
valueAnnotation :: Name -> AnnTarget
valueAnnotation = ValueAnnotation
typeAnnotation :: Name -> AnnTarget
typeAnnotation = TypeAnnotation
moduleAnnotation :: AnnTarget
moduleAnnotation = ModuleAnnotation
unidir, implBidir :: Quote m => m PatSynDir
unidir = pure Unidir
implBidir = pure ImplBidir
explBidir :: Quote m => [m Clause] -> m PatSynDir
explBidir cls = do
cls' <- sequenceA cls
pure (ExplBidir cls')
prefixPatSyn :: Quote m => [Name] -> m PatSynArgs
prefixPatSyn args = pure $ PrefixPatSyn args
recordPatSyn :: Quote m => [Name] -> m PatSynArgs
recordPatSyn sels = pure $ RecordPatSyn sels
infixPatSyn :: Quote m => Name -> Name -> m PatSynArgs
infixPatSyn arg1 arg2 = pure $ InfixPatSyn arg1 arg2
appsE :: Quote m => [m Exp] -> m Exp
appsE [] = error "appsE []"
appsE [x] = x
appsE (x:y:zs) = appsE ( (appE x y) : zs )
thisModule :: Q Module
thisModule = do
loc <- location
pure $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)