Overloaded Quotation Brackets (#246)

This patch implements overloaded quotation brackets which generalise the
desugaring of all quotation forms in terms of a new minimal interface.

The main change is that a quotation, for example, [e| 5 |], will now
have type `Quote m => m Exp` rather than `Q Exp`. The `Quote` typeclass
contains a single method for generating new names which is used when
desugaring binding structures.

The return type of functions from the `Lift` type class, `lift` and `liftTyped` have
been restricted to `forall m . Quote m => m Exp` rather than returning a
result in a Q monad.

More details about the feature can be read in the GHC proposal.

https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0246-overloaded-bracket.rst

5 files changed, 490 insertions, 457 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs
index 5b03b2649c..b818535576 100644
--- a/libraries/template-haskell/Language/Haskell/TH.hs
+++ b/libraries/template-haskell/Language/Haskell/TH.hs
@@ -8,6 +8,7 @@ module Language.Haskell.TH(
         -- * The monad and its operations
         Q,
         runQ,
+        Quote(..),
         -- ** Administration: errors, locations and IO
         reportError,              -- :: String -> Q ()
         reportWarning,            -- :: String -> Q ()
@@ -53,7 +54,6 @@ module Language.Haskell.TH(
         Name, NameSpace,        -- Abstract
         -- ** Constructing names
         mkName,         -- :: String -> Name
-        newName,        -- :: String -> Q Name
         -- ** Deconstructing names
         nameBase,       -- :: Name -> String
         nameModule,     -- :: Name -> Maybe String
@@ -84,7 +84,7 @@ module Language.Haskell.TH(
         Pat(..), FieldExp, FieldPat,
     -- ** Types
         Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..),
-        FamilyResultSig(..), Syntax.InjectivityAnn(..), PatSynType,
+        FamilyResultSig(..), Syntax.InjectivityAnn(..), PatSynType, BangType, VarBangType,
 
     -- * Library functions
     module Language.Haskell.TH.Lib,
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index 7bb4eb50dd..77c85d907c 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -159,7 +159,7 @@ import Language.Haskell.TH.Lib.Internal hiding
   )
 import Language.Haskell.TH.Syntax
 
-import Control.Monad (liftM2)
+import Control.Applicative ( liftA2 )
 import Foreign.ForeignPtr
 import Data.Word
 import Prelude
@@ -172,97 +172,97 @@ import Prelude
 -------------------------------------------------------------------------------
 -- *   Dec
 
-tySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ
+tySynD :: Quote m => Name -> [TyVarBndr] -> m Type -> m Dec
 tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) }
 
-dataD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]
-      -> DecQ
+dataD :: Quote m => m Cxt -> Name -> [TyVarBndr] -> Maybe Kind -> [m Con] -> [m DerivClause]
+      -> m Dec
 dataD ctxt tc tvs ksig cons derivs =
   do
     ctxt1 <- ctxt
-    cons1 <- sequence cons
-    derivs1 <- sequence derivs
+    cons1 <- sequenceA cons
+    derivs1 <- sequenceA derivs
     return (DataD ctxt1 tc tvs ksig cons1 derivs1)
 
-newtypeD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> ConQ -> [DerivClauseQ]
-         -> DecQ
+newtypeD :: Quote m => m Cxt -> Name -> [TyVarBndr] -> Maybe Kind -> m Con -> [m DerivClause]
+         -> m Dec
 newtypeD ctxt tc tvs ksig con derivs =
   do
     ctxt1 <- ctxt
     con1 <- con
-    derivs1 <- sequence derivs
+    derivs1 <- sequenceA derivs
     return (NewtypeD ctxt1 tc tvs ksig con1 derivs1)
 
-classD :: CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [DecQ] -> DecQ
+classD :: Quote m => m Cxt -> Name -> [TyVarBndr] -> [FunDep] -> [m Dec] -> m Dec
 classD ctxt cls tvs fds decs =
   do
-    decs1 <- sequence decs
+    decs1 <- sequenceA decs
     ctxt1 <- ctxt
     return $ ClassD ctxt1 cls tvs fds decs1
 
-pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ
+pragRuleD :: Quote m => String -> [m RuleBndr] -> m Exp -> m Exp -> Phases -> m Dec
 pragRuleD n bndrs lhs rhs phases
   = do
-      bndrs1 <- sequence bndrs
+      bndrs1 <- sequenceA bndrs
       lhs1   <- lhs
       rhs1   <- rhs
       return $ PragmaD $ RuleP n Nothing bndrs1 lhs1 rhs1 phases
 
-dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]
-          -> DecQ
+dataInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> [m Con] -> [m DerivClause]
+          -> m Dec
 dataInstD ctxt tc tys ksig cons derivs =
   do
     ctxt1 <- ctxt
     ty1 <- foldl appT (conT tc) tys
-    cons1 <- sequence cons
-    derivs1 <- sequence derivs
+    cons1 <- sequenceA cons
+    derivs1 <- sequenceA derivs
     return (DataInstD ctxt1 Nothing ty1 ksig cons1 derivs1)
 
-newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> ConQ -> [DerivClauseQ]
-             -> DecQ
+newtypeInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> m Con -> [m DerivClause]
+             -> m Dec
 newtypeInstD ctxt tc tys ksig con derivs =
   do
     ctxt1 <- ctxt
     ty1 <- foldl appT (conT tc) tys
     con1  <- con
-    derivs1 <- sequence derivs
+    derivs1 <- sequenceA derivs
     return (NewtypeInstD ctxt1 Nothing ty1 ksig con1 derivs1)
 
-dataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ
+dataFamilyD :: Quote m => Name -> [TyVarBndr] -> Maybe Kind -> m Dec
 dataFamilyD tc tvs kind
-    = return $ DataFamilyD tc tvs kind
+    = pure $ DataFamilyD tc tvs kind
 
-openTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig
-                -> Maybe InjectivityAnn -> DecQ
+openTypeFamilyD :: Quote m => Name -> [TyVarBndr] -> FamilyResultSig
+                -> Maybe InjectivityAnn -> m Dec
 openTypeFamilyD tc tvs res inj
-    = return $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj)
+    = pure $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj)
 
-closedTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig
-                  -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ
+closedTypeFamilyD :: Quote m => Name -> [TyVarBndr] -> FamilyResultSig
+                  -> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec
 closedTypeFamilyD tc tvs result injectivity eqns =
-  do eqns1 <- sequence eqns
+  do eqns1 <- sequenceA eqns
      return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)
 
-tySynEqn :: (Maybe [TyVarBndr]) -> TypeQ -> TypeQ -> TySynEqnQ
+tySynEqn :: Quote m => (Maybe [TyVarBndr]) -> m Type -> m Type -> m TySynEqn
 tySynEqn tvs lhs rhs =
   do
     lhs1 <- lhs
     rhs1 <- rhs
     return (TySynEqn tvs lhs1 rhs1)
 
-forallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ
-forallC ns ctxt con = liftM2 (ForallC ns) ctxt con
+forallC :: Quote m => [TyVarBndr] -> m Cxt -> m Con -> m Con
+forallC ns ctxt con = liftA2 (ForallC ns) ctxt con
 
 -------------------------------------------------------------------------------
 -- *   Type
 
-forallT :: [TyVarBndr] -> CxtQ -> TypeQ -> TypeQ
+forallT :: Quote m => [TyVarBndr] -> m Cxt -> m Type -> m Type
 forallT tvars ctxt ty = do
     ctxt1 <- ctxt
     ty1   <- ty
     return $ ForallT tvars ctxt1 ty1
 
-sigT :: TypeQ -> Kind -> TypeQ
+sigT :: Quote m => m Type -> Kind -> m Type
 sigT t k
   = do
       t' <- t
@@ -298,12 +298,12 @@ tyVarSig = TyVarSig
 -------------------------------------------------------------------------------
 -- * Top Level Declarations
 
-derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ
+derivClause :: Quote m => Maybe DerivStrategy -> [m Pred] -> m DerivClause
 derivClause mds p = do
   p' <- cxt p
   return $ DerivClause mds p'
 
-standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ
+standaloneDerivWithStrategyD :: Quote m => Maybe DerivStrategy -> m Cxt -> m Type -> m Dec
 standaloneDerivWithStrategyD mds ctxt ty = do
   ctxt' <- ctxt
   ty'   <- ty
@@ -326,8 +326,8 @@ mkBytes = Bytes
 -------------------------------------------------------------------------------
 -- * Tuple expressions
 
-tupE :: [ExpQ] -> ExpQ
-tupE es = do { es1 <- sequence es; return (TupE $ map Just es1)}
+tupE :: Quote m => [m Exp] -> m Exp
+tupE es = do { es1 <- sequenceA es; return (TupE $ map Just es1)}
 
-unboxedTupE :: [ExpQ] -> ExpQ
-unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE $ map Just es1)}
+unboxedTupE :: Quote m => [m Exp] -> m Exp
+unboxedTupE es = do { es1 <- sequenceA es; return (UnboxedTupE $ map Just es1)}
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
index 4d3887baf2..3a55f7a96a 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
@@ -16,7 +16,7 @@ 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 Control.Applicative(liftA, liftA2)
 import Data.Word( Word8 )
 import Prelude
 
@@ -31,6 +31,7 @@ type ExpQ                = Q Exp
 type TExpQ a             = Q (TExp a)
 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
@@ -91,675 +92,675 @@ bytesPrimL = BytesPrimL
 rationalL   :: Rational -> Lit
 rationalL   = RationalL
 
-litP :: Lit -> PatQ
-litP l = return (LitP l)
+litP :: Quote m => Lit -> m Pat
+litP l = pure (LitP l)
 
-varP :: Name -> PatQ
-varP v = return (VarP v)
+varP :: Quote m => Name -> m Pat
+varP v = pure (VarP v)
 
-tupP :: [PatQ] -> PatQ
-tupP ps = do { ps1 <- sequence ps; return (TupP ps1)}
+tupP :: Quote m => [m Pat] -> m Pat
+tupP ps = do { ps1 <- sequenceA ps; pure (TupP ps1)}
 
-unboxedTupP :: [PatQ] -> PatQ
-unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}
+unboxedTupP :: Quote m => [m Pat] -> m Pat
+unboxedTupP ps = do { ps1 <- sequenceA ps; pure (UnboxedTupP ps1)}
 
-unboxedSumP :: PatQ -> SumAlt -> SumArity -> PatQ
-unboxedSumP p alt arity = do { p1 <- p; return (UnboxedSumP p1 alt arity) }
+unboxedSumP :: Quote m => m Pat -> SumAlt -> SumArity -> m Pat
+unboxedSumP p alt arity = do { p1 <- p; pure (UnboxedSumP p1 alt arity) }
 
