-- | -- TH.Lib contains lots of useful helper functions for -- generating and manipulating Template Haskell terms {-# LANGUAGE CPP #-} module Language.Haskell.TH.Lib ( -- All of the exports from this module should -- be "public" functions. The main module TH -- re-exports them all. -- * Library functions -- ** Abbreviations InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ, DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ, StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ, BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ, FieldPatQ, RuleBndrQ, TySynEqnQ, PatSynDirQ, PatSynArgsQ, -- ** Constructors lifted to 'Q' -- *** Literals intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL, charL, stringL, stringPrimL, charPrimL, -- *** Patterns litP, varP, tupP, unboxedTupP, unboxedSumP, conP, uInfixP, parensP, infixP, tildeP, bangP, asP, wildP, recP, listP, sigP, viewP, fieldPat, -- *** Pattern Guards normalB, guardedB, normalG, normalGE, patG, patGE, match, clause, -- *** Expressions dyn, varE, unboundVarE, conE, litE, appE, appTypeE, uInfixE, parensE, staticE, infixE, infixApp, sectionL, sectionR, lamE, lam1E, lamCaseE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE, letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp, -- **** Ranges fromE, fromThenE, fromToE, fromThenToE, -- ***** Ranges with more indirection arithSeqE, fromR, fromThenR, fromToR, fromThenToR, -- **** Statements doE, compE, bindS, letS, noBindS, parS, -- *** Types forallT, varT, conT, appT, arrowT, infixT, uInfixT, parensT, equalityT, listT, tupleT, unboxedTupleT, unboxedSumT, sigT, litT, wildCardT, promotedT, promotedTupleT, promotedNilT, promotedConsT, -- **** Type literals numTyLit, strTyLit, -- **** Strictness noSourceUnpackedness, sourceNoUnpack, sourceUnpack, noSourceStrictness, sourceLazy, sourceStrict, isStrict, notStrict, unpacked, bang, bangType, varBangType, strictType, varStrictType, -- **** Class Contexts cxt, classP, equalP, -- **** Constructors normalC, recC, infixC, forallC, gadtC, recGadtC, -- *** Kinds varK, conK, tupleK, arrowK, listK, appK, starK, constraintK, -- *** Type variable binders plainTV, kindedTV, -- *** Roles nominalR, representationalR, phantomR, inferR, -- *** Top Level Declarations -- **** Data valD, funD, tySynD, dataD, newtypeD, derivClause, DerivClause(..), DerivStrategy(..), -- **** Class classD, instanceD, instanceWithOverlapD, Overlap(..), sigD, standaloneDerivD, standaloneDerivWithStrategyD, defaultSigD, -- **** Role annotations roleAnnotD, -- **** Type Family / Data Family dataFamilyD, openTypeFamilyD, closedTypeFamilyD, dataInstD, familyNoKindD, familyKindD, closedTypeFamilyNoKindD, closedTypeFamilyKindD, newtypeInstD, tySynInstD, typeFam, dataFam, tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig, -- **** Fixity infixLD, infixRD, infixND, -- **** Foreign Function Interface (FFI) cCall, stdCall, cApi, prim, javaScript, unsafe, safe, interruptible, forImpD, -- **** Functional dependencies funDep, -- **** Pragmas ruleVar, typedRuleVar, valueAnnotation, typeAnnotation, moduleAnnotation, pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD, pragLineD, pragCompleteD, -- **** Pattern Synonyms patSynD, patSynSigD, unidir, implBidir, explBidir, prefixPatSyn, infixPatSyn, recordPatSyn, -- ** Reify thisModule ) where import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn) import qualified Language.Haskell.TH.Syntax as TH import Control.Monad( liftM, liftM2 ) import Data.Word( Word8 ) ---------------------------------------------------------- -- * Type synonyms ---------------------------------------------------------- type InfoQ = Q Info type PatQ = Q Pat type FieldPatQ = Q FieldPat type ExpQ = Q Exp type TExpQ a = Q (TExp a) type DecQ = Q Dec type DecsQ = Q [Dec] type ConQ = Q Con type TypeQ = Q Type 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 -- must be defined here for DsMeta to find it type Role = TH.Role type InjectivityAnn = TH.InjectivityAnn ---------------------------------------------------------- -- * Lowercase pattern syntax functions ---------------------------------------------------------- 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 rationalL :: Rational -> Lit rationalL = RationalL litP :: Lit -> PatQ litP l = return (LitP l) varP :: Name -> PatQ varP v = return (VarP v) tupP :: [PatQ] -> PatQ tupP ps = do { ps1 <- sequence ps; return (TupP ps1)} unboxedTupP :: [PatQ] -> PatQ unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)} unboxedSumP :: PatQ -> SumAlt -> SumArity -> PatQ unboxedSumP p alt arity = do { p1 <- p; return (UnboxedSumP p1 alt arity) } conP :: Name -> [PatQ] -> PatQ conP n ps = do ps' <- sequence ps return (ConP n ps') infixP :: PatQ -> Name -> PatQ -> PatQ infixP p1 n p2 = do p1' <- p1 p2' <- p2 return (InfixP p1' n p2') uInfixP :: PatQ -> Name -> PatQ -> PatQ uInfixP p1 n p2 = do p1' <- p1 p2' <- p2 return (UInfixP p1' n p2') parensP :: PatQ -> PatQ parensP p = do p' <- p return (ParensP p') tildeP :: PatQ -> PatQ tildeP p = do p' <- p return (TildeP p') bangP :: PatQ -> PatQ bangP p = do p' <- p return (BangP p') asP :: Name -> PatQ -> PatQ asP n p = do p' <- p return (AsP n p') wildP :: PatQ wildP = return WildP recP :: Name -> [FieldPatQ] -> PatQ recP n fps = do fps' <- sequence fps return (RecP n fps') listP :: [PatQ] -> PatQ listP ps = do ps' <- sequence ps return (ListP ps') sigP :: PatQ -> TypeQ -> PatQ sigP p t = do p' <- p t' <- t return (SigP p' t') viewP :: ExpQ -> PatQ -> PatQ viewP e p = do e' <- e p' <- p return (ViewP e' p') fieldPat :: Name -> PatQ -> FieldPatQ fieldPat n p = do p' <- p return (n, p') ------------------------------------------------------------------------------- -- * Stmt bindS :: PatQ -> ExpQ -> StmtQ bindS p e = liftM2 BindS p e letS :: [DecQ] -> StmtQ letS ds = do { ds1 <- sequence ds; return (LetS ds1) } noBindS :: ExpQ -> StmtQ noBindS e = do { e1 <- e; return (NoBindS e1) } parS :: [[StmtQ]] -> StmtQ parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) } ------------------------------------------------------------------------------- -- * Range fromR :: ExpQ -> RangeQ fromR x = do { a <- x; return (FromR a) } fromThenR :: ExpQ -> ExpQ -> RangeQ fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) } fromToR :: ExpQ -> ExpQ -> RangeQ fromToR x y = do { a <- x; b <- y; return (FromToR a b) } fromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ fromThenToR x y z = do { a <- x; b <- y; c <- z; return (FromThenToR a b c) } ------------------------------------------------------------------------------- -- * Body normalB :: ExpQ -> BodyQ normalB e = do { e1 <- e; return (NormalB e1) } guardedB :: [Q (Guard,Exp)] -> BodyQ guardedB ges = do { ges' <- sequence ges; return (GuardedB ges') } ------------------------------------------------------------------------------- -- * Guard normalG :: ExpQ -> GuardQ normalG e = do { e1 <- e; return (NormalG e1) } normalGE :: ExpQ -> ExpQ -> Q (Guard, Exp) normalGE g e = do { g1 <- g; e1 <- e; return (NormalG g1, e1) } patG :: [StmtQ] -> GuardQ patG ss = do { ss' <- sequence ss; return (PatG ss') } patGE :: [StmtQ] -> ExpQ -> Q (Guard, Exp) patGE ss e = do { ss' <- sequence ss; e' <- e; return (PatG ss', e') } ------------------------------------------------------------------------------- -- * Match and Clause -- | Use with 'caseE' match :: PatQ -> BodyQ -> [DecQ] -> MatchQ match p rhs ds = do { p' <- p; r' <- rhs; ds' <- sequence ds; return (Match p' r' ds') } -- | Use with 'funD' clause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ clause ps r ds = do { ps' <- sequence ps; r' <- r; ds' <- sequence ds; return (Clause ps' r' ds') } --------------------------------------------------------------------------- -- * Exp -- | Dynamically binding a variable (unhygenic) dyn :: String -> ExpQ dyn s = return (VarE (mkName s)) varE :: Name -> ExpQ varE s = return (VarE s) conE :: Name -> ExpQ conE s = return (ConE s) litE :: Lit -> ExpQ litE c = return (LitE c) appE :: ExpQ -> ExpQ -> ExpQ appE x y = do { a <- x; b <- y; return (AppE a b)} appTypeE :: ExpQ -> TypeQ -> ExpQ appTypeE x t = do { a <- x; s <- t; return (AppTypeE a s) } parensE :: ExpQ -> ExpQ parensE x = do { x' <- x; return (ParensE x') } uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ uInfixE x s y = do { x' <- x; s' <- s; y' <- y; return (UInfixE x' s' y') } infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y; return (InfixE (Just a) s' (Just b))} infixE Nothing s (Just y) = do { s' <- s; b <- y; return (InfixE Nothing s' (Just b))} infixE (Just x) s Nothing = do { a <- x; s' <- s; return (InfixE (Just a) s' Nothing)} infixE Nothing s Nothing = do { s' <- s; return (InfixE Nothing s' Nothing) } infixApp :: ExpQ -> ExpQ -> ExpQ -> ExpQ infixApp x y z = infixE (Just x) y (Just z) sectionL :: ExpQ -> ExpQ -> ExpQ sectionL x y = infixE (Just x) y Nothing sectionR :: ExpQ -> ExpQ -> ExpQ sectionR x y = infixE Nothing x (Just y) lamE :: [PatQ] -> ExpQ -> ExpQ lamE ps e = do ps' <- sequence ps e' <- e return (LamE ps' e') -- | Single-arg lambda lam1E :: PatQ -> ExpQ -> ExpQ lam1E p e = lamE [p] e lamCaseE :: [MatchQ] -> ExpQ lamCaseE ms = sequence ms >>= return . LamCaseE tupE :: [ExpQ] -> ExpQ tupE es = do { es1 <- sequence es; return (TupE es1)} unboxedTupE :: [ExpQ] -> ExpQ unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)} unboxedSumE :: ExpQ -> SumAlt -> SumArity -> ExpQ unboxedSumE e alt arity = do { e1 <- e; return (UnboxedSumE e1 alt arity) } condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ condE x y z = do { a <- x; b <- y; c <- z; return (CondE a b c)} multiIfE :: [Q (Guard, Exp)] -> ExpQ multiIfE alts = sequence alts >>= return . MultiIfE letE :: [DecQ] -> ExpQ -> ExpQ letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) } caseE :: ExpQ -> [MatchQ] -> ExpQ caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) } doE :: [StmtQ] -> ExpQ doE ss = do { ss1 <- sequence ss; return (DoE ss1) } compE :: [StmtQ] -> ExpQ compE ss = do { ss1 <- sequence ss; return (CompE ss1) } arithSeqE :: RangeQ -> ExpQ arithSeqE r = do { r' <- r; return (ArithSeqE r') } listE :: [ExpQ] -> ExpQ listE es = do { es1 <- sequence es; return (ListE es1) } sigE :: ExpQ -> TypeQ -> ExpQ sigE e t = do { e1 <- e; t1 <- t; return (SigE e1 t1) } recConE :: Name -> [Q (Name,Exp)] -> ExpQ recConE c fs = do { flds <- sequence fs; return (RecConE c flds) } recUpdE :: ExpQ -> [Q (Name,Exp)] -> ExpQ recUpdE e fs = do { e1 <- e; flds <- sequence fs; return (RecUpdE e1 flds) } stringE :: String -> ExpQ stringE = litE . stringL fieldExp :: Name -> ExpQ -> Q (Name, Exp) fieldExp s e = do { e' <- e; return (s,e') } -- | @staticE x = [| static x |]@ staticE :: ExpQ -> ExpQ staticE = fmap StaticE unboundVarE :: Name -> ExpQ unboundVarE s = return (UnboundVarE s) -- ** 'arithSeqE' Shortcuts fromE :: ExpQ -> ExpQ fromE x = do { a <- x; return (ArithSeqE (FromR a)) } fromThenE :: ExpQ -> ExpQ -> ExpQ fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) } fromToE :: ExpQ -> ExpQ -> ExpQ fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) } fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ fromThenToE x y z = do { a <- x; b <- y; c <- z; return (ArithSeqE (FromThenToR a b c)) } ------------------------------------------------------------------------------- -- * Dec valD :: PatQ -> BodyQ -> [DecQ] -> DecQ valD p b ds = do { p' <- p ; ds' <- sequence ds ; b' <- b ; return (ValD p' b' ds') } funD :: Name -> [ClauseQ] -> DecQ funD nm cs = do { cs1 <- sequence cs ; return (FunD nm cs1) } tySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) } dataD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> [ConQ] -> [DerivClauseQ] -> DecQ dataD ctxt tc tvs ksig cons derivs = do ctxt1 <- ctxt cons1 <- sequence cons derivs1 <- sequence derivs return (DataD ctxt1 tc tvs ksig cons1 derivs1) newtypeD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> ConQ -> [DerivClauseQ] -> DecQ newtypeD ctxt tc tvs ksig con derivs = do ctxt1 <- ctxt con1 <- con derivs1 <- sequence derivs return (NewtypeD ctxt1 tc tvs ksig con1 derivs1) classD :: CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [DecQ] -> DecQ classD ctxt cls tvs fds decs = do decs1 <- sequence decs ctxt1 <- ctxt return $ ClassD ctxt1 cls tvs fds decs1 instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ instanceD = instanceWithOverlapD Nothing instanceWithOverlapD :: Maybe Overlap -> CxtQ -> TypeQ -> [DecQ] -> DecQ instanceWithOverlapD o ctxt ty decs = do ctxt1 <- ctxt decs1 <- sequence decs ty1 <- ty return $ InstanceD o ctxt1 ty1 decs1 sigD :: Name -> TypeQ -> DecQ sigD fun ty = liftM (SigD fun) $ ty forImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ forImpD cc s str n ty = do ty' <- ty return $ ForeignD (ImportF cc s str n ty') infixLD :: Int -> Name -> DecQ infixLD prec nm = return (InfixD (Fixity prec InfixL) nm) infixRD :: Int -> Name -> DecQ infixRD prec nm = return (InfixD (Fixity prec InfixR) nm) infixND :: Int -> Name -> DecQ infixND prec nm = return (InfixD (Fixity prec InfixN) nm) pragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ pragInlD name inline rm phases = return $ PragmaD $ InlineP name inline rm phases pragSpecD :: Name -> TypeQ -> Phases -> DecQ pragSpecD n ty phases = do ty1 <- ty return $ PragmaD $ SpecialiseP n ty1 Nothing phases pragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ pragSpecInlD n ty inline phases = do ty1 <- ty return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases pragSpecInstD :: TypeQ -> DecQ pragSpecInstD ty = do ty1 <- ty return $ PragmaD $ SpecialiseInstP ty1 pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ pragRuleD n bndrs lhs rhs phases = do bndrs1 <- sequence bndrs lhs1 <- lhs rhs1 <- rhs return $ PragmaD $ RuleP n bndrs1 lhs1 rhs1 phases pragAnnD :: AnnTarget -> ExpQ -> DecQ pragAnnD target expr = do exp1 <- expr return $ PragmaD $ AnnP target exp1 pragLineD :: Int -> String -> DecQ pragLineD line file = return $ PragmaD $ LineP line file pragCompleteD :: [Name] -> Maybe Name -> DecQ pragCompleteD cls mty = return $ PragmaD $ CompleteP cls mty dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> [DerivClauseQ] -> DecQ dataInstD ctxt tc tys ksig cons derivs = do ctxt1 <- ctxt tys1 <- sequence tys cons1 <- sequence cons derivs1 <- sequence derivs return (DataInstD ctxt1 tc tys1 ksig cons1 derivs1) newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> ConQ -> [DerivClauseQ] -> DecQ newtypeInstD ctxt tc tys ksig con derivs = do ctxt1 <- ctxt tys1 <- sequence tys con1 <- con derivs1 <- sequence derivs return (NewtypeInstD ctxt1 tc tys1 ksig con1 derivs1) tySynInstD :: Name -> TySynEqnQ -> DecQ tySynInstD tc eqn = do eqn1 <- eqn return (TySynInstD tc eqn1) dataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ dataFamilyD tc tvs kind = return $ DataFamilyD tc tvs kind openTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig -> Maybe InjectivityAnn -> DecQ openTypeFamilyD tc tvs res inj = return $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj) closedTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ closedTypeFamilyD tc tvs result injectivity eqns = do eqns1 <- sequence eqns return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1) -- These were deprecated in GHC 8.0 with a plan to remove them in 8.2. If you -- remove this check please also: -- 1. remove deprecated functions -- 2. remove CPP language extension from top of this module -- 3. remove the FamFlavour data type from Syntax module -- 4. make sure that all references to FamFlavour are gone from DsMeta, -- Convert, TcSplice (follows from 3) #if __GLASGOW_HASKELL__ >= 804 #error Remove deprecated familyNoKindD, familyKindD, closedTypeFamilyNoKindD and closedTypeFamilyKindD #endif {-# DEPRECATED familyNoKindD, familyKindD "This function will be removed in the next stable release. Use openTypeFamilyD/dataFamilyD instead." #-} familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ familyNoKindD flav tc tvs = case flav of TypeFam -> return $ OpenTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing) DataFam -> return $ DataFamilyD tc tvs Nothing familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ familyKindD flav tc tvs k = case flav of TypeFam -> return $ OpenTypeFamilyD (TypeFamilyHead tc tvs (KindSig k) Nothing) DataFam -> return $ DataFamilyD tc tvs (Just k) {-# DEPRECATED closedTypeFamilyNoKindD, closedTypeFamilyKindD "This function will be removed in the next stable release. Use closedTypeFamilyD instead." #-} closedTypeFamilyNoKindD :: Name -> [TyVarBndr] -> [TySynEqnQ] -> DecQ closedTypeFamilyNoKindD tc tvs eqns = do eqns1 <- sequence eqns return (ClosedTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing) eqns1) closedTypeFamilyKindD :: Name -> [TyVarBndr] -> Kind -> [TySynEqnQ] -> DecQ closedTypeFamilyKindD tc tvs kind eqns = do eqns1 <- sequence eqns return (ClosedTypeFamilyD (TypeFamilyHead tc tvs (KindSig kind) Nothing) eqns1) roleAnnotD :: Name -> [Role] -> DecQ roleAnnotD name roles = return $ RoleAnnotD name roles standaloneDerivD :: CxtQ -> TypeQ -> DecQ standaloneDerivD = standaloneDerivWithStrategyD Nothing standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ standaloneDerivWithStrategyD ds ctxtq tyq = do ctxt <- ctxtq ty <- tyq return $ StandaloneDerivD ds ctxt ty defaultSigD :: Name -> TypeQ -> DecQ defaultSigD n tyq = do ty <- tyq return $ DefaultSigD n ty -- | Pattern synonym declaration patSynD :: Name -> PatSynArgsQ -> PatSynDirQ -> PatQ -> DecQ patSynD name args dir pat = do args' <- args dir' <- dir pat' <- pat return (PatSynD name args' dir' pat') -- | Pattern synonym type signature patSynSigD :: Name -> TypeQ -> DecQ patSynSigD nm ty = do ty' <- ty return $ PatSynSigD nm ty' tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ tySynEqn lhs rhs = do lhs1 <- sequence lhs rhs1 <- rhs return (TySynEqn lhs1 rhs1) cxt :: [PredQ] -> CxtQ cxt = sequence derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ derivClause ds p = do p' <- cxt p return $ DerivClause ds p' normalC :: Name -> [BangTypeQ] -> ConQ normalC con strtys = liftM (NormalC con) $ sequence strtys recC :: Name -> [VarBangTypeQ] -> ConQ recC con varstrtys = liftM (RecC con) $ sequence varstrtys infixC :: Q (Bang, Type) -> Name -> Q (Bang, Type) -> ConQ infixC st1 con st2 = do st1' <- st1 st2' <- st2 return $ InfixC st1' con st2' forallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ forallC ns ctxt con = liftM2 (ForallC ns) ctxt con gadtC :: [Name] -> [StrictTypeQ] -> TypeQ -> ConQ gadtC cons strtys ty = liftM2 (GadtC cons) (sequence strtys) ty recGadtC :: [Name] -> [VarStrictTypeQ] -> TypeQ -> ConQ recGadtC cons varstrtys ty = liftM2 (RecGadtC cons) (sequence varstrtys) ty ------------------------------------------------------------------------------- -- * Type forallT :: [TyVarBndr] -> CxtQ -> TypeQ -> TypeQ forallT tvars ctxt ty = do ctxt1 <- ctxt ty1 <- ty return $ ForallT tvars ctxt1 ty1 varT :: Name -> TypeQ varT = return . VarT conT :: Name -> TypeQ conT = return . ConT infixT :: TypeQ -> Name -> TypeQ -> TypeQ infixT t1 n t2 = do t1' <- t1 t2' <- t2 return (InfixT t1' n t2') uInfixT :: TypeQ -> Name -> TypeQ -> TypeQ uInfixT t1 n t2 = do t1' <- t1 t2' <- t2 return (UInfixT t1' n t2') parensT :: TypeQ -> TypeQ parensT t = do t' <- t return (ParensT t') appT :: TypeQ -> TypeQ -> TypeQ appT t1 t2 = do t1' <- t1 t2' <- t2 return $ AppT t1' t2' arrowT :: TypeQ arrowT = return ArrowT listT :: TypeQ listT = return ListT litT :: TyLitQ -> TypeQ litT l = fmap LitT l tupleT :: Int -> TypeQ tupleT i = return (TupleT i) unboxedTupleT :: Int -> TypeQ unboxedTupleT i = return (UnboxedTupleT i) unboxedSumT :: SumArity -> TypeQ unboxedSumT arity = return (UnboxedSumT arity) sigT :: TypeQ -> Kind -> TypeQ sigT t k = do t' <- t return $ SigT t' k equalityT :: TypeQ equalityT = return EqualityT wildCardT :: TypeQ wildCardT = return WildCardT {-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-} classP :: Name -> [Q Type] -> Q Pred classP cla tys = do tysl <- sequence tys return (foldl AppT (ConT cla) tysl) {-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-} equalP :: TypeQ -> TypeQ -> PredQ equalP tleft tright = do tleft1 <- tleft tright1 <- tright eqT <- equalityT return (foldl AppT eqT [tleft1, tright1]) promotedT :: Name -> TypeQ promotedT = return . PromotedT promotedTupleT :: Int -> TypeQ promotedTupleT i = return (PromotedTupleT i) promotedNilT :: TypeQ promotedNilT = return PromotedNilT promotedConsT :: TypeQ promotedConsT = return PromotedConsT noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: SourceUnpackednessQ noSourceUnpackedness = return NoSourceUnpackedness sourceNoUnpack = return SourceNoUnpack sourceUnpack = return SourceUnpack noSourceStrictness, sourceLazy, sourceStrict :: SourceStrictnessQ noSourceStrictness = return NoSourceStrictness sourceLazy = return SourceLazy sourceStrict = return SourceStrict {-# DEPRECATED isStrict ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ", "Example usage: 'bang noSourceUnpackedness sourceStrict'"] #-} {-# DEPRECATED notStrict ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ", "Example usage: 'bang noSourceUnpackedness noSourceStrictness'"] #-} {-# DEPRECATED unpacked ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ", "Example usage: 'bang sourceUnpack sourceStrict'"] #-} isStrict, notStrict, unpacked :: Q Strict isStrict = bang noSourceUnpackedness sourceStrict notStrict = bang noSourceUnpackedness noSourceStrictness unpacked = bang sourceUnpack sourceStrict bang :: SourceUnpackednessQ -> SourceStrictnessQ -> BangQ bang u s = do u' <- u s' <- s return (Bang u' s') bangType :: BangQ -> TypeQ -> BangTypeQ bangType = liftM2 (,) varBangType :: Name -> BangTypeQ -> VarBangTypeQ varBangType v bt = do (b, t) <- bt return (v, b, t) {-# DEPRECATED strictType "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'bangType' instead." #-} strictType :: Q Strict -> TypeQ -> StrictTypeQ strictType = bangType {-# DEPRECATED varStrictType "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'varBangType' instead." #-} varStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ varStrictType = varBangType -- * Type Literals numTyLit :: Integer -> TyLitQ numTyLit n = if n >= 0 then return (NumTyLit n) else fail ("Negative type-level number: " ++ show n) strTyLit :: String -> TyLitQ strTyLit s = return (StrTyLit s) ------------------------------------------------------------------------------- -- * Kind plainTV :: Name -> TyVarBndr plainTV = PlainTV kindedTV :: Name -> Kind -> TyVarBndr kindedTV = KindedTV 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 :: Kind starK = StarT constraintK :: Kind constraintK = ConstraintT ------------------------------------------------------------------------------- -- * Type family result noSig :: FamilyResultSig noSig = NoSig kindSig :: Kind -> FamilyResultSig kindSig = KindSig tyVarSig :: TyVarBndr -> FamilyResultSig tyVarSig = TyVarSig ------------------------------------------------------------------------------- -- * Injectivity annotation injectivityAnn :: Name -> [Name] -> InjectivityAnn injectivityAnn = TH.InjectivityAnn ------------------------------------------------------------------------------- -- * Role nominalR, representationalR, phantomR, inferR :: Role nominalR = NominalR representationalR = RepresentationalR phantomR = PhantomR inferR = InferR ------------------------------------------------------------------------------- -- * Callconv cCall, stdCall, cApi, prim, javaScript :: Callconv cCall = CCall stdCall = StdCall cApi = CApi prim = Prim javaScript = JavaScript ------------------------------------------------------------------------------- -- * Safety unsafe, safe, interruptible :: Safety unsafe = Unsafe safe = Safe interruptible = Interruptible ------------------------------------------------------------------------------- -- * FunDep funDep :: [Name] -> [Name] -> FunDep funDep = FunDep ------------------------------------------------------------------------------- -- * FamFlavour typeFam, dataFam :: FamFlavour typeFam = TypeFam dataFam = DataFam ------------------------------------------------------------------------------- -- * RuleBndr ruleVar :: Name -> RuleBndrQ ruleVar = return . RuleVar typedRuleVar :: Name -> TypeQ -> RuleBndrQ typedRuleVar n ty = ty >>= return . TypedRuleVar n ------------------------------------------------------------------------------- -- * AnnTarget valueAnnotation :: Name -> AnnTarget valueAnnotation = ValueAnnotation typeAnnotation :: Name -> AnnTarget typeAnnotation = TypeAnnotation moduleAnnotation :: AnnTarget moduleAnnotation = ModuleAnnotation ------------------------------------------------------------------------------- -- * Pattern Synonyms (sub constructs) unidir, implBidir :: PatSynDirQ unidir = return Unidir implBidir = return ImplBidir explBidir :: [ClauseQ] -> PatSynDirQ explBidir cls = do cls' <- sequence cls return (ExplBidir cls') prefixPatSyn :: [Name] -> PatSynArgsQ prefixPatSyn args = return $ PrefixPatSyn args recordPatSyn :: [Name] -> PatSynArgsQ recordPatSyn sels = return $ RecordPatSyn sels infixPatSyn :: Name -> Name -> PatSynArgsQ infixPatSyn arg1 arg2 = return $ InfixPatSyn arg1 arg2 -------------------------------------------------------------- -- * Useful helper function appsE :: [ExpQ] -> ExpQ appsE [] = error "appsE []" appsE [x] = x appsE (x:y:zs) = appsE ( (appE x y) : zs ) -- | Return the Module at the place of splicing. Can be used as an -- input for 'reifyModule'. thisModule :: Q Module thisModule = do loc <- location return $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)