template-haskell 2.12.0.0 → 2.13.0.0

raw patch · 8 files changed

+1035/−833 lines, 8 filesdep ~basedep ~ghc-boot-thPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, ghc-boot-th

API changes (from Hackage documentation)

Files

• Language/Haskell/TH.hs +1/−1
• Language/Haskell/TH/Lib.hs +44/−782
• Language/Haskell/TH/Lib/Internal.hs +888/−0
• Language/Haskell/TH/Ppr.hs +10/−11
• Language/Haskell/TH/PprLib.hs +1/−0
• Language/Haskell/TH/Syntax.hs +58/−26
• changelog.md +25/−1
• template-haskell.cabal +8/−12

@@ -73,7 +73,7 @@         SourceUnpackedness(..), SourceStrictness(..), DecidedStrictness(..),         Bang(..), Strict, Foreign(..), Callconv(..), Safety(..), Pragma(..),         Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..),-        FunDep(..), FamFlavour(..), TySynEqn(..), TypeFamilyHead(..),+        FunDep(..), TySynEqn(..), TypeFamilyHead(..),         Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,         PatSynDir(..), PatSynArgs(..),     -- ** Expressions

@@ -1,8 +1,13 @@ -- |--- TH.Lib contains lots of useful helper functions for+-- Language.Haskell.TH.Lib contains lots of useful helper functions for -- generating and manipulating Template Haskell terms -{-# LANGUAGE CPP #-}+-- Note: this module mostly re-exports functions from+-- Language.Haskell.TH.Lib.Internal, but if a change occurs to Template+-- Haskell which requires breaking the API offered in this module, we opt to+-- copy the old definition here, and make the changes in+-- Language.Haskell.TH.Lib.Internal. This way, we can retain backwards+-- compatibility while still allowing GHC to make changes as it needs.  module Language.Haskell.TH.Lib (     -- All of the exports from this module should@@ -11,11 +16,12 @@      -- * 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,+        InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, KindQ, TyVarBndrQ,+        TyLitQ, CxtQ, PredQ, DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ,+        StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ,+        BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ,+        FieldPatQ, RuleBndrQ, TySynEqnQ, PatSynDirQ, PatSynArgsQ,+        FamilyResultSigQ,      -- ** Constructors lifted to 'Q'     -- *** Literals@@ -31,7 +37,7 @@         normalB, guardedB, normalG, normalGE, patG, patGE, match, clause,      -- *** Expressions-        dyn, varE, unboundVarE, conE, litE, appE, appTypeE, uInfixE, parensE,+        dyn, varE, unboundVarE, labelE,  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,@@ -82,9 +88,8 @@     roleAnnotD,     -- **** Type Family / Data Family     dataFamilyD, openTypeFamilyD, closedTypeFamilyD, dataInstD,-    familyNoKindD, familyKindD, closedTypeFamilyNoKindD, closedTypeFamilyKindD,     newtypeInstD, tySynInstD,-    typeFam, dataFam, tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig,+    tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig,      -- **** Fixity     infixLD, infixRD, infixND,@@ -111,355 +116,45 @@     ) 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+import Language.Haskell.TH.Lib.Internal hiding+  ( tySynD+  , dataD+  , newtypeD+  , classD+  , dataInstD+  , newtypeInstD+  , dataFamilyD+  , openTypeFamilyD+  , closedTypeFamilyD+  , forallC -unboundVarE :: Name -> ExpQ-unboundVarE s = return (UnboundVarE s)+  , forallT+  , sigT --- ** 'arithSeqE' Shortcuts-fromE :: ExpQ -> ExpQ-fromE x = do { a <- x; return (ArithSeqE (FromR a)) }+  , plainTV+  , kindedTV+  , starK+  , constraintK -fromThenE :: ExpQ -> ExpQ -> ExpQ-fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }+  , noSig+  , kindSig+  , tyVarSig -fromToE :: ExpQ -> ExpQ -> ExpQ-fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }+  , Role+  , InjectivityAnn+  )+import Language.Haskell.TH.Syntax -fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ-fromThenToE x y z = do { a <- x; b <- y; c <- z;-                         return (ArithSeqE (FromThenToR a b c)) }+import Control.Monad (liftM2) +-- All definitions below represent the "old" API, since their definitions are+-- different in Language.Haskell.TH.Lib.Internal. Please think carefully before+-- deciding to change the APIs of the functions below, as they represent the+-- public API (as opposed to the Internal module, which has no API promises.)  ------------------------------------------------------------------------------- -- *   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) } @@ -488,78 +183,6 @@     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 =@@ -580,12 +203,6 @@     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@@ -601,112 +218,9 @@   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 @@ -716,145 +230,12 @@     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 @@ -864,24 +245,6 @@ 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 @@ -899,104 +262,3 @@  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)

@@ -0,0 +1,888 @@+-- |+-- Language.Haskell.TH.Lib.Internal 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 Language.Haskell.TH.Lib.Internal 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 Language.Haskell.TH.Lib.Internal 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 KindQ               = Q Kind+type TyVarBndrQ          = Q TyVarBndr+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++-- 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)++labelE :: String -> ExpQ+labelE s = return (LabelE 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 -> [TyVarBndrQ] -> TypeQ -> DecQ+tySynD tc tvs rhs =+  do { tvs1 <- sequenceA tvs+     ; rhs1 <- rhs+     ; return (TySynD tc tvs1 rhs1)+     }++dataD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> [ConQ]+      -> [DerivClauseQ] -> DecQ+dataD ctxt tc tvs ksig cons derivs =+  do+    ctxt1   <- ctxt+    tvs1    <- sequenceA tvs+    ksig1   <- sequenceA ksig+    cons1   <- sequence cons+    derivs1 <- sequence derivs+    return (DataD ctxt1 tc tvs1 ksig1 cons1 derivs1)++newtypeD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> ConQ+         -> [DerivClauseQ] -> DecQ+newtypeD ctxt tc tvs ksig con derivs =+  do+    ctxt1   <- ctxt+    tvs1    <- sequenceA tvs+    ksig1   <- sequenceA ksig+    con1    <- con+    derivs1 <- sequence derivs+    return (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1)++classD :: CxtQ -> Name -> [TyVarBndrQ] -> [FunDep] -> [DecQ] -> DecQ+classD ctxt cls tvs fds decs =+  do+    tvs1  <- sequenceA tvs+    decs1 <- sequenceA decs+    ctxt1 <- ctxt+    return $ ClassD ctxt1 cls tvs1 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 KindQ -> [ConQ]+          -> [DerivClauseQ] -> DecQ+dataInstD ctxt tc tys ksig cons derivs =+  do+    ctxt1   <- ctxt+    tys1    <- sequenceA tys+    ksig1   <- sequenceA ksig+    cons1   <- sequenceA cons+    derivs1 <- sequenceA derivs+    return (DataInstD ctxt1 tc tys1 ksig1 cons1 derivs1)++newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe KindQ -> ConQ+             -> [DerivClauseQ] -> DecQ+newtypeInstD ctxt tc tys ksig con derivs =+  do+    ctxt1   <- ctxt+    tys1    <- sequenceA tys+    ksig1   <- sequenceA ksig+    con1    <- con+    derivs1 <- sequence derivs+    return (NewtypeInstD ctxt1 tc tys1 ksig1 con1 derivs1)++tySynInstD :: Name -> TySynEqnQ -> DecQ+tySynInstD tc eqn =+  do+    eqn1 <- eqn+    return (TySynInstD tc eqn1)++dataFamilyD :: Name -> [TyVarBndrQ] -> Maybe KindQ -> DecQ+dataFamilyD tc tvs kind =+  do tvs'  <- sequenceA tvs+     kind' <- sequenceA kind+     return $ DataFamilyD tc tvs' kind'++openTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ+                -> Maybe InjectivityAnn -> DecQ+openTypeFamilyD tc tvs res inj =+  do tvs' <- sequenceA tvs+     res' <- res+     return $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj)++closedTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ+                  -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ+closedTypeFamilyD tc tvs result injectivity eqns =+  do tvs1    <- sequenceA tvs+     result1 <- result+     eqns1   <- sequenceA eqns+     return (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) 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 :: [TyVarBndrQ] -> CxtQ -> ConQ -> ConQ+forallC ns ctxt con = do+  ns'   <- sequenceA ns+  ctxt' <- ctxt+  con'  <- con+  pure $ 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 :: [TyVarBndrQ] -> CxtQ -> TypeQ -> TypeQ+forallT tvars ctxt ty = do+    tvars1 <- sequenceA tvars+    ctxt1  <- ctxt+    ty1    <- ty+    return $ ForallT tvars1 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 -> KindQ -> TypeQ+sigT t k+  = do+      t' <- t+      k' <- k+      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 -> TyVarBndrQ+plainTV = pure . PlainTV++kindedTV :: Name -> KindQ -> TyVarBndrQ+kindedTV n = fmap (KindedTV n)++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 :: KindQ+starK = pure StarT++constraintK :: KindQ+constraintK = pure ConstraintT++-------------------------------------------------------------------------------+-- *   Type family result++noSig :: FamilyResultSigQ+noSig = pure NoSig++kindSig :: KindQ -> FamilyResultSigQ+kindSig = fmap KindSig++tyVarSig :: TyVarBndrQ -> FamilyResultSigQ+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 :: 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)

