Language/Haskell/TH/Lib.hs

    -- |
    -- 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)