content: {-# OPTIONS_HADDOCK not-home #-}
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE PolyKinds #-}
  {-# LANGUAGE StandaloneKindSignatures #-}
  {-# LANGUAGE Trustworthy #-}
  
  -- |
  -- GHC.Internal.TH.Lib exposes some additional functionality that
  -- is used internally in GHC's integration with Template Haskell. This is not a
  -- part of the public API, and as such, there are no API guarantees for this
  -- module from version to version.
  
  -- Why do we have both GHC.Internal.TH.Lib and
  -- Language.Haskell.TH.Lib? Ultimately, it's because the functions in the
  -- former (which are tailored for GHC's use) need different type signatures
  -- than the ones in the latter. Syncing up the Internal type signatures would
  -- involve a massive amount of breaking changes, so for the time being, we
  -- relegate as many changes as we can to just the Internal module, where it
  -- is safe to break things.
  
  module GHC.Internal.TH.Lib where
  
  import GHC.Internal.TH.Syntax hiding (Role, InjectivityAnn)
  import GHC.Internal.TH.Monad
  import qualified GHC.Internal.TH.Syntax as TH
  
  #ifdef BOOTSTRAP_TH
  import Control.Applicative(liftA, Applicative(..))
  import qualified Data.Kind as Kind (Type)
  import Data.Word( Word8 )
  import Data.List.NonEmpty ( NonEmpty(..) )
  import GHC.Exts (TYPE)
  import Prelude hiding (Applicative(..))
  #else
  import GHC.Internal.Base hiding (NonEmpty (..), Type, Module, inline)
  import GHC.Internal.Data.Foldable
  import GHC.Internal.Data.Functor
  import GHC.Internal.Data.Maybe
  import GHC.Internal.Data.NonEmpty (NonEmpty(..))
  import GHC.Internal.Data.Traversable (traverse, sequenceA)
  import GHC.Internal.Integer
  import GHC.Internal.List (zip)
  import GHC.Internal.Real
  import GHC.Internal.Show
  import GHC.Internal.Word
  import qualified GHC.Internal.Types as Kind (Type)
  #endif
  
  ----------------------------------------------------------
  -- * Type synonyms
  ----------------------------------------------------------
  
  -- | Representation-polymorphic since /template-haskell-2.17.0.0/.
  type TExpQ :: TYPE r -> Kind.Type
  type TExpQ a = Q (TExp a)
  
  type CodeQ :: TYPE r -> Kind.Type
  type CodeQ = Code Q
  
  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] -- Defined as it is more convenient to wire-in
  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
  
  -- must be defined here for DsMeta to find it
  type Role                = TH.Role
  type InjectivityAnn      = TH.InjectivityAnn
  
  type TyVarBndrUnit       = TyVarBndr ()
  type TyVarBndrSpec       = TyVarBndr Specificity
  type TyVarBndrVis        = TyVarBndr BndrVis
  
  ----------------------------------------------------------
  -- * 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
  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 Type] -> [m Pat] -> m Pat
  conP n ts ps = do ps' <- sequenceA ps
                    ts' <- sequenceA ts
                    pure (ConP n ts' 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')
  typeP :: Quote m => m Type -> m Pat
  typeP t = do t' <- t
               pure (TypeP t')
  invisP :: Quote m => m Type -> m Pat
  invisP t = do t' <- t
                pure (InvisP t')
  viewP :: Quote m => m Exp -> m Pat -> m Pat
  viewP e p = do e' <- e
                 p' <- p
                 pure (ViewP e' p')
  
  orP :: Quote m => (NonEmpty (m Pat)) -> m Pat
  orP ps = do ps' <- sequenceA ps
              pure (OrP ps')
  
  fieldPat :: Quote m => Name -> m Pat -> m FieldPat
  fieldPat n p = do p' <- p
                    pure (n, p')
  
  
  -------------------------------------------------------------------------------
  -- *   Stmt
  
  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) }
  
  -------------------------------------------------------------------------------
  -- *   Range
  
  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) }
  -------------------------------------------------------------------------------
  -- *   Body
  
  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') }
  
  -------------------------------------------------------------------------------
  -- *   Guard
  
  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 and Clause
  
  -- | Use with 'caseE'
  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') }
  
  -- | Use with 'funD'
  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') }
  
  ---------------------------------------------------------------------------
  -- *   Exp
  
  -- | Dynamically binding a variable (unhygienic)
  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')
  
  -- | Single-arg lambda
  lam1E :: Quote m => m Pat -> m Exp -> m Exp
  lam1E p e = lamE [p] e
  
  -- | Lambda-case (@\case@)
  lamCaseE :: Quote m => [m Match] -> m Exp
  lamCaseE ms = LamCaseE <$> sequenceA ms
  
  -- | Lambda-cases (@\cases@)
  lamCasesE :: Quote m => [m Clause] -> m Exp
  lamCasesE ms = LamCasesE <$> 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 x = [| static x |]@
  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)
  
  getFieldE :: Quote m => m Exp -> String -> m Exp
  getFieldE e f = do
    e' <- e
    pure (GetFieldE e' f)
  
  projectionE :: Quote m => NonEmpty String -> m Exp
  projectionE xs = pure (ProjectionE xs)
  
  typedSpliceE :: Quote m => m Exp -> m Exp
  typedSpliceE = fmap TypedSpliceE
  
  typedBracketE :: Quote m => m Exp -> m Exp
  typedBracketE = fmap TypedBracketE
  
  -- ** 'arithSeqE' Shortcuts
  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)) }
  
  typeE :: Quote m => m Type -> m Exp
  typeE = fmap TypeE
  
  forallE :: Quote m => [m (TyVarBndr Specificity)] -> m Exp -> m Exp
  forallE tvars body = ForallE <$> sequenceA tvars <*> body
  
  forallVisE :: Quote m => [m (TyVarBndr ())] -> m Exp -> m Exp
  forallVisE tvars body = ForallVisE <$> sequenceA tvars <*> body
  
  constrainedE :: Quote m => [m Exp] -> m Exp -> m Exp
  constrainedE ctx body = ConstrainedE <$> sequenceA ctx <*> body
  
  -------------------------------------------------------------------------------
  -- *   Dec
  
  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 BndrVis)] -> 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 BndrVis)] -> 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 BndrVis)] -> 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)
  
  typeDataD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> [m Con]
        -> m Dec
  typeDataD tc tvs ksig cons =
    do
      tvs1    <- sequenceA tvs
      ksig1   <- sequenceA ksig
      cons1   <- sequenceA cons
      pure (TypeDataD tc tvs1 ksig1 cons1)
  
  classD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> [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 = infixLWithSpecD prec NoNamespaceSpecifier
  
  infixRD :: Quote m => Int -> Name -> m Dec
  infixRD prec = infixRWithSpecD prec NoNamespaceSpecifier
  
  infixND :: Quote m => Int -> Name -> m Dec
  infixND prec = infixNWithSpecD prec NoNamespaceSpecifier
  
  infixLWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec
  infixLWithSpecD prec ns_spec nm = pure (InfixD (Fixity prec InfixL) ns_spec nm)
  
  infixRWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec
  infixRWithSpecD prec ns_spec nm = pure (InfixD (Fixity prec InfixR) ns_spec nm)
  
  infixNWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec
  infixNWithSpecD prec ns_spec nm = pure (InfixD (Fixity prec InfixN) ns_spec nm)
  
  defaultD :: Quote m => [m Type] -> m Dec
  defaultD tys = DefaultD <$> sequenceA tys
  
  pragInlD :: Quote m => Name -> Inline -> RuleMatch -> Phases -> m Dec
  pragInlD name inline rm phases
    = pure $ PragmaD $ InlineP name inline rm phases
  
  pragOpaqueD :: Quote m => Name -> m Dec
  pragOpaqueD name = pure $ PragmaD $ OpaqueP name
  
  pragSpecED :: Quote m
             => Maybe [m (TyVarBndr ())] -> [m RuleBndr]
             -> m Exp
             -> Phases
             -> m Dec
  pragSpecED ty_bndrs tm_bndrs expr phases
    = do
        ty_bndrs1    <- traverse sequenceA ty_bndrs
        tm_bndrs1    <- sequenceA tm_bndrs
        expr1        <- expr
        pure $ PragmaD $ SpecialiseEP ty_bndrs1 tm_bndrs1 expr1 Nothing phases
  
  pragSpecInlED :: Quote m
                => Maybe [m (TyVarBndr ())] -> [m RuleBndr]
                -> m Exp
                -> Inline
                -> Phases
                -> m Dec
  pragSpecInlED ty_bndrs tm_bndrs expr inl phases
    = do
        ty_bndrs1    <- traverse sequenceA ty_bndrs
        tm_bndrs1    <- sequenceA tm_bndrs
        expr1        <- expr
        pure $ PragmaD $ SpecialiseEP ty_bndrs1 tm_bndrs1 expr1 (Just inl) 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
  
  pragSCCFunD :: Quote m => Name -> m Dec
  pragSCCFunD nm = pure $ PragmaD $ SCCP nm Nothing
  
  pragSCCFunNamedD :: Quote m => Name -> String -> m Dec
  pragSCCFunNamedD nm str = pure $ PragmaD $ SCCP nm (Just str)
  
  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 BndrVis)] -> 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 BndrVis)] -> 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 BndrVis)] -> 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
  
  -- | Pattern synonym declaration
  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')
  
  -- | Pattern synonym type signature
  patSynSigD :: Quote m => Name -> m Type -> m Dec
  patSynSigD nm ty =
    do ty' <- ty
       pure $ PatSynSigD nm ty'
  
  -- | Implicit parameter binding declaration. Can only be used in let
  -- and where clauses which consist entirely of implicit bindings.
  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
  
  -------------------------------------------------------------------------------
  -- *   Type
  
  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')
  
  promotedInfixT :: Quote m => m Type -> Name -> m Type -> m Type
  promotedInfixT t1 n t2 = do t1' <- t1
                              t2' <- t2
                              pure (PromotedInfixT t1' n t2')
  
  promotedUInfixT :: Quote m => m Type -> Name -> m Type -> m Type
  promotedUInfixT t1 n t2 = do t1' <- t1
                               t2' <- t2
                               pure (PromotedUInfixT 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'
  
  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
  
  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
  
  -- * Type Literals
  
  -- MonadFail here complicates things (a lot) because it would mean we would
  -- have to emit a MonadFail constraint during typechecking if there was any
  -- chance the desugaring would use numTyLit, which in general is hard to
  -- predict.
  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)
  
  charTyLit :: Quote m => Char -> m TyLit
  charTyLit c = pure (CharTyLit c)
  
  -------------------------------------------------------------------------------
  -- *   Kind
  
  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
  
  plainBndrTV :: Quote m => Name -> BndrVis -> m (TyVarBndr BndrVis)
  plainBndrTV n v = pure $ PlainTV n v
  
  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)
  
  kindedBndrTV :: Quote m => Name -> BndrVis -> m Kind -> m (TyVarBndr BndrVis)
  kindedBndrTV n v = fmap (KindedTV n v)
  
  specifiedSpec :: Specificity
  specifiedSpec = SpecifiedSpec
  
  inferredSpec :: Specificity
  inferredSpec = InferredSpec
  
  bndrReq :: BndrVis
  bndrReq = BndrReq
  
  bndrInvis :: BndrVis
  bndrInvis = BndrInvis
  
  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
  
  -------------------------------------------------------------------------------
  -- *   Type family result
  
  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
  
  -------------------------------------------------------------------------------
  -- *   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
  
  -------------------------------------------------------------------------------
  -- *   RuleBndr
  ruleVar :: Quote m => Name -> m RuleBndr
  ruleVar = pure . RuleVar
  
  typedRuleVar :: Quote m => Name -> m Type -> m RuleBndr
  typedRuleVar n ty = TypedRuleVar n <$> ty
  
  -------------------------------------------------------------------------------
  -- *   AnnTarget
  valueAnnotation ::  Name -> AnnTarget
  valueAnnotation = ValueAnnotation
  
  typeAnnotation ::  Name -> AnnTarget
  typeAnnotation = TypeAnnotation
  
  moduleAnnotation :: AnnTarget
  moduleAnnotation = ModuleAnnotation
  
  -------------------------------------------------------------------------------
  -- * Pattern Synonyms (sub constructs)
  
  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
  
  --------------------------------------------------------------
  -- * Useful helper function
  
  appsE :: Quote m => [m Exp] -> m Exp
  appsE [] = error "appsE []"
  appsE [x] = x
  appsE (x:y:zs) = appsE ( (appE x y) : zs )
  
  -- | pure the Module at the place of splicing.  Can be used as an
  -- input for 'reifyModule'.
  thisModule :: Q Module
  thisModule = do
    loc <- location
    pure $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)
  
  --------------------------------------------------------------
  -- * Documentation combinators
  
  -- | Attaches Haddock documentation to the declaration provided. Unlike
  -- 'putDoc', the names do not need to be in scope when calling this function so
  -- it can be used for quoted declarations and anything else currently being
  -- spliced.
  -- Not all declarations can have documentation attached to them. For those that
  -- can't, 'withDecDoc' will return it unchanged without any side effects.
  withDecDoc :: String -> Q Dec -> Q Dec
  withDecDoc doc dec = do
    dec' <- dec
    case doc_loc dec' of
      Just loc -> qAddModFinalizer $ qPutDoc loc doc
      Nothing  -> pure ()
    pure dec'
    where
      doc_loc (FunD n _)                                     = Just $ DeclDoc n
      doc_loc (ValD (VarP n) _ _)                            = Just $ DeclDoc n
      doc_loc (DataD _ n _ _ _ _)                            = Just $ DeclDoc n
      doc_loc (NewtypeD _ n _ _ _ _)                         = Just $ DeclDoc n
      doc_loc (TypeDataD n _ _ _)                            = Just $ DeclDoc n
      doc_loc (TySynD n _ _)                                 = Just $ DeclDoc n
      doc_loc (ClassD _ n _ _ _)                             = Just $ DeclDoc n
      doc_loc (SigD n _)                                     = Just $ DeclDoc n
      doc_loc (ForeignD (ImportF _ _ _ n _))                 = Just $ DeclDoc n
      doc_loc (ForeignD (ExportF _ _ n _))                   = Just $ DeclDoc n
      doc_loc (InfixD _ _ n)                                 = Just $ DeclDoc n
      doc_loc (DataFamilyD n _ _)                            = Just $ DeclDoc n
      doc_loc (OpenTypeFamilyD (TypeFamilyHead n _ _ _))     = Just $ DeclDoc n
      doc_loc (ClosedTypeFamilyD (TypeFamilyHead n _ _ _) _) = Just $ DeclDoc n
      doc_loc (PatSynD n _ _ _)                              = Just $ DeclDoc n
      doc_loc (PatSynSigD n _)                               = Just $ DeclDoc n
  
      -- For instances we just pass along the full type
      doc_loc (InstanceD _ _ t _)           = Just $ InstDoc t
      doc_loc (DataInstD _ _ t _ _ _)       = Just $ InstDoc t
      doc_loc (NewtypeInstD _ _ t _ _ _)    = Just $ InstDoc t
      doc_loc (TySynInstD (TySynEqn _ t _)) = Just $ InstDoc t
  
      -- Declarations that can't have documentation attached to
      -- ValDs that aren't a simple variable pattern
      doc_loc (ValD _ _ _)             = Nothing
      doc_loc (KiSigD _ _)             = Nothing
      doc_loc (PragmaD _)              = Nothing
      doc_loc (RoleAnnotD _ _)         = Nothing
      doc_loc (StandaloneDerivD _ _ _) = Nothing
      doc_loc (DefaultSigD _ _)        = Nothing
      doc_loc (ImplicitParamBindD _ _) = Nothing
      doc_loc (DefaultD _)             = Nothing
  
  -- | Variant of 'withDecDoc' that applies the same documentation to
  -- multiple declarations. Useful for documenting quoted declarations.
  withDecsDoc :: String -> Q [Dec] -> Q [Dec]
  withDecsDoc doc decs = decs >>= mapM (withDecDoc doc . pure)
  
  -- | Variant of 'funD' that attaches Haddock documentation.
  funD_doc :: Name -> [Q Clause]
           -> Maybe String -- ^ Documentation to attach to function
           -> [Maybe String] -- ^ Documentation to attach to arguments
           -> Q Dec
  funD_doc nm cs mfun_doc arg_docs = do
    qAddModFinalizer $ sequence_
      [putDoc (ArgDoc nm i) s | (i, Just s) <- zip [0..] arg_docs]
    let dec = funD nm cs
    case mfun_doc of
      Just fun_doc -> withDecDoc fun_doc dec
      Nothing -> funD nm cs
  
  -- | Variant of 'dataD' that attaches Haddock documentation.
  dataD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind)
            -> [(Q Con, Maybe String, [Maybe String])]
            -- ^ List of constructors, documentation for the constructor, and
            -- documentation for the arguments
            -> [Q DerivClause]
            -> Maybe String
            -- ^ Documentation to attach to the data declaration
            -> Q Dec
  dataD_doc ctxt tc tvs ksig cons_with_docs derivs mdoc = do
    qAddModFinalizer $ mapM_ docCons cons_with_docs
    let dec = dataD ctxt tc tvs ksig (map (\(con, _, _) -> con) cons_with_docs) derivs
    maybe dec (flip withDecDoc dec) mdoc
  
  -- | Variant of 'newtypeD' that attaches Haddock documentation.
  newtypeD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind)
               -> (Q Con, Maybe String, [Maybe String])
               -- ^ The constructor, documentation for the constructor, and
               -- documentation for the arguments
               -> [Q DerivClause]
               -> Maybe String
               -- ^ Documentation to attach to the newtype declaration
               -> Q Dec
  newtypeD_doc ctxt tc tvs ksig con_with_docs@(con, _, _) derivs mdoc = do
    qAddModFinalizer $ docCons con_with_docs
    let dec = newtypeD ctxt tc tvs ksig con derivs
    maybe dec (flip withDecDoc dec) mdoc
  
  -- | Variant of 'typeDataD' that attaches Haddock documentation.
  typeDataD_doc :: Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind)
            -> [(Q Con, Maybe String, [Maybe String])]
            -- ^ List of constructors, documentation for the constructor, and
            -- documentation for the arguments
            -> Maybe String
            -- ^ Documentation to attach to the data declaration
            -> Q Dec
  typeDataD_doc tc tvs ksig cons_with_docs mdoc = do
    qAddModFinalizer $ mapM_ docCons cons_with_docs
    let dec = typeDataD tc tvs ksig (map (\(con, _, _) -> con) cons_with_docs)
    maybe dec (flip withDecDoc dec) mdoc
  
  -- | Variant of 'dataInstD' that attaches Haddock documentation.
  dataInstD_doc :: Q Cxt -> (Maybe [Q (TyVarBndr ())]) -> Q Type -> Maybe (Q Kind)
                -> [(Q Con, Maybe String, [Maybe String])]
                -- ^ List of constructors, documentation for the constructor, and
                -- documentation for the arguments
                -> [Q DerivClause]
                -> Maybe String
                -- ^ Documentation to attach to the instance declaration
                -> Q Dec
  dataInstD_doc ctxt mb_bndrs ty ksig cons_with_docs derivs mdoc = do
    qAddModFinalizer $ mapM_ docCons cons_with_docs
    let dec = dataInstD ctxt mb_bndrs ty ksig (map (\(con, _, _) -> con) cons_with_docs)
                derivs
    maybe dec (flip withDecDoc dec) mdoc
  
  -- | Variant of 'newtypeInstD' that attaches Haddock documentation.
  newtypeInstD_doc :: Q Cxt -> (Maybe [Q (TyVarBndr ())]) -> Q Type
                   -> Maybe (Q Kind)
                   -> (Q Con, Maybe String, [Maybe String])
                   -- ^ The constructor, documentation for the constructor, and
                   -- documentation for the arguments
                   -> [Q DerivClause]
                   -> Maybe String
                   -- ^ Documentation to attach to the instance declaration
                   -> Q Dec
  newtypeInstD_doc ctxt mb_bndrs ty ksig con_with_docs@(con, _, _) derivs mdoc = do
    qAddModFinalizer $ docCons con_with_docs
    let dec = newtypeInstD ctxt mb_bndrs ty ksig con derivs
    maybe dec (flip withDecDoc dec) mdoc
  
  -- | Variant of 'patSynD' that attaches Haddock documentation.
  patSynD_doc :: Name -> Q PatSynArgs -> Q PatSynDir -> Q Pat
              -> Maybe String   -- ^ Documentation to attach to the pattern synonym
              -> [Maybe String] -- ^ Documentation to attach to the pattern arguments
              -> Q Dec
  patSynD_doc name args dir pat mdoc arg_docs = do
    qAddModFinalizer $ sequence_
      [putDoc (ArgDoc name i) s | (i, Just s) <- zip [0..] arg_docs]
    let dec = patSynD name args dir pat
    maybe dec (flip withDecDoc dec) mdoc
  
  -- | Document a data/newtype constructor with its arguments.
  docCons :: (Q Con, Maybe String, [Maybe String]) -> Q ()
  docCons (c, md, arg_docs) = do
    c' <- c
    -- Attach docs to the constructors
    sequence_ [ putDoc (DeclDoc nm) d | Just d <- [md], nm <- get_cons_names c' ]
    -- Attach docs to the arguments
    case c' of
      -- Record selector documentation isn't stored in the argument map,
      -- but in the declaration map instead
      RecC _ var_bang_types ->
        sequence_ [ putDoc (DeclDoc nm) arg_doc
                    | (Just arg_doc, (nm, _, _)) <- zip arg_docs var_bang_types
                  ]
      _ ->
        sequence_ [ putDoc (ArgDoc nm i) arg_doc
                      | nm <- get_cons_names c'
                      , (i, Just arg_doc) <- zip [0..] arg_docs
                  ]
  