@@ -14,6 +14,7 @@ import GHC.Show  ( showMultiLineString ) import GHC.Lexeme( startsVarSym ) import Data.Ratio ( numerator, denominator )+import Prelude hiding ((<>))  nestDepth :: Int nestDepth = 4@@ -143,6 +144,7 @@ pprExp _ (InfixE me1 op me2) = parens $ pprMaybeExp noPrec me1                                     <+> pprInfixExp op                                     <+> pprMaybeExp noPrec me2+pprExp i (LamE [] e) = pprExp i e -- #13856 pprExp i (LamE ps e) = parensIf (i > noPrec) $ char '\\' <> hsep (map (pprPat appPrec) ps)                                            <+> text "->" <+> ppr e pprExp i (LamCaseE ms) = parensIf (i > noPrec)@@ -150,7 +152,7 @@ pprExp _ (TupE es) = parens (commaSep es) pprExp _ (UnboxedTupE es) = hashParens (commaSep es) pprExp _ (UnboxedSumE e alt arity) = unboxedSumBars (ppr e) alt arity--- Nesting in Cond is to avoid potential problems in do statments+-- Nesting in Cond is to avoid potential problems in do statements pprExp i (CondE guard true false)  = parensIf (i > noPrec) $ sep [text "if"   <+> ppr guard,                        nest 1 $ text "then" <+> ppr true,@@ -198,6 +200,7 @@ pprExp i (StaticE e) = parensIf (i >= appPrec) $                          text "static"<+> pprExp appPrec e pprExp _ (UnboundVarE v) = pprName' Applied v+pprExp _ (LabelE s) = text "#" <> text s  pprFields :: [(Name,Exp)] -> Doc pprFields = sep . punctuate comma . map (\(s,e) -> ppr s <+> equals <+> ppr e)@@ -397,7 +400,7 @@ ppr_data maybeInst ctxt t argsDoc ksig cs decs   = sep [text "data" <+> maybeInst             <+> pprCxt ctxt-            <+> ppr t <+> argsDoc <+> ksigDoc <+> maybeWhere,+            <+> pprName' Applied t <+> argsDoc <+> ksigDoc <+> maybeWhere,          nest nestDepth (sep (pref $ map ppr cs)),          if null decs            then empty@@ -463,11 +466,6 @@     ppr_list xs = bar <+> commaSep xs  -------------------------------instance Ppr FamFlavour where-    ppr DataFam = text "data"-    ppr TypeFam = text "type"-------------------------------- instance Ppr FamilyResultSig where     ppr NoSig           = empty     ppr (KindSig k)     = dcolon <+> ppr k@@ -677,8 +675,9 @@  ------------------------------ pprParendType :: Type -> Doc-pprParendType (VarT v)            = ppr v-pprParendType (ConT c)            = ppr c+pprParendType (VarT v)            = pprName' Applied v+-- `Applied` is used here instead of `ppr` because of infix names (#13887)+pprParendType (ConT c)            = pprName' Applied c pprParendType (TupleT 0)          = text "()" pprParendType (TupleT n)          = parens (hcat (replicate (n-1) comma)) pprParendType (UnboxedTupleT n)   = hashParens $ hcat $ replicate (n-1) comma@@ -686,11 +685,11 @@ pprParendType ArrowT              = parens (text "->") pprParendType ListT               = text "[]" pprParendType (LitT l)            = pprTyLit l-pprParendType (PromotedT c)       = text "'" <> ppr c+pprParendType (PromotedT c)       = text "'" <> pprName' Applied c pprParendType (PromotedTupleT 0)  = text "'()" pprParendType (PromotedTupleT n)  = quoteParens (hcat (replicate (n-1) comma)) pprParendType PromotedNilT        = text "'[]"-pprParendType PromotedConsT       = text "(':)"+pprParendType PromotedConsT       = text "'(:)" pprParendType StarT               = char '*' pprParendType ConstraintT         = text "Constraint" pprParendType (SigT ty k)         = parens (ppr ty <+> text "::" <+> ppr k)

@@ -41,6 +41,7 @@ import Control.Monad (liftM, liftM2, ap) import Language.Haskell.TH.Lib.Map ( Map ) import qualified Language.Haskell.TH.Lib.Map as Map ( lookup, insert, empty )+import Prelude hiding ((<>))  infixl 6 <>  infixl 6 <+>

@@ -1,14 +1,10 @@-{-# LANGUAGE CPP, DeriveDataTypeable,+{-# LANGUAGE DeriveDataTypeable,              DeriveGeneric, FlexibleInstances, DefaultSignatures,              RankNTypes, RoleAnnotations, ScopedTypeVariables,              Trustworthy #-}  {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} -#if MIN_VERSION_base(4,9,0)-# define HAS_MONADFAIL 1-#endif- ----------------------------------------------------------------------------- -- | -- Module      :  Language.Haskell.Syntax@@ -34,6 +30,7 @@ import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) import Control.Monad (liftM)+import Control.Monad.IO.Class (MonadIO (..)) import System.IO        ( hPutStrLn, stderr ) import Data.Char        ( isAlpha, isAlphaNum, isUpper ) import Data.Int@@ -45,9 +42,7 @@ import Language.Haskell.TH.LanguageExtensions import Numeric.Natural -#if HAS_MONADFAIL import qualified Control.Monad.Fail as Fail-#endif  ----------------------------------------------------- --@@ -55,11 +50,7 @@ -- ----------------------------------------------------- -#if HAS_MONADFAIL-class Fail.MonadFail m => Quasi m where-#else-class Monad m => Quasi m where-#endif+class (MonadIO m, Fail.MonadFail m) => Quasi m where   qNewName :: String -> m Name         -- ^ Fresh names @@ -88,6 +79,7 @@   qLocation :: m Loc    qRunIO :: IO a -> m a+  qRunIO = liftIO   -- ^ Input/output (dangerous)    qAddDependentFile :: FilePath -> m ()@@ -98,6 +90,8 @@    qAddModFinalizer :: Q () -> m () +  qAddCorePlugin :: String -> m ()+   qGetQ :: Typeable a => m (Maybe a)    qPutQ :: Typeable a => a -> m ()@@ -137,13 +131,12 @@   qAddTopDecls _        = badIO "addTopDecls"   qAddForeignFile _ _   = badIO "addForeignFile"   qAddModFinalizer _    = badIO "addModFinalizer"+  qAddCorePlugin _      = badIO "addCorePlugin"   qGetQ                 = badIO "getQ"   qPutQ _               = badIO "putQ"   qIsExtEnabled _       = badIO "isExtEnabled"   qExtsEnabled          = badIO "extsEnabled" -  qRunIO m = m- badIO :: String -> IO a badIO op = do   { qReport True ("Can't do `" ++ op ++ "' in the IO monad")                 ; fail "Template Haskell failure" }@@ -179,14 +172,10 @@ instance Monad Q where   Q m >>= k  = Q (m >>= \x -> unQ (k x))   (>>) = (*>)-#if !HAS_MONADFAIL-  fail s     = report True s >> Q (fail "Q monad failure")-#else   fail       = Fail.fail  instance Fail.MonadFail Q where   fail s     = report True s >> Q (Fail.fail "Q monad failure")-#endif  instance Functor Q where   fmap f (Q x) = Q (fmap f x)@@ -490,6 +479,16 @@ addModFinalizer :: Q () -> Q () addModFinalizer act = Q (qAddModFinalizer (unQ act)) +-- | Adds a core plugin to the compilation pipeline.+--+-- @addCorePlugin m@ has almost the same effect as passing @-fplugin=m@ to ghc+-- in the command line. The major difference is that the plugin module @m@+-- must not belong to the current package. When TH executes, it is too late+-- to tell the compiler that we needed to compile first a plugin module in the+-- current package.+addCorePlugin :: String -> Q ()+addCorePlugin plugin = Q (qAddCorePlugin plugin)+ -- | Get state from the 'Q' monad. Note that the state is local to the -- Haskell module in which the Template Haskell expression is executed. getQ :: Typeable a => Q (Maybe a)@@ -508,6 +507,9 @@ extsEnabled :: Q [Extension] extsEnabled = Q qExtsEnabled +instance MonadIO Q where+  liftIO = runIO+ instance Quasi Q where   qNewName            = newName   qReport             = report@@ -521,11 +523,11 @@   qReifyConStrictness = reifyConStrictness   qLookupName         = lookupName   qLocation           = location-  qRunIO              = runIO   qAddDependentFile   = addDependentFile   qAddTopDecls        = addTopDecls   qAddForeignFile     = addForeignFile   qAddModFinalizer    = addModFinalizer+  qAddCorePlugin      = addCorePlugin   qGetQ               = getQ   qPutQ               = putQ   qIsExtEnabled       = isExtEnabled@@ -563,6 +565,9 @@ -- Template Haskell has no way of knowing what value @x@ will take on at -- splice-time, so it requires the type of @x@ to be an instance of 'Lift'. --+-- A 'Lift' instance must satisfy @$(lift x) ≡ x@ for all @x@, where @$(...)@+-- is a Template Haskell splice.+-- -- 'Lift' instances can be derived automatically by use of the @-XDeriveLift@ -- GHC language extension: --@@ -1538,7 +1543,7 @@   | ConE Name                          -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2  @   | LitE Lit                           -- ^ @{ 5 or \'c\'}@   | AppE Exp Exp                       -- ^ @{ f x }@-  | AppTypeE Exp Type                  -- ^ @{ f \@Int }+  | AppTypeE Exp Type                  -- ^ @{ f \@Int }@    | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@ @@ -1582,6 +1587,7 @@   | RecUpdE Exp [FieldExp]             -- ^ @{ (f x) { z = w } }@   | StaticE Exp                        -- ^ @{ static e }@   | UnboundVarE Name                   -- ^ @{ _x }@ (hole)+  | LabelE String                      -- ^ @{ #x }@ ( Overloaded label )   deriving( Show, Eq, Ord, Data, Generic )  type FieldExp = (Name,Exp)@@ -1770,9 +1776,6 @@ data FunDep = FunDep [Name] [Name]   deriving( Show, Eq, Ord, Data, Generic ) -data FamFlavour = TypeFam | DataFam-  deriving( Show, Eq, Ord, Data, Generic )- data Foreign = ImportF Callconv Safety String Name Type              | ExportF Callconv        String Name Type          deriving( Show, Eq, Ord, Data, Generic )@@ -1844,6 +1847,35 @@                        | DecidedUnpack         deriving (Show, Eq, Ord, Data, Generic) +-- | A single data constructor.+--+-- The constructors for 'Con' can roughly be divided up into two categories:+-- those for constructors with \"vanilla\" syntax ('NormalC', 'RecC', and+-- 'InfixC'), and those for constructors with GADT syntax ('GadtC' and+-- 'RecGadtC'). The 'ForallC' constructor, which quantifies additional type+-- variables and class contexts, can surround either variety of constructor.+-- However, the type variables that it quantifies are different depending+-- on what constructor syntax is used:+--+-- * If a 'ForallC' surrounds a constructor with vanilla syntax, then the+--   'ForallC' will only quantify /existential/ type variables. For example:+--+--   @+--   data Foo a = forall b. MkFoo a b+--   @+--+--   In @MkFoo@, 'ForallC' will quantify @b@, but not @a@.+--+-- * If a 'ForallC' surrounds a constructor with GADT syntax, then the+--   'ForallC' will quantify /all/ type variables used in the constructor.+--   For example:+--+--   @+--   data Bar a b where+--     MkBar :: (a ~ b) => c -> MkBar a b+--   @+--+--   In @MkBar@, 'ForallC' will quantify @a@, @b@, and @c@. data Con = NormalC Name [BangType]       -- ^ @C Int a@          | RecC Name [VarBangType]       -- ^ @C { v :: Int, w :: a }@          | InfixC BangType Name BangType -- ^ @Int :+ a@@@ -1916,7 +1948,7 @@   | RecordPatSyn [Name]        -- ^ @pattern P { {x,y,z} } = p@   deriving( Show, Eq, Ord, Data, Generic ) -data Type = ForallT [TyVarBndr] Cxt Type  -- ^ @forall \<vars\>. \<ctxt\> -> \<type\>@+data Type = ForallT [TyVarBndr] Cxt Type  -- ^ @forall \<vars\>. \<ctxt\> => \<type\>@           | AppT Type Type                -- ^ @T a b@           | SigT Type Kind                -- ^ @t :: k@           | VarT Name                     -- ^ @a@@@ -1941,7 +1973,7 @@           | StarT                         -- ^ @*@           | ConstraintT                   -- ^ @Constraint@           | LitT TyLit                    -- ^ @0,1,2, etc.@-          | WildCardT                     -- ^ @_,+          | WildCardT                     -- ^ @_@       deriving( Show, Eq, Ord, Data, Generic )  data TyVarBndr = PlainTV  Name            -- ^ @a@@@ -1959,7 +1991,7 @@   deriving ( Show, Eq, Ord, Data, Generic )  data TyLit = NumTyLit Integer             -- ^ @2@-           | StrTyLit String              -- ^ @"Hello"@+           | StrTyLit String              -- ^ @\"Hello\"@   deriving ( Show, Eq, Ord, Data, Generic )  -- | Role annotations

@@ -1,8 +1,30 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.13.0.0 *March 2018*++  * Bundled with GHC 8.4.1++  * `Language.Haskell.TH.FamFlavour`, which was deprecated in 2.11,+    has been removed.++  * Add support for overloaded labels. Introduces `labelE :: String -> ExpQ`.++  * Add `KindQ`, `TyVarBndrQ`, and `FamilyResultSigQ` aliases to+    `Language.Haskell.TH.Lib`.++  * Add `Language.Haskell.TH.Lib.Internal` module, which 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.++  * `MonadIO` is now a superclass of `Quasi`, `qRunIO` has a default+    implementation `qRunIO = liftIO`++  * Add `MonadIO Q` instance+ ## 2.12.0.0 *July 2017* -  * Bundled with GHC 8.2.1.+  * Bundled with GHC 8.2.1    * Add support for pattern synonyms. This introduces one new constructor to     `Info` (`PatSynI`), two new constructors to `Dec` (`PatSynD` and@@ -31,6 +53,8 @@     - `plainTV` and `kindedTV`     - `interruptible` and `funDep`     - `valueAnnotation`, `typeAnnotation`, and `moduleAnnotation`++  * Add support for overloaded labels.  ## 2.11.0.0  *May 2016* 

@@ -1,5 +1,5 @@ name:           template-haskell-version:        2.12.0.0+version:        2.13.0.0 -- NOTE: Don't forget to update ./changelog.md license:        BSD3 license-file:   LICENSE@@ -45,22 +45,18 @@         Language.Haskell.TH.Syntax         Language.Haskell.TH.LanguageExtensions +        Language.Haskell.TH.Lib.Internal+     other-modules:         Language.Haskell.TH.Lib.Map      build-depends:-        base        >= 4.8 && < 4.11,-        ghc-boot-th == 8.2.*,+        base        >= 4.9 && < 4.12,+        ghc-boot-th == 8.4.*,         pretty      == 1.1.* -    -- We need to set the unit ID to template-haskell (without a-    -- version number) as it's magic.     ghc-options: -Wall -    if impl( ghc >= 7.11 )-        ghc-options:  -this-unit-id template-haskell-    else-        if impl( ghc >= 7.9 )-            ghc-options:  -this-package-key template-haskell-        else-            ghc-options:  -package-name template-haskell+    -- We need to set the unit ID to template-haskell (without a+    -- version number) as it's magic.+    ghc-options: -this-unit-id template-haskell