-conP :: Name -> [PatQ] -> PatQ
-conP n ps = do ps' <- sequence ps
-               return (ConP n ps')
-infixP :: PatQ -> Name -> PatQ -> PatQ
+conP :: Quote m => Name -> [m Pat] -> m Pat
+conP n ps = do ps' <- sequenceA ps
+               pure (ConP n ps')
+infixP :: Quote m => m Pat -> Name -> m Pat -> m Pat
 infixP p1 n p2 = do p1' <- p1
                     p2' <- p2
-                    return (InfixP p1' n p2')
-uInfixP :: PatQ -> Name -> PatQ -> PatQ
+                    pure (InfixP p1' n p2')
+uInfixP :: Quote m => m Pat -> Name -> m Pat -> m Pat
 uInfixP p1 n p2 = do p1' <- p1
                      p2' <- p2
-                     return (UInfixP p1' n p2')
-parensP :: PatQ -> PatQ
+                     pure (UInfixP p1' n p2')
+parensP :: Quote m => m Pat -> m Pat
 parensP p = do p' <- p
-               return (ParensP p')
+               pure (ParensP p')
 
-tildeP :: PatQ -> PatQ
+tildeP :: Quote m => m Pat -> m Pat
 tildeP p = do p' <- p
-              return (TildeP p')
-bangP :: PatQ -> PatQ
+              pure (TildeP p')
+bangP :: Quote m => m Pat -> m Pat
 bangP p = do p' <- p
-             return (BangP p')
-asP :: Name -> PatQ -> PatQ
+             pure (BangP p')
+asP :: Quote m => Name -> m Pat -> m Pat
 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
+             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
-              return (SigP p' t')
-viewP :: ExpQ -> PatQ -> PatQ
+              pure (SigP p' t')
+viewP :: Quote m => m Exp -> m Pat -> m Pat
 viewP e p = do e' <- e
                p' <- p
-               return (ViewP e' p')
+               pure (ViewP e' p')
 
-fieldPat :: Name -> PatQ -> FieldPatQ
+fieldPat :: Quote m => Name -> m Pat -> m FieldPat
 fieldPat n p = do p' <- p
-                  return (n, p')
+                  pure (n, p')
 
 
 -------------------------------------------------------------------------------
 -- *   Stmt
 
-bindS :: PatQ -> ExpQ -> StmtQ
-bindS p e = liftM2 BindS p e
+bindS :: Quote m => m Pat -> m Exp -> m Stmt
+bindS p e = liftA2 BindS p e
 
-letS :: [DecQ] -> StmtQ
-letS ds = do { ds1 <- sequence ds; return (LetS ds1) }
+letS :: Quote m => [m Dec] -> m Stmt
+letS ds = do { ds1 <- sequenceA ds; pure (LetS ds1) }
 
-noBindS :: ExpQ -> StmtQ
-noBindS e = do { e1 <- e; return (NoBindS e1) }
+noBindS :: Quote m => m Exp -> m Stmt
+noBindS e = do { e1 <- e; pure (NoBindS e1) }
 
-parS :: [[StmtQ]] -> StmtQ
-parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) }
+parS :: Quote m => [[m Stmt]] -> m Stmt
+parS sss = do { sss1 <- traverse sequenceA sss; pure (ParS sss1) }
 
-recS :: [StmtQ] -> StmtQ
-recS ss = do { ss1 <- sequence ss; return (RecS ss1) }
+recS :: Quote m => [m Stmt] -> m Stmt
+recS ss = do { ss1 <- sequenceA ss; pure (RecS ss1) }
 
 -------------------------------------------------------------------------------
 -- *   Range
 
-fromR :: ExpQ -> RangeQ
-fromR x = do { a <- x; return (FromR a) }
+fromR :: Quote m => m Exp -> m Range
+fromR x = do { a <- x; pure (FromR a) }
 
-fromThenR :: ExpQ -> ExpQ -> RangeQ
-fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }
+fromThenR :: Quote m => m Exp -> m Exp -> m Range
+fromThenR x y = do { a <- x; b <- y; pure (FromThenR a b) }
 
-fromToR :: ExpQ -> ExpQ -> RangeQ
-fromToR x y = do { a <- x; b <- y; return (FromToR a b) }
+fromToR :: Quote m => m Exp -> m Exp -> m Range
+fromToR x y = do { a <- x; b <- y; pure (FromToR a b) }
 
-fromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ
+fromThenToR :: Quote m => m Exp -> m Exp -> m Exp -> m Range
 fromThenToR x y z = do { a <- x; b <- y; c <- z;
-                         return (FromThenToR a b c) }
+                         pure (FromThenToR a b c) }
 -------------------------------------------------------------------------------
 -- *   Body
 
-normalB :: ExpQ -> BodyQ
-normalB e = do { e1 <- e; return (NormalB e1) }
+normalB :: Quote m => m Exp -> m Body
+normalB e = do { e1 <- e; pure (NormalB e1) }
 
-guardedB :: [Q (Guard,Exp)] -> BodyQ
-guardedB ges = do { ges' <- sequence ges; return (GuardedB ges') }
+guardedB :: Quote m => [m (Guard,Exp)] -> m Body
+guardedB ges = do { ges' <- sequenceA ges; pure (GuardedB ges') }
 
 -------------------------------------------------------------------------------
 -- *   Guard
 
-normalG :: ExpQ -> GuardQ
-normalG e = do { e1 <- e; return (NormalG e1) }
+normalG :: Quote m => m Exp -> m Guard
+normalG e = do { e1 <- e; pure (NormalG e1) }
 
-normalGE :: ExpQ -> ExpQ -> Q (Guard, Exp)
-normalGE g e = do { g1 <- g; e1 <- e; return (NormalG g1, e1) }
+normalGE :: Quote m => m Exp -> m Exp -> m (Guard, Exp)
+normalGE g e = do { g1 <- g; e1 <- e; pure (NormalG g1, e1) }
 
-patG :: [StmtQ] -> GuardQ
-patG ss = do { ss' <- sequence ss; return (PatG ss') }
+patG :: Quote m => [m Stmt] -> m Guard
+patG ss = do { ss' <- sequenceA ss; pure (PatG ss') }
 
-patGE :: [StmtQ] -> ExpQ -> Q (Guard, Exp)
-patGE ss e = do { ss' <- sequence ss;
+patGE :: Quote m => [m Stmt] -> m Exp -> m (Guard, Exp)
+patGE ss e = do { ss' <- sequenceA ss;
                   e'  <- e;
-                  return (PatG ss', e') }
+                  pure (PatG ss', e') }
 
 -------------------------------------------------------------------------------
 -- *   Match and Clause
 
 -- | Use with 'caseE'
-match :: PatQ -> BodyQ -> [DecQ] -> MatchQ
+match :: Quote m => m Pat -> m Body -> [m Dec] -> m Match
 match p rhs ds = do { p' <- p;
                       r' <- rhs;
-                      ds' <- sequence ds;
-                      return (Match p' r' ds') }
+                      ds' <- sequenceA ds;
+                      pure (Match p' r' ds') }
 
 -- | Use with 'funD'
-clause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
-clause ps r ds = do { ps' <- sequence ps;
+clause :: Quote m => [m Pat] -> m Body -> [m Dec] -> m Clause
+clause ps r ds = do { ps' <- sequenceA ps;
                       r' <- r;
-                      ds' <- sequence ds;
-                      return (Clause ps' r' ds') }
+                      ds' <- sequenceA ds;
+                      pure (Clause ps' r' ds') }
 
 
 ---------------------------------------------------------------------------
 -- *   Exp
 
 -- | Dynamically binding a variable (unhygenic)
-dyn :: String -> ExpQ
-dyn s = return (VarE (mkName s))
+dyn :: Quote m => String -> m Exp
+dyn s = pure (VarE (mkName s))
 
-varE :: Name -> ExpQ
-varE s = return (VarE s)
+varE :: Quote m => Name -> m Exp
+varE s = pure (VarE s)
 
-conE :: Name -> ExpQ
-conE s =  return (ConE s)
+conE :: Quote m => Name -> m Exp
+conE s =  pure (ConE s)
 
-litE :: Lit -> ExpQ
-litE c = return (LitE c)
+litE :: Quote m => Lit -> m Exp
+litE c = pure (LitE c)
 
-appE :: ExpQ -> ExpQ -> ExpQ
-appE x y = do { a <- x; b <- y; return (AppE a b)}
+appE :: Quote m => m Exp -> m Exp -> m Exp
+appE x y = do { a <- x; b <- y; pure (AppE a b)}
 
-appTypeE :: ExpQ -> TypeQ -> ExpQ
-appTypeE x t = do { a <- x; s <- t; return (AppTypeE a s) }
+appTypeE :: Quote m => m Exp -> m Type -> m Exp
+appTypeE x t = do { a <- x; s <- t; pure (AppTypeE a s) }
 
-parensE :: ExpQ -> ExpQ
-parensE x = do { x' <- x; return (ParensE x') }
+parensE :: Quote m => m Exp -> m Exp
+parensE x = do { x' <- x; pure (ParensE x') }
 
-uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+uInfixE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
 uInfixE x s y = do { x' <- x; s' <- s; y' <- y;
-                     return (UInfixE x' s' y') }
+                     pure (UInfixE x' s' y') }
 
-infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
+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;
-                                  return (InfixE (Just a) s' (Just b))}
+                                  pure (InfixE (Just a) s' (Just b))}
 infixE Nothing  s (Just y) = do { s' <- s; b <- y;
-                                  return (InfixE Nothing s' (Just b))}
+                                  pure (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) }
+                                  pure (InfixE (Just a) s' Nothing)}
+infixE Nothing  s Nothing  = do { s' <- s; pure (InfixE Nothing s' Nothing) }
 
-infixApp :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+infixApp :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
 infixApp x y z = infixE (Just x) y (Just z)
-sectionL :: ExpQ -> ExpQ -> ExpQ
+sectionL :: Quote m => m Exp -> m Exp -> m Exp
 sectionL x y = infixE (Just x) y Nothing
-sectionR :: ExpQ -> ExpQ -> ExpQ
+sectionR :: Quote m => m Exp -> m Exp -> m Exp
 sectionR x y = infixE Nothing x (Just y)
 
-lamE :: [PatQ] -> ExpQ -> ExpQ
-lamE ps e = do ps' <- sequence ps
+lamE :: Quote m => [m Pat] -> m Exp -> m Exp
+lamE ps e = do ps' <- sequenceA ps
                e' <- e
-               return (LamE ps' e')
+               pure (LamE ps' e')
 
 -- | Single-arg lambda
-lam1E :: PatQ -> ExpQ -> ExpQ
+lam1E :: Quote m => m Pat -> m Exp -> m Exp
 lam1E p e = lamE [p] e
 
-lamCaseE :: [MatchQ] -> ExpQ
-lamCaseE ms = sequence ms >>= return . LamCaseE
+lamCaseE :: Quote m => [m Match] -> m Exp
+lamCaseE ms = LamCaseE <$> sequenceA ms
 
-tupE :: [Maybe ExpQ] -> ExpQ
-tupE es = do { es1 <- traverse sequence es; return (TupE es1)}
+tupE :: Quote m => [Maybe (m Exp)] -> m Exp
+tupE es = do { es1 <- traverse sequenceA es; pure (TupE es1)}
 
-unboxedTupE :: [Maybe ExpQ] -> ExpQ
-unboxedTupE es = do { es1 <- traverse sequence es; return (UnboxedTupE es1)}
+unboxedTupE :: Quote m => [Maybe (m Exp)] -> m Exp
+unboxedTupE es = do { es1 <- traverse sequenceA es; pure (UnboxedTupE es1)}
 
-unboxedSumE :: ExpQ -> SumAlt -> SumArity -> ExpQ
-unboxedSumE e alt arity = do { e1 <- e; return (UnboxedSumE e1 alt arity) }
+unboxedSumE :: Quote m => m Exp -> SumAlt -> SumArity -> m Exp
+unboxedSumE e alt arity = do { e1 <- e; pure (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)}
+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 :: [Q (Guard, Exp)] -> ExpQ
-multiIfE alts = sequence alts >>= return . MultiIfE
+multiIfE :: Quote m => [m (Guard, Exp)] -> m Exp
+multiIfE alts = MultiIfE <$> sequenceA alts
 
-letE :: [DecQ] -> ExpQ -> ExpQ
-letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }
+letE :: Quote m => [m Dec] -> m Exp -> m Exp
+letE ds e = do { ds2 <- sequenceA ds; e2 <- e; pure (LetE ds2 e2) }
 
-caseE :: ExpQ -> [MatchQ] -> ExpQ
-caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) }
+caseE :: Quote m => m Exp -> [m Match] -> m Exp
+caseE e ms = do { e1 <- e; ms1 <- sequenceA ms; pure (CaseE e1 ms1) }
 
-doE :: [StmtQ] -> ExpQ
-doE ss = do { ss1 <- sequence ss; return (DoE ss1) }
+doE :: Quote m => [m Stmt] -> m Exp
+doE ss = do { ss1 <- sequenceA ss; pure (DoE ss1) }
 
-mdoE :: [StmtQ] -> ExpQ
-mdoE ss = do { ss1 <- sequence ss; return (MDoE ss1) }
+mdoE :: Quote m => [m Stmt] -> m Exp
+mdoE ss = do { ss1 <- sequenceA ss; pure (MDoE ss1) }
 
-compE :: [StmtQ] -> ExpQ
-compE ss = do { ss1 <- sequence ss; return (CompE ss1) }
+compE :: Quote m => [m Stmt] -> m Exp
+compE ss = do { ss1 <- sequenceA ss; pure (CompE ss1) }
 
-arithSeqE :: RangeQ -> ExpQ
-arithSeqE r = do { r' <- r; return (ArithSeqE r') }
+arithSeqE :: Quote m => m Range -> m Exp
+arithSeqE r = do { r' <- r; pure (ArithSeqE r') }
 
-listE :: [ExpQ] -> ExpQ
-listE es = do { es1 <- sequence es; return (ListE es1) }
+listE :: Quote m => [m Exp] -> m Exp
+listE es = do { es1 <- sequenceA es; pure (ListE es1) }
 
-sigE :: ExpQ -> TypeQ -> ExpQ
-sigE e t = do { e1 <- e; t1 <- t; return (SigE e1 t1) }
+sigE :: Quote m => m Exp -> m Type -> m Exp
+sigE e t = do { e1 <- e; t1 <- t; pure (SigE e1 t1) }
 
-recConE :: Name -> [Q (Name,Exp)] -> ExpQ
-recConE c fs = do { flds <- sequence fs; return (RecConE c flds) }
+recConE :: Quote m => Name -> [m (Name,Exp)] -> m Exp
+recConE c fs = do { flds <- sequenceA fs; pure (RecConE c flds) }
 
-recUpdE :: ExpQ -> [Q (Name,Exp)] -> ExpQ
-recUpdE e fs = do { e1 <- e; flds <- sequence fs; return (RecUpdE e1 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 :: String -> ExpQ
+stringE :: Quote m => String -> m Exp
 stringE = litE . stringL
 
-fieldExp :: Name -> ExpQ -> Q (Name, Exp)
-fieldExp s e = do { e' <- e; return (s,e') }
+fieldExp :: Quote m => Name -> m Exp -> m (Name, Exp)
+fieldExp s e = do { e' <- e; pure (s,e') }
 
 -- | @staticE x = [| static x |]@
-staticE :: ExpQ -> ExpQ
+staticE :: Quote m => m Exp -> m Exp
 staticE = fmap StaticE
 
-unboundVarE :: Name -> ExpQ
-unboundVarE s = return (UnboundVarE s)
+unboundVarE :: Quote m => Name -> m Exp
+unboundVarE s = pure (UnboundVarE s)
 
-labelE :: String -> ExpQ
-labelE s = return (LabelE s)
+labelE :: Quote m => String -> m Exp
+labelE s = pure (LabelE s)
 
-implicitParamVarE :: String -> ExpQ
-implicitParamVarE n = return (ImplicitParamVarE n)
+implicitParamVarE :: Quote m => String -> m Exp
+implicitParamVarE n = pure (ImplicitParamVarE n)
 
 -- ** 'arithSeqE' Shortcuts
-fromE :: ExpQ -> ExpQ
-fromE x = do { a <- x; return (ArithSeqE (FromR a)) }
+fromE :: Quote m => m Exp -> m Exp
+fromE x = do { a <- x; pure (ArithSeqE (FromR a)) }
 
-fromThenE :: ExpQ -> ExpQ -> ExpQ
-fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }
+fromThenE :: Quote m => m Exp -> m Exp -> m Exp
+fromThenE x y = do { a <- x; b <- y; pure (ArithSeqE (FromThenR a b)) }
 
-fromToE :: ExpQ -> ExpQ -> ExpQ
-fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR 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 :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+fromThenToE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
 fromThenToE x y z = do { a <- x; b <- y; c <- z;
-                         return (ArithSeqE (FromThenToR a b c)) }
+                         pure (ArithSeqE (FromThenToR a b c)) }
 
 
 -------------------------------------------------------------------------------
 -- *   Dec
 
-valD :: PatQ -> BodyQ -> [DecQ] -> DecQ
+valD :: Quote m => m Pat -> m Body -> [m Dec] -> m Dec
 valD p b ds =
   do { p' <- p
-     ; ds' <- sequence ds
+     ; ds' <- sequenceA ds
      ; b' <- b
-     ; return (ValD p' b' ds')
+     ; pure (ValD p' b' ds')
      }
 
-funD :: Name -> [ClauseQ] -> DecQ
+funD :: Quote m => Name -> [m Clause] -> m Dec
 funD nm cs =
- do { cs1 <- sequence cs
-    ; return (FunD nm cs1)
+ do { cs1 <- sequenceA cs
+    ; pure (FunD nm cs1)
     }
 
-tySynD :: Name -> [TyVarBndrQ] -> TypeQ -> DecQ
+tySynD :: Quote m => Name -> [m TyVarBndr] -> m Type -> m Dec
 tySynD tc tvs rhs =
   do { tvs1 <- sequenceA tvs
      ; rhs1 <- rhs
-     ; return (TySynD tc tvs1 rhs1)
+     ; pure (TySynD tc tvs1 rhs1)
      }
 
-dataD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> [ConQ]
-      -> [DerivClauseQ] -> DecQ
+dataD :: Quote m => m Cxt -> Name -> [m TyVarBndr] -> Maybe (m Kind) -> [m Con]
+      -> [m DerivClause] -> m Dec
 dataD ctxt tc tvs ksig cons derivs =
   do
     ctxt1   <- ctxt
     tvs1    <- sequenceA tvs
     ksig1   <- sequenceA ksig
-    cons1   <- sequence cons
-    derivs1 <- sequence derivs
-    return (DataD ctxt1 tc tvs1 ksig1 cons1 derivs1)
+    cons1   <- sequenceA cons
+    derivs1 <- sequenceA derivs
+    pure (DataD ctxt1 tc tvs1 ksig1 cons1 derivs1)
 
-newtypeD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> ConQ
-         -> [DerivClauseQ] -> DecQ
+newtypeD :: Quote m => m Cxt -> Name -> [m TyVarBndr] -> Maybe (m Kind) -> m Con
+         -> [m DerivClause] -> m Dec
 newtypeD ctxt tc tvs ksig con derivs =
   do
     ctxt1   <- ctxt
     tvs1    <- sequenceA tvs
     ksig1   <- sequenceA ksig
     con1    <- con
-    derivs1 <- sequence derivs
-    return (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1)
+    derivs1 <- sequenceA derivs
+    pure (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1)
 
-classD :: CxtQ -> Name -> [TyVarBndrQ] -> [FunDep] -> [DecQ] -> DecQ
+classD :: Quote m => m Cxt -> Name -> [m TyVarBndr] -> [FunDep] -> [m Dec] -> m Dec
 classD ctxt cls tvs fds decs =
   do
     tvs1  <- sequenceA tvs
     decs1 <- sequenceA decs
     ctxt1 <- ctxt
-    return $ ClassD ctxt1 cls tvs1 fds decs1
+    pure $ ClassD ctxt1 cls tvs1 fds decs1
 
-instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
+instanceD :: Quote m => m Cxt -> m Type -> [m Dec] -> m Dec
 instanceD = instanceWithOverlapD Nothing
 
-instanceWithOverlapD :: Maybe Overlap -> CxtQ -> TypeQ -> [DecQ] -> DecQ
+instanceWithOverlapD :: Quote m => Maybe Overlap -> m Cxt -> m Type -> [m Dec] -> m Dec
 instanceWithOverlapD o ctxt ty decs =
   do
     ctxt1 <- ctxt
-    decs1 <- sequence decs
+    decs1 <- sequenceA decs
     ty1   <- ty
-    return $ InstanceD o ctxt1 ty1 decs1
+    pure $ InstanceD o ctxt1 ty1 decs1
 
 
 
-sigD :: Name -> TypeQ -> DecQ
-sigD fun ty = liftM (SigD fun) $ ty
+sigD :: Quote m => Name -> m Type -> m Dec
+sigD fun ty = liftA (SigD fun) $ ty
 
-kiSigD :: Name -> KindQ -> DecQ
-kiSigD fun ki = liftM (KiSigD fun) $ ki
+kiSigD :: Quote m => Name -> m Kind -> m Dec
+kiSigD fun ki = liftA (KiSigD fun) $ ki
 
-forImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ
+forImpD :: Quote m => Callconv -> Safety -> String -> Name -> m Type -> m Dec
 forImpD cc s str n ty
  = do ty' <- ty
-      return $ ForeignD (ImportF cc s str n ty')
+      pure $ ForeignD (ImportF cc s str n ty')
 
-infixLD :: Int -> Name -> DecQ
-infixLD prec nm = return (InfixD (Fixity prec InfixL) nm)
+infixLD :: Quote m => Int -> Name -> m Dec
+infixLD prec nm = pure (InfixD (Fixity prec InfixL) nm)
 
-infixRD :: Int -> Name -> DecQ
-infixRD prec nm = return (InfixD (Fixity prec InfixR) nm)
+infixRD :: Quote m => Int -> Name -> m Dec
+infixRD prec nm = pure (InfixD (Fixity prec InfixR) nm)
 
-infixND :: Int -> Name -> DecQ
-infixND prec nm = return (InfixD (Fixity prec InfixN) nm)
+infixND :: Quote m => Int -> Name -> m Dec
+infixND prec nm = pure (InfixD (Fixity prec InfixN) nm)
 
-pragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ
+pragInlD :: Quote m => Name -> Inline -> RuleMatch -> Phases -> m Dec
 pragInlD name inline rm phases
-  = return $ PragmaD $ InlineP name inline rm phases
+  = pure $ PragmaD $ InlineP name inline rm phases
 
-pragSpecD :: Name -> TypeQ -> Phases -> DecQ
+pragSpecD :: Quote m => Name -> m Type -> Phases -> m Dec
 pragSpecD n ty phases
   = do
       ty1    <- ty
-      return $ PragmaD $ SpecialiseP n ty1 Nothing phases
+      pure $ PragmaD $ SpecialiseP n ty1 Nothing phases
 
-pragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ
+pragSpecInlD :: Quote m => Name -> m Type -> Inline -> Phases -> m Dec
 pragSpecInlD n ty inline phases
   = do
       ty1    <- ty
-      return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases
+      pure $ PragmaD $ SpecialiseP n ty1 (Just inline) phases
 
-pragSpecInstD :: TypeQ -> DecQ
+pragSpecInstD :: Quote m => m Type -> m Dec
 pragSpecInstD ty
   = do
       ty1    <- ty
-      return $ PragmaD $ SpecialiseInstP ty1
+      pure $ PragmaD $ SpecialiseInstP ty1
 
-pragRuleD :: String -> Maybe [TyVarBndrQ] -> [RuleBndrQ] -> ExpQ -> ExpQ
-          -> Phases -> DecQ
+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 sequence ty_bndrs
-      tm_bndrs1 <- sequence tm_bndrs
+      ty_bndrs1 <- traverse sequenceA ty_bndrs
+      tm_bndrs1 <- sequenceA tm_bndrs
       lhs1   <- lhs
       rhs1   <- rhs
-      return $ PragmaD $ RuleP n ty_bndrs1 tm_bndrs1 lhs1 rhs1 phases
+      pure $ PragmaD $ RuleP n ty_bndrs1 tm_bndrs1 lhs1 rhs1 phases
 
-pragAnnD :: AnnTarget -> ExpQ -> DecQ
+pragAnnD :: Quote m => AnnTarget -> m Exp -> m Dec
 pragAnnD target expr
   = do
       exp1 <- expr
-      return $ PragmaD $ AnnP target exp1
+      pure $ PragmaD $ AnnP target exp1
 
-pragLineD :: Int -> String -> DecQ
-pragLineD line file = return $ PragmaD $ LineP line file
+pragLineD :: Quote m => Int -> String -> m Dec
+pragLineD line file = pure $ PragmaD $ LineP line file
 
-pragCompleteD :: [Name] -> Maybe Name -> DecQ
-pragCompleteD cls mty = return $ PragmaD $ CompleteP cls mty
+pragCompleteD :: Quote m => [Name] -> Maybe Name -> m Dec
+pragCompleteD cls mty = pure $ PragmaD $ CompleteP cls mty
 
-dataInstD :: CxtQ -> (Maybe [TyVarBndrQ]) -> TypeQ -> Maybe KindQ -> [ConQ]
-          -> [DerivClauseQ] -> DecQ
+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 sequence mb_bndrs
+    mb_bndrs1 <- traverse sequenceA mb_bndrs
     ty1    <- ty
     ksig1   <- sequenceA ksig
     cons1   <- sequenceA cons
     derivs1 <- sequenceA derivs
-    return (DataInstD ctxt1 mb_bndrs1 ty1 ksig1 cons1 derivs1)
+    pure (DataInstD ctxt1 mb_bndrs1 ty1 ksig1 cons1 derivs1)
 
-newtypeInstD :: CxtQ -> (Maybe [TyVarBndrQ]) -> TypeQ -> Maybe KindQ -> ConQ
-             -> [DerivClauseQ] -> DecQ
+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 sequence mb_bndrs
+    mb_bndrs1 <- traverse sequenceA mb_bndrs
     ty1    <- ty
     ksig1   <- sequenceA ksig
     con1    <- con
-    derivs1 <- sequence derivs
-    return (NewtypeInstD ctxt1 mb_bndrs1 ty1 ksig1 con1 derivs1)
+    derivs1 <- sequenceA derivs
+    pure (NewtypeInstD ctxt1 mb_bndrs1 ty1 ksig1 con1 derivs1)
 
-tySynInstD :: TySynEqnQ -> DecQ
+tySynInstD :: Quote m => m TySynEqn -> m Dec
 tySynInstD eqn =
   do
     eqn1 <- eqn
-    return (TySynInstD eqn1)
+    pure (TySynInstD eqn1)
 
-dataFamilyD :: Name -> [TyVarBndrQ] -> Maybe KindQ -> DecQ
+dataFamilyD :: Quote m => Name -> [m TyVarBndr] -> Maybe (m Kind) -> m Dec
 dataFamilyD tc tvs kind =
   do tvs'  <- sequenceA tvs
      kind' <- sequenceA kind
-     return $ DataFamilyD tc tvs' kind'
+     pure $ DataFamilyD tc tvs' kind'
 
-openTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ
-                -> Maybe InjectivityAnn -> DecQ
+openTypeFamilyD :: Quote m => Name -> [m TyVarBndr] -> m FamilyResultSig
+                -> Maybe InjectivityAnn -> m Dec
 openTypeFamilyD tc tvs res inj =
   do tvs' <- sequenceA tvs
      res' <- res
-     return $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj)
+     pure $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj)
 
-closedTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ
-                  -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ
+closedTypeFamilyD :: Quote m => Name -> [m TyVarBndr] -> m FamilyResultSig
+                  -> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec
 closedTypeFamilyD tc tvs result injectivity eqns =
   do tvs1    <- sequenceA tvs
      result1 <- result
      eqns1   <- sequenceA eqns
-     return (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) eqns1)
+     pure (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) eqns1)
 
-roleAnnotD :: Name -> [Role] -> DecQ
-roleAnnotD name roles = return $ RoleAnnotD name roles
+roleAnnotD :: Quote m => Name -> [Role] -> m Dec
+roleAnnotD name roles = pure $ RoleAnnotD name roles
 
-standaloneDerivD :: CxtQ -> TypeQ -> DecQ
+standaloneDerivD :: Quote m => m Cxt -> m Type -> m Dec
 standaloneDerivD = standaloneDerivWithStrategyD Nothing
 
-standaloneDerivWithStrategyD :: Maybe DerivStrategyQ -> CxtQ -> TypeQ -> DecQ
+standaloneDerivWithStrategyD :: Quote m => Maybe (m DerivStrategy) -> m Cxt -> m Type -> m Dec
 standaloneDerivWithStrategyD mdsq ctxtq tyq =
   do
     mds  <- sequenceA mdsq
     ctxt <- ctxtq
     ty   <- tyq
-    return $ StandaloneDerivD mds ctxt ty
+    pure $ StandaloneDerivD mds ctxt ty
 
-defaultSigD :: Name -> TypeQ -> DecQ
+defaultSigD :: Quote m => Name -> m Type -> m Dec
 defaultSigD n tyq =
   do
     ty <- tyq
-    return $ DefaultSigD n ty
+    pure $ DefaultSigD n ty
 
 -- | Pattern synonym declaration
-patSynD :: Name -> PatSynArgsQ -> PatSynDirQ -> PatQ -> DecQ
+patSynD :: Quote m => Name -> m PatSynArgs -> m PatSynDir -> m Pat -> m Dec
 patSynD name args dir pat = do
   args'    <- args
   dir'     <- dir
   pat'     <- pat
-  return (PatSynD name args' dir' pat')
+  pure (PatSynD name args' dir' pat')
 
 -- | Pattern synonym type signature
-patSynSigD :: Name -> TypeQ -> DecQ
+patSynSigD :: Quote m => Name -> m Type -> m Dec
 patSynSigD nm ty =
   do ty' <- ty
-     return $ PatSynSigD nm 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 :: String -> ExpQ -> DecQ
+implicitParamBindD :: Quote m => String -> m Exp -> m Dec
 implicitParamBindD n e =
   do
     e' <- e
-    return $ ImplicitParamBindD n e'
+    pure $ ImplicitParamBindD n e'
 
-tySynEqn :: (Maybe [TyVarBndrQ]) -> TypeQ -> TypeQ -> TySynEqnQ
+tySynEqn :: Quote m => (Maybe [m TyVarBndr]) -> m Type -> m Type -> m TySynEqn
 tySynEqn mb_bndrs lhs rhs =
   do
-    mb_bndrs1 <- traverse sequence mb_bndrs
+    mb_bndrs1 <- traverse sequenceA mb_bndrs
     lhs1 <- lhs
     rhs1 <- rhs
-    return (TySynEqn mb_bndrs1 lhs1 rhs1)
+    pure (TySynEqn mb_bndrs1 lhs1 rhs1)
 
-cxt :: [PredQ] -> CxtQ
-cxt = sequence
+cxt :: Quote m => [m Pred] -> m Cxt
+cxt = sequenceA
 
-derivClause :: Maybe DerivStrategyQ -> [PredQ] -> DerivClauseQ
+derivClause :: Quote m => Maybe (m DerivStrategy) -> [m Pred] -> m DerivClause
 derivClause mds p = do mds' <- sequenceA mds
                        p'   <- cxt p
-                       return $ DerivClause mds' p'
+                       pure $ DerivClause mds' p'
 
-stockStrategy :: DerivStrategyQ
+stockStrategy :: Quote m => m DerivStrategy
 stockStrategy = pure StockStrategy
 
-anyclassStrategy :: DerivStrategyQ
+anyclassStrategy :: Quote m => m DerivStrategy
 anyclassStrategy = pure AnyclassStrategy
 
-newtypeStrategy :: DerivStrategyQ
+newtypeStrategy :: Quote m => m DerivStrategy
 newtypeStrategy = pure NewtypeStrategy
 
-viaStrategy :: TypeQ -> DerivStrategyQ
+viaStrategy :: Quote m => m Type -> m DerivStrategy
 viaStrategy = fmap ViaStrategy
 
-normalC :: Name -> [BangTypeQ] -> ConQ
-normalC con strtys = liftM (NormalC con) $ sequence strtys
+normalC :: Quote m => Name -> [m BangType] -> m Con
+normalC con strtys = liftA (NormalC con) $ sequenceA strtys
 
-recC :: Name -> [VarBangTypeQ] -> ConQ
-recC con varstrtys = liftM (RecC con) $ sequence varstrtys
+recC :: Quote m => Name -> [m VarBangType] -> m Con
+recC con varstrtys = liftA (RecC con) $ sequenceA varstrtys
 
-infixC :: Q (Bang, Type) -> Name -> Q (Bang, Type) -> ConQ
+infixC :: Quote m => m (Bang, Type) -> Name -> m (Bang, Type) -> m Con
 infixC st1 con st2 = do st1' <- st1
                         st2' <- st2
-                        return $ InfixC st1' con st2'
+                        pure $ InfixC st1' con st2'
 
-forallC :: [TyVarBndrQ] -> CxtQ -> ConQ -> ConQ
+forallC :: Quote m => [m TyVarBndr] -> m Cxt -> m Con -> m Con
 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
+gadtC :: Quote m => [Name] -> [m StrictType] -> m Type -> m Con
+gadtC cons strtys ty = liftA2 (GadtC cons) (sequenceA strtys) ty
 
-recGadtC :: [Name] -> [VarStrictTypeQ] -> TypeQ -> ConQ
-recGadtC cons varstrtys ty = liftM2 (RecGadtC cons) (sequence varstrtys) ty
+recGadtC :: Quote m => [Name] -> [m VarStrictType] -> m Type -> m Con
+recGadtC cons varstrtys ty = liftA2 (RecGadtC cons) (sequenceA varstrtys) ty
 
 -------------------------------------------------------------------------------
 -- *   Type
 
-forallT :: [TyVarBndrQ] -> CxtQ -> TypeQ -> TypeQ
+forallT :: Quote m => [m TyVarBndr] -> m Cxt -> m Type -> m Type
 forallT tvars ctxt ty = do
     tvars1 <- sequenceA tvars
     ctxt1  <- ctxt
     ty1    <- ty
-    return $ ForallT tvars1 ctxt1 ty1
+    pure $ ForallT tvars1 ctxt1 ty1
 
-forallVisT :: [TyVarBndrQ] -> TypeQ -> TypeQ
+forallVisT :: Quote m => [m TyVarBndr] -> m Type -> m Type
 forallVisT tvars ty = ForallVisT <$> sequenceA tvars <*> ty
 
-varT :: Name -> TypeQ
-varT = return . VarT
+varT :: Quote m => Name -> m Type
+varT = pure . VarT
 
-conT :: Name -> TypeQ
-conT = return . ConT
+conT :: Quote m => Name -> m Type
+conT = pure . ConT
 
-infixT :: TypeQ -> Name -> TypeQ -> TypeQ
+infixT :: Quote m => m Type -> Name -> m Type -> m Type
 infixT t1 n t2 = do t1' <- t1
                     t2' <- t2
-                    return (InfixT t1' n t2')
+                    pure (InfixT t1' n t2')
 
-uInfixT :: TypeQ -> Name -> TypeQ -> TypeQ
+uInfixT :: Quote m => m Type -> Name -> m Type -> m Type
 uInfixT t1 n t2 = do t1' <- t1
                      t2' <- t2
-                     return (UInfixT t1' n t2')
+                     pure (UInfixT t1' n t2')
 
-parensT :: TypeQ -> TypeQ
+parensT :: Quote m => m Type -> m Type
 parensT t = do t' <- t
-               return (ParensT t')
+               pure (ParensT t')
 
-appT :: TypeQ -> TypeQ -> TypeQ
+appT :: Quote m => m Type -> m Type -> m Type
 appT t1 t2 = do
            t1' <- t1
            t2' <- t2
-           return $ AppT t1' t2'
+           pure $ AppT t1' t2'
 
-appKindT :: TypeQ -> KindQ -> TypeQ
+appKindT :: Quote m => m Type -> m Kind -> m Type
 appKindT ty ki = do
                ty' <- ty
                ki' <- ki
-               return $ AppKindT ty' ki'
+               pure $ AppKindT ty' ki'
 
-arrowT :: TypeQ
-arrowT = return ArrowT
+arrowT :: Quote m => m Type
+arrowT = pure ArrowT
 
-listT :: TypeQ
-listT = return ListT
+listT :: Quote m => m Type
+listT = pure ListT
 
-litT :: TyLitQ -> TypeQ
+litT :: Quote m => m TyLit -> m Type
 litT l = fmap LitT l
 
-tupleT :: Int -> TypeQ
-tupleT i = return (TupleT i)
+tupleT :: Quote m => Int -> m Type
+tupleT i = pure (TupleT i)
 
-unboxedTupleT :: Int -> TypeQ
-unboxedTupleT i = return (UnboxedTupleT i)
+unboxedTupleT :: Quote m => Int -> m Type
+unboxedTupleT i = pure (UnboxedTupleT i)
 
-unboxedSumT :: SumArity -> TypeQ
-unboxedSumT arity = return (UnboxedSumT arity)
+unboxedSumT :: Quote m => SumArity -> m Type
+unboxedSumT arity = pure (UnboxedSumT arity)
 
-sigT :: TypeQ -> KindQ -> TypeQ
+sigT :: Quote m => m Type -> m Kind -> m Type
 sigT t k
   = do
       t' <- t
       k' <- k
-      return $ SigT t' k'
+      pure $ SigT t' k'
 
-equalityT :: TypeQ
-equalityT = return EqualityT
+equalityT :: Quote m => m Type
+equalityT = pure EqualityT
 
-wildCardT :: TypeQ
-wildCardT = return WildCardT
+wildCardT :: Quote m => m Type
+wildCardT = pure WildCardT
 
-implicitParamT :: String -> TypeQ -> TypeQ
+implicitParamT :: Quote m => String -> m Type -> m Type
 implicitParamT n t
   = do
       t' <- t
-      return $ ImplicitParamT n t'
+      pure $ ImplicitParamT n t'
 
 {-# 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 :: Quote m => Name -> [m Type] -> m Pred
 classP cla tys
   = do
-      tysl <- sequence tys
-      return (foldl AppT (ConT cla) tysl)
+      tysl <- sequenceA tys
+      pure (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 :: Quote m => m Type -> m Type -> m Pred
 equalP tleft tright
   = do
       tleft1  <- tleft
       tright1 <- tright
       eqT <- equalityT
-      return (foldl AppT eqT [tleft1, tright1])
+      pure (foldl AppT eqT [tleft1, tright1])
 
-promotedT :: Name -> TypeQ
-promotedT = return . PromotedT
+promotedT :: Quote m => Name -> m Type
+promotedT = pure . PromotedT
 
-promotedTupleT :: Int -> TypeQ
-promotedTupleT i = return (PromotedTupleT i)
+promotedTupleT :: Quote m => Int -> m Type
+promotedTupleT i = pure (PromotedTupleT i)
 
-promotedNilT :: TypeQ
-promotedNilT = return PromotedNilT
+promotedNilT :: Quote m => m Type
+promotedNilT = pure PromotedNilT
 
-promotedConsT :: TypeQ
-promotedConsT = return PromotedConsT
+promotedConsT :: Quote m => m Type
+promotedConsT = pure PromotedConsT
 
-noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: SourceUnpackednessQ
-noSourceUnpackedness = return NoSourceUnpackedness
-sourceNoUnpack       = return SourceNoUnpack
-sourceUnpack         = return SourceUnpack
+noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: Quote m => m SourceUnpackedness
+noSourceUnpackedness = pure NoSourceUnpackedness
+sourceNoUnpack       = pure SourceNoUnpack
+sourceUnpack         = pure SourceUnpack
 
-noSourceStrictness, sourceLazy, sourceStrict :: SourceStrictnessQ
-noSourceStrictness = return NoSourceStrictness
-sourceLazy         = return SourceLazy
-sourceStrict       = return SourceStrict
+noSourceStrictness, sourceLazy, sourceStrict :: Quote m => m SourceStrictness
+noSourceStrictness = pure NoSourceStrictness
+sourceLazy         = pure SourceLazy
+sourceStrict       = pure SourceStrict
 
 {-# DEPRECATED isStrict
     ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",
@@ -770,49 +771,52 @@ sourceStrict       = return SourceStrict
 {-# DEPRECATED unpacked
     ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",
      "Example usage: 'bang sourceUnpack sourceStrict'"] #-}
-isStrict, notStrict, unpacked :: Q Strict
+isStrict, notStrict, unpacked :: Quote m => m Strict
 isStrict = bang noSourceUnpackedness sourceStrict
 notStrict = bang noSourceUnpackedness noSourceStrictness
 unpacked = bang sourceUnpack sourceStrict
 
-bang :: SourceUnpackednessQ -> SourceStrictnessQ -> BangQ
+bang :: Quote m => m SourceUnpackedness -> m SourceStrictness -> m Bang
 bang u s = do u' <- u
               s' <- s
-              return (Bang u' s')
+              pure (Bang u' s')
 
-bangType :: BangQ -> TypeQ -> BangTypeQ
-bangType = liftM2 (,)
+bangType :: Quote m => m Bang -> m Type -> m BangType
+bangType = liftA2 (,)
 
-varBangType :: Name -> BangTypeQ -> VarBangTypeQ
-varBangType v bt = do (b, t) <- bt
-                      return (v, b, t)
+varBangType :: Quote m => Name -> m BangType -> m VarBangType
+varBangType v bt = (\(b, t) -> (v, b, t)) <$> bt
 
 {-# 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 :: Quote m => m Strict -> m Type -> m StrictType
 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 :: Quote m => Name -> m StrictType -> m VarStrictType
 varStrictType = varBangType
 
 -- * Type Literals
 
-numTyLit :: Integer -> TyLitQ
-numTyLit n = if n >= 0 then return (NumTyLit n)
-                       else fail ("Negative type-level number: " ++ show n)
+-- 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 :: String -> TyLitQ
-strTyLit s = return (StrTyLit s)
+strTyLit :: Quote m => String -> m TyLit
+strTyLit s = pure (StrTyLit s)
 
 -------------------------------------------------------------------------------
 -- *   Kind
 
-plainTV :: Name -> TyVarBndrQ
+plainTV :: Quote m => Name -> m TyVarBndr
 plainTV = pure . PlainTV
 
-kindedTV :: Name -> KindQ -> TyVarBndrQ
+kindedTV :: Quote m => Name -> m Kind -> m TyVarBndr
 kindedTV n = fmap (KindedTV n)
 
 varK :: Name -> Kind
@@ -824,31 +828,31 @@ conK = ConT
 tupleK :: Int -> Kind
 tupleK = TupleT
 
-arrowK :: Kind
+arrowK ::  Kind
 arrowK = ArrowT
 
-listK :: Kind
+listK ::  Kind
 listK = ListT
 
 appK :: Kind -> Kind -> Kind
 appK = AppT
 
-starK :: KindQ
+starK :: Quote m => m Kind
 starK = pure StarT
 
-constraintK :: KindQ
+constraintK :: Quote m => m Kind
 constraintK = pure ConstraintT
 
 -------------------------------------------------------------------------------
 -- *   Type family result
 
-noSig :: FamilyResultSigQ
+noSig :: Quote m => m FamilyResultSig
 noSig = pure NoSig
 
-kindSig :: KindQ -> FamilyResultSigQ
+kindSig :: Quote m => m Kind -> m FamilyResultSig
 kindSig = fmap KindSig
 
-tyVarSig :: TyVarBndrQ -> FamilyResultSigQ
+tyVarSig :: Quote m => m TyVarBndr -> m FamilyResultSig
 tyVarSig = fmap TyVarSig
 
 -------------------------------------------------------------------------------
@@ -887,23 +891,23 @@ interruptible = Interruptible
 -------------------------------------------------------------------------------
 -- *   FunDep
 
-funDep :: [Name] -> [Name] -> FunDep
+funDep ::  [Name] -> [Name] -> FunDep
 funDep = FunDep
 
 -------------------------------------------------------------------------------
 -- *   RuleBndr
-ruleVar :: Name -> RuleBndrQ
-ruleVar = return . RuleVar
+ruleVar :: Quote m => Name -> m RuleBndr
+ruleVar = pure . RuleVar
 
-typedRuleVar :: Name -> TypeQ -> RuleBndrQ
-typedRuleVar n ty = ty >>= return . TypedRuleVar n
+typedRuleVar :: Quote m => Name -> m Type -> m RuleBndr
+typedRuleVar n ty = TypedRuleVar n <$> ty
 
 -------------------------------------------------------------------------------
 -- *   AnnTarget
-valueAnnotation :: Name -> AnnTarget
+valueAnnotation ::  Name -> AnnTarget
 valueAnnotation = ValueAnnotation
 
-typeAnnotation :: Name -> AnnTarget
+typeAnnotation ::  Name -> AnnTarget
 typeAnnotation = TypeAnnotation
 
 moduleAnnotation :: AnnTarget
@@ -912,35 +916,35 @@ moduleAnnotation = ModuleAnnotation
 -------------------------------------------------------------------------------
 -- * Pattern Synonyms (sub constructs)
 
-unidir, implBidir :: PatSynDirQ
-unidir    = return Unidir
-implBidir = return ImplBidir
+unidir, implBidir :: Quote m => m PatSynDir
+unidir    = pure Unidir
+implBidir = pure ImplBidir
 
-explBidir :: [ClauseQ] -> PatSynDirQ
+explBidir :: Quote m => [m Clause] -> m PatSynDir
 explBidir cls = do
-  cls' <- sequence cls
-  return (ExplBidir cls')
+  cls' <- sequenceA cls
+  pure (ExplBidir cls')
 
-prefixPatSyn :: [Name] -> PatSynArgsQ
-prefixPatSyn args = return $ PrefixPatSyn args
+prefixPatSyn :: Quote m => [Name] -> m PatSynArgs
+prefixPatSyn args = pure $ PrefixPatSyn args
 
-recordPatSyn :: [Name] -> PatSynArgsQ
-recordPatSyn sels = return $ RecordPatSyn sels
+recordPatSyn :: Quote m => [Name] -> m PatSynArgs
+recordPatSyn sels = pure $ RecordPatSyn sels
 
-infixPatSyn :: Name -> Name -> PatSynArgsQ
-infixPatSyn arg1 arg2 = return $ InfixPatSyn arg1 arg2
+infixPatSyn :: Quote m => Name -> Name -> m PatSynArgs
+infixPatSyn arg1 arg2 = pure $ InfixPatSyn arg1 arg2
 
 --------------------------------------------------------------
 -- * Useful helper function
 
-appsE :: [ExpQ] -> ExpQ
+appsE :: Quote m => [m Exp] -> m Exp
 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
+-- | pure 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)
+  pure $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index fb9556db54..0abe15f3ea 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -204,6 +204,67 @@ instance Applicative Q where
 
 -----------------------------------------------------
 --
+--              The Quote class
+--
+-----------------------------------------------------
+
+
+
+-- | The 'Quote' class implements the minimal interface which is necessary for
+-- desugaring quotations.
+--
+-- * The @Monad m@ superclass is needed to stitch together the different
+-- AST fragments.
+-- * 'newName' is used when desugaring binding structures such as lambdas
+-- to generate fresh names.
+--
+-- Therefore the type of an untyped quotation in GHC is `Quote m => m Exp`
+--
+-- For many years the type of a quotation was fixed to be `Q Exp` but by
+-- more precisely specifying the minimal interface it enables the `Exp` to
+-- be extracted purely from the quotation without interacting with `Q`.
+class Monad m => Quote m where
+  {- |
+  Generate a fresh name, which cannot be captured.
+
+  For example, this:
+
+  @f = $(do
+    nm1 <- newName \"x\"
+    let nm2 = 'mkName' \"x\"
+    return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
+   )@
+
+  will produce the splice
+
+  >f = \x0 -> \x -> x0
+
+  In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
+  and is not captured by the binding @VarP nm2@.
+
+  Although names generated by @newName@ cannot /be captured/, they can
+  /capture/ other names. For example, this:
+
+  >g = $(do
+  >  nm1 <- newName "x"
+  >  let nm2 = mkName "x"
+  >  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
+  > )
+
+  will produce the splice
+
+  >g = \x -> \x0 -> x0
+
+  since the occurrence @VarE nm2@ is captured by the innermost binding
+  of @x@, namely @VarP nm1@.
+  -}
+  newName :: String -> m Name
+
+instance Quote Q where
+  newName s = Q (qNewName s)
+
+-----------------------------------------------------
+--
 --              The TExp type
 --
 -----------------------------------------------------
@@ -250,7 +311,7 @@ newtype TExp (a :: TYPE (r :: RuntimeRep)) = TExp
 -- expression
 --
 -- Levity-polymorphic since /template-haskell-2.16.0.0/.
-unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r). Q (TExp a) -> Q Exp
+unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m => m (TExp a) -> m Exp
 unTypeQ m = do { TExp e <- m
                ; return e }
 
@@ -260,7 +321,8 @@ unTypeQ m = do { TExp e <- m
 -- really does have the type you claim it has.
 --
 -- Levity-polymorphic since /template-haskell-2.16.0.0/.
-unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r). Q Exp -> Q (TExp a)
+unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
+                      Quote m => m Exp -> m (TExp a)
 unsafeTExpCoerce m = do { e <- m
                         ; return (TExp e) }
 
@@ -280,42 +342,6 @@ The splice will evaluate to (MkAge 3) and you can't add that to
 ----------------------------------------------------
 -- Packaged versions for the programmer, hiding the Quasi-ness
 
-{- |
-Generate a fresh name, which cannot be captured.
-
-For example, this:
-
-@f = $(do
-  nm1 <- newName \"x\"
-  let nm2 = 'mkName' \"x\"
-  return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
- )@
-
-will produce the splice
-
->f = \x0 -> \x -> x0
-
-In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
-and is not captured by the binding @VarP nm2@.
-
-Although names generated by @newName@ cannot /be captured/, they can
-/capture/ other names. For example, this:
-
->g = $(do
->  nm1 <- newName "x"
->  let nm2 = mkName "x"
->  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
-> )
-
-will produce the splice
-
->g = \x -> \x0 -> x0
-
-since the occurrence @VarE nm2@ is captured by the innermost binding
-of @x@, namely @VarP nm1@.
--}
-newName :: String -> Q Name
-newName s = Q (qNewName s)
 
 -- | Report an error (True) or warning (False),
 -- but carry on; use 'fail' to stop.
@@ -654,13 +680,7 @@ instance Quasi Q where
 -- The following operations are used solely in DsMeta when desugaring brackets
 -- They are not necessary for the user, who can use ordinary return and (>>=) etc
 
-returnQ :: a -> Q a
-returnQ = return
-
-bindQ :: Q a -> (a -> Q b) -> Q b
-bindQ = (>>=)
-
-sequenceQ :: [Q a] -> Q [a]
+sequenceQ :: forall m . Monad m => forall a . [m a] -> m [a]
 sequenceQ = sequence
 
 
@@ -700,15 +720,15 @@ sequenceQ = sequence
 class Lift (t :: TYPE r) where
   -- | Turn a value into a Template Haskell expression, suitable for use in
   -- a splice.
-  lift :: t -> Q Exp
-  default lift :: (r ~ 'LiftedRep) => t -> Q Exp
+  lift :: Quote m => t -> m Exp
+  default lift :: (r ~ 'LiftedRep, Quote m) => t -> m Exp
   lift = unTypeQ . liftTyped
 
   -- | Turn a value into a Template Haskell typed expression, suitable for use
   -- in a typed splice.
   --
   -- @since 2.16.0.0
-  liftTyped :: t -> Q (TExp t)
+  liftTyped :: Quote m => t -> m (TExp t)
 
 
 -- If you add any instances here, consider updating test th/TH_Lift
@@ -832,7 +852,7 @@ instance Lift a => Lift [a] where
   liftTyped x = unsafeTExpCoerce (lift x)
   lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
 
-liftString :: String -> Q Exp
+liftString :: Quote m => String -> m Exp
 -- Used in TcExpr to short-circuit the lifting for strings
 liftString s = return (LitE (StringL s))
 
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index 18b12fd4e7..a6d6307b7e 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -1,5 +1,14 @@
 # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell)
 
+## 2.17.0.0
+
+  * Implement Overloaded Quotations (GHC Proposal #246). This patch modifies a
+     few fundamental things in the API. All the library combinators are generalised
+     to be in terms of a new minimal class `Quote`. The type of `lift` and `liftTyped`
+     are modified to return `m Exp` rather than `Q Exp`. Instances written in terms
+     of `Q` are now disallowed. The types of `unsafeTExpCoerce` and `unTypeQ`
+     are also generalised in terms of `Quote` rather than specific to `Q`.
+
 ## 2.16.0.0 *TBA*
 
   * Add support for tuple sections. (#15843) The type signatures of `TupE` and