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

46 files changed, 231 insertions, 25 deletions

diff --git a/testsuite/tests/cabal/cabal04/TH.hs b/testsuite/tests/cabal/cabal04/TH.hs
index 8719c7d550..d37efa1acc 100644
--- a/testsuite/tests/cabal/cabal04/TH.hs
+++ b/testsuite/tests/cabal/cabal04/TH.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-}
 module TH where
 
 import Language.Haskell.TH
diff --git a/testsuite/tests/driver/recomp009/Sub1.hs b/testsuite/tests/driver/recomp009/Sub1.hs
index 25ea7552e4..9420c7a3f9 100644
--- a/testsuite/tests/driver/recomp009/Sub1.hs
+++ b/testsuite/tests/driver/recomp009/Sub1.hs
@@ -1,3 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-}
 module Sub where
 x = [| 1 |]
diff --git a/testsuite/tests/driver/recomp009/Sub2.hs b/testsuite/tests/driver/recomp009/Sub2.hs
index 7ca8b12c33..78bd05fc18 100644
--- a/testsuite/tests/driver/recomp009/Sub2.hs
+++ b/testsuite/tests/driver/recomp009/Sub2.hs
@@ -1,3 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-}
 module Sub where
 x = [| 2 |]
diff --git a/testsuite/tests/ghci/T16670/TH.hs b/testsuite/tests/ghci/T16670/TH.hs
index f288c784f0..36f705e2bd 100644
--- a/testsuite/tests/ghci/T16670/TH.hs
+++ b/testsuite/tests/ghci/T16670/TH.hs
@@ -1,3 +1,4 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module TH where
 th = [|909|]
diff --git a/testsuite/tests/ghci/scripts/T8831.hs b/testsuite/tests/ghci/scripts/T8831.hs
index b0a3cc5bdf..4bf9f6d870 100644
--- a/testsuite/tests/ghci/scripts/T8831.hs
+++ b/testsuite/tests/ghci/scripts/T8831.hs
@@ -1,3 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-}
 module T8831 where
 foo = [| 3 |]
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.hs
index 40d82bb7a2..0f8198d22d 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.hs
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DuplicateRecordFields, TemplateHaskell #-}
+{-# LANGUAGE DuplicateRecordFields, TemplateHaskell, NoMonomorphismRestriction #-}
 
 data S = MkS { x :: Int }
 data T = MkT { x :: Int }
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
index 89464451ee..3867404d2c 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
@@ -17,6 +17,7 @@ import OccName
 import RdrName
 import Name
 import Avail
+import GHC.Hs.Dump
 
 plugin :: Plugin
 plugin = defaultPlugin { parsedResultAction = parsedPlugin
@@ -52,11 +53,13 @@ typecheckPlugin [name, "typecheck"] _ tc
 typecheckPlugin _ _ tc = return tc
 
 metaPlugin' :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
-metaPlugin' opts (L l (HsPar x e)) = (\e' -> L l (HsPar x e')) <$> metaPlugin' opts e
-metaPlugin' [name, "meta"] (L _ (HsApp noExt (L l (HsVar _ (L _ id))) e))
+metaPlugin' [name, "meta"] (L l (HsWrap ne w (HsPar x (L _ (HsApp noExt (L _ (HsVar _ (L _ id))) e)))))
   | occNameString (getOccName id) == name
-  = return e
-metaPlugin' _ meta = return meta
+  = return (L l (HsWrap ne w (unLoc e)))
+-- The test should always match this first case. If the desugaring changes
+-- again in the future then the panic is more useful than the previous
+-- inscrutable failure.
+metaPlugin' _ meta = pprPanic "meta" (showAstData BlankSrcSpan meta)
 
 interfaceLoadPlugin' :: [CommandLineOption] -> ModIface -> IfM lcl ModIface
 interfaceLoadPlugin' [name, "interface"] iface
diff --git a/testsuite/tests/quotes/T6062.hs b/testsuite/tests/quotes/T6062.hs
index 342850e853..efce7b2752 100644
--- a/testsuite/tests/quotes/T6062.hs
+++ b/testsuite/tests/quotes/T6062.hs
@@ -1,2 +1,3 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module T6062 where
 x = [| False True |]
diff --git a/testsuite/tests/quotes/T8455.hs b/testsuite/tests/quotes/T8455.hs
index 69d1271b40..c55c5272f9 100644
--- a/testsuite/tests/quotes/T8455.hs
+++ b/testsuite/tests/quotes/T8455.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 
 module T8455 where
 
diff --git a/testsuite/tests/quotes/T8759a.hs b/testsuite/tests/quotes/T8759a.hs
index 37b65d6fcc..c56a363e7a 100644
--- a/testsuite/tests/quotes/T8759a.hs
+++ b/testsuite/tests/quotes/T8759a.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 
 module T8759a where
 
diff --git a/testsuite/tests/quotes/T9824.hs b/testsuite/tests/quotes/T9824.hs
index 9a2d6fdfef..d8e2098c07 100644
--- a/testsuite/tests/quotes/T9824.hs
+++ b/testsuite/tests/quotes/T9824.hs
@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -fwarn-unused-matches #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 
 module T9824 where
 
diff --git a/testsuite/tests/quotes/TH_bracket1.hs b/testsuite/tests/quotes/TH_bracket1.hs
index 7dee21ba01..bc0126a91d 100644
--- a/testsuite/tests/quotes/TH_bracket1.hs
+++ b/testsuite/tests/quotes/TH_bracket1.hs
@@ -1,6 +1,6 @@
 -- Check that declarations in a bracket shadow the top-level
 -- declarations, rather than clashing with them.
-
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module TH_bracket1 where
 
 foo = 1
diff --git a/testsuite/tests/quotes/TH_bracket2.hs b/testsuite/tests/quotes/TH_bracket2.hs
index 2b06b9eecb..e903b673db 100644
--- a/testsuite/tests/quotes/TH_bracket2.hs
+++ b/testsuite/tests/quotes/TH_bracket2.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module TH_bracket2 where
 
 d_show = [d| data A = A
diff --git a/testsuite/tests/quotes/TH_bracket3.hs b/testsuite/tests/quotes/TH_bracket3.hs
index c746d61cd3..281b8cb081 100644
--- a/testsuite/tests/quotes/TH_bracket3.hs
+++ b/testsuite/tests/quotes/TH_bracket3.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 
 module TH_bracket3 where
 
diff --git a/testsuite/tests/quotes/TH_localname.stderr b/testsuite/tests/quotes/TH_localname.stderr
index d872a622b3..6d0ccc91ec 100644
--- a/testsuite/tests/quotes/TH_localname.stderr
+++ b/testsuite/tests/quotes/TH_localname.stderr
@@ -1,21 +1,23 @@
 
 TH_localname.hs:3:11: error:
-    • Ambiguous type variable ‘t0’ arising from a use of ‘Language.Haskell.TH.Syntax.lift’
-      prevents the constraint ‘(Language.Haskell.TH.Syntax.Lift
-                                  t0)’ from being solved.
+    • Ambiguous type variable ‘m0’ arising from a quotation bracket
+      prevents the constraint ‘(Language.Haskell.TH.Syntax.Quote
+                                  m0)’ from being solved.
       Relevant bindings include
-        y :: t0 (bound at TH_localname.hs:3:6)
-        x :: t0 -> Language.Haskell.TH.Lib.Internal.ExpQ
+        x :: t0 -> m0 Language.Haskell.TH.Syntax.Exp
           (bound at TH_localname.hs:3:1)
-      Probable fix: use a type annotation to specify what ‘t0’ should be.
-      These potential instances exist:
-        29 instances involving out-of-scope types
+      Probable fix: use a type annotation to specify what ‘m0’ should be.
+      These potential instance exist:
+        one instance involving out-of-scope types
         (use -fprint-potential-instances to see them all)
-    • In the expression: Language.Haskell.TH.Syntax.lift y
-      In the expression:
+    • In the expression:
         [| y |]
         pending(rn) [<y, Language.Haskell.TH.Syntax.lift y>]
       In the expression:
         \ y
           -> [| y |]
              pending(rn) [<y, Language.Haskell.TH.Syntax.lift y>]
+      In an equation for ‘x’:
+          x = \ y
+                -> [| y |]
+                   pending(rn) [<y, Language.Haskell.TH.Syntax.lift y>]
diff --git a/testsuite/tests/quotes/TH_typed_csp.hs b/testsuite/tests/quotes/TH_typed_csp.hs
new file mode 100644
index 0000000000..4660fffd7f
--- /dev/null
+++ b/testsuite/tests/quotes/TH_typed_csp.hs
@@ -0,0 +1,6 @@
+-- Check that CSP works for typed quotations.. there was no test for this
+-- before apart from the deriving tests.
+{-# LANGUAGE NoMonomorphismRestriction #-}
+module TH_typed_csp where
+
+bar = (\x -> [|| x ||]) ()
diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T
index feefc41433..a10da1046f 100644
--- a/testsuite/tests/quotes/all.T
+++ b/testsuite/tests/quotes/all.T
@@ -29,3 +29,4 @@ test('TH_repE1', normal, compile, [''])
 test('TH_repE3', normal, compile, [''])
 test('TH_abstractFamily', normal, compile_fail, [''])
 test('TH_localname', normal, compile_fail, [''])
+test('TH_typed_csp', normal, compile, [''])
diff --git a/testsuite/tests/th/T10047.stdout b/testsuite/tests/th/T10047.stdout
index ea22d78254..6855b00bdf 100644
--- a/testsuite/tests/th/T10047.stdout
+++ b/testsuite/tests/th/T10047.stdout
@@ -1,2 +1,2 @@
-[| $(dyn "foo") |] :: ExpQ
-[| [n|foo|] |] :: ExpQ
+[| $(dyn "foo") |] :: Quote m => m Exp
+[| [n|foo|] |] :: Q Exp
diff --git a/testsuite/tests/th/T12993_Lib.hs b/testsuite/tests/th/T12993_Lib.hs
index 441b783812..344cd034d0 100644
--- a/testsuite/tests/th/T12993_Lib.hs
+++ b/testsuite/tests/th/T12993_Lib.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module T12993_Lib (q) where
 data X = X { x :: Int }
 q = [|x|]
diff --git a/testsuite/tests/th/T1476.hs b/testsuite/tests/th/T1476.hs
index 7e3a192ba0..be08f59082 100644
--- a/testsuite/tests/th/T1476.hs
+++ b/testsuite/tests/th/T1476.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 
 module T1476 where
 
diff --git a/testsuite/tests/th/T1476b.hs b/testsuite/tests/th/T1476b.hs
index 7d62850904..8481be1ce2 100644
--- a/testsuite/tests/th/T1476b.hs
+++ b/testsuite/tests/th/T1476b.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 
 module T1476b where
 
diff --git a/testsuite/tests/th/T15783B.hs b/testsuite/tests/th/T15783B.hs
index 818f57d52e..b58b2baa51 100644
--- a/testsuite/tests/th/T15783B.hs
+++ b/testsuite/tests/th/T15783B.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module T15783B(f) where
 
 d = 0
diff --git a/testsuite/tests/th/T15843a.hs b/testsuite/tests/th/T15843a.hs
index 2f413fd2c1..e0fb69ce0f 100644
--- a/testsuite/tests/th/T15843a.hs
+++ b/testsuite/tests/th/T15843a.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module T15843a where
 
 import Language.Haskell.TH
diff --git a/testsuite/tests/th/T2386_Lib.hs b/testsuite/tests/th/T2386_Lib.hs
index 4322cc9584..96fa324ef1 100644
--- a/testsuite/tests/th/T2386_Lib.hs
+++ b/testsuite/tests/th/T2386_Lib.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 
 module T2386_Lib(ExportedAbstract, makeOne) where
 
diff --git a/testsuite/tests/th/T4949.hs b/testsuite/tests/th/T4949.hs
index a1cb8b4d99..b3c37eea57 100644
--- a/testsuite/tests/th/T4949.hs
+++ b/testsuite/tests/th/T4949.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module Foo where
 
 import Language.Haskell.TH
diff --git a/testsuite/tests/th/T7276.stderr b/testsuite/tests/th/T7276.stderr
index 4fa2a3c4c9..10a592f4a5 100644
--- a/testsuite/tests/th/T7276.stderr
+++ b/testsuite/tests/th/T7276.stderr
@@ -3,6 +3,7 @@ T7276.hs:6:8: error:
     • Couldn't match type ‘[Language.Haskell.TH.Syntax.Dec]’
                      with ‘Language.Haskell.TH.Syntax.Exp’
       Expected type: Language.Haskell.TH.Lib.Internal.ExpQ
-        Actual type: Language.Haskell.TH.Lib.Internal.DecsQ
+        Actual type: Language.Haskell.TH.Syntax.Q
+                       Language.Haskell.TH.Lib.Internal.Decs
     • In the expression: [d| y = 3 |]
       In the untyped splice: $([d| y = 3 |])
diff --git a/testsuite/tests/th/T7276a.stdout b/testsuite/tests/th/T7276a.stdout
index ebcf5be338..048d305562 100644
--- a/testsuite/tests/th/T7276a.stdout
+++ b/testsuite/tests/th/T7276a.stdout
@@ -2,7 +2,7 @@
 <interactive>:3:9: warning: [-Wdeferred-type-errors (in -Wdefault)]
     • Couldn't match type ‘[Dec]’ with ‘Exp’
       Expected type: Q Exp
-        Actual type: DecsQ
+        Actual type: Q Language.Haskell.TH.Lib.Internal.Decs
     • In the expression: [d| a = () |] :: Q Exp
       In an equation for ‘x’: x = [d| a = () |] :: Q Exp
 
@@ -11,7 +11,7 @@
         <interactive>:3:9: error:
     • Couldn't match type ‘[Dec]’ with ‘Exp’
       Expected type: Q Exp
-        Actual type: DecsQ
+        Actual type: Q Language.Haskell.TH.Lib.Internal.Decs
     • In the expression: [d| a = () |] :: Q Exp
       In an equation for ‘x’: x = [d| a = () |] :: Q Exp
 (deferred type error)
diff --git a/testsuite/tests/th/T8028a.hs b/testsuite/tests/th/T8028a.hs
index 5bdff99f4d..b944634ac1 100644
--- a/testsuite/tests/th/T8028a.hs
+++ b/testsuite/tests/th/T8028a.hs
@@ -2,5 +2,6 @@ module T8028a where
 
 import Language.Haskell.TH
 
+x :: Q [Dec]
 x = do n <- newName "F"
        return [ClosedTypeFamilyD (TypeFamilyHead n [] NoSig Nothing) []]
diff --git a/testsuite/tests/th/TH_NestedSplices.hs b/testsuite/tests/th/TH_NestedSplices.hs
index 1af80dbcf9..f5950ef5cb 100644
--- a/testsuite/tests/th/TH_NestedSplices.hs
+++ b/testsuite/tests/th/TH_NestedSplices.hs
@@ -24,8 +24,10 @@ f x = $(spliceExpr "boo" [| x |])
 g x = $(spliceExpr $(litE (stringL "boo")) [| x |])
 
 -- Ordinary splice inside bracket
+h1 :: Q Exp
 h1 = [| $(litE (integerL 3)) |]
 
 -- Splice inside splice inside bracket
+h2 :: Q Exp
 h2 = [| $(litE ($(varE 'integerL) 3)) |]
 
diff --git a/testsuite/tests/th/TH_StringLift.hs b/testsuite/tests/th/TH_StringLift.hs
new file mode 100644
index 0000000000..334ba14353
--- /dev/null
+++ b/testsuite/tests/th/TH_StringLift.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+module TH_StringLift where
+
+import Language.Haskell.TH.Syntax
+
+foo :: Quote m => String -> m (TExp String)
+foo x = [|| x ||]
+
+foo2 :: Quote m => String -> m Exp
+foo2 x = [| x |]
diff --git a/testsuite/tests/th/TH_tuple1a.hs b/testsuite/tests/th/TH_tuple1a.hs
index 2b4bb5014b..c6894b6817 100644
--- a/testsuite/tests/th/TH_tuple1a.hs
+++ b/testsuite/tests/th/TH_tuple1a.hs
@@ -4,6 +4,7 @@ module TH_tuple1a where
 
 import Language.Haskell.TH
 
+tp2, tp1, tp2u, tp1u :: Q Exp
 tp2 = sigE (appsE [conE (tupleDataName 2),
                   litE (integerL 1),
                   litE (integerL 2)])
diff --git a/testsuite/tests/th/TH_unresolvedInfix.hs b/testsuite/tests/th/TH_unresolvedInfix.hs
index 49a6b03871..3c34b976a3 100644
--- a/testsuite/tests/th/TH_unresolvedInfix.hs
+++ b/testsuite/tests/th/TH_unresolvedInfix.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE NoStarIsType #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 
 module Main where
 
diff --git a/testsuite/tests/th/TH_unresolvedInfix_Lib.hs b/testsuite/tests/th/TH_unresolvedInfix_Lib.hs
index 56930be3b7..04dead18ae 100644
--- a/testsuite/tests/th/TH_unresolvedInfix_Lib.hs
+++ b/testsuite/tests/th/TH_unresolvedInfix_Lib.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE NoStarIsType #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 
 module TH_unresolvedInfix_Lib where
 
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 3d73107231..bcaf5fbd1b 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -496,3 +496,4 @@ test('T17379b', normal, compile_fail, [''])
 test('T17461', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T17511', normal, compile, [''])
 test('TH_PprStar', normal, compile, ['-v0 -dsuppress-uniques'])
+test('TH_StringLift', normal, compile, [''])
diff --git a/testsuite/tests/th/overloaded/Makefile b/testsuite/tests/th/overloaded/Makefile
new file mode 100644
index 0000000000..4a268530f1
--- /dev/null
+++ b/testsuite/tests/th/overloaded/Makefile
@@ -0,0 +1,4 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
diff --git a/testsuite/tests/th/overloaded/TH_overloaded_constraints.hs b/testsuite/tests/th/overloaded/TH_overloaded_constraints.hs
new file mode 100644
index 0000000000..565ef41c1d
--- /dev/null
+++ b/testsuite/tests/th/overloaded/TH_overloaded_constraints.hs
@@ -0,0 +1,32 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE TemplateHaskell #-}
+module TH_overloaded_constraints where
+-- Test that constraints are collected properly from nested splices
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+import Data.Functor.Identity
+
+class C m where
+  cid :: m a -> m a
+
+class D m where
+  did :: m a -> m a
+
+cq :: (C m, Quote m) => m Exp
+cq = [| 5 |]
+
+dq :: (D m, Quote m) => m Exp
+dq = [| 5 |]
+
+top_level :: (C m, D m, Quote m) => m Exp
+top_level = [| $cq + $dq |]
+
+cqt :: (C m, Quote m) => m (TExp Int)
+cqt = [|| 5 ||]
+
+dqt :: (D m, Quote m) => m (TExp Int)
+dqt = [|| 5 ||]
+
+top_level_t :: (C m, D m, Quote m) => m (TExp Int)
+top_level_t = [|| $$cqt + $$dqt ||]
diff --git a/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.hs b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.hs
new file mode 100644
index 0000000000..07c2163bbc
--- /dev/null
+++ b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.hs
@@ -0,0 +1,20 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE TemplateHaskell #-}
+module TH_overloaded_constraints_fail where
+-- Test the error message when there are conflicting nested splices
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+import Data.Functor.Identity
+
+instance Quote Identity where
+  -- Not the correct implementation, just for testing
+  newName s = Identity (Name (mkOccName s) NameS)
+
+idQ :: Identity Exp
+idQ = [| 5 |]
+
+qq :: Q Exp
+qq = [| 5 |]
+
+quote = [| $(idQ) $(qq) |]
diff --git a/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr
new file mode 100644
index 0000000000..d76db558c6
--- /dev/null
+++ b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr
@@ -0,0 +1,13 @@
+
+TH_overloaded_constraints_fail.hs:20:14: error:
+    • Couldn't match type ‘Identity’ with ‘Q’
+      Expected type: Q Exp
+        Actual type: Identity Exp
+    • In the expression: idQ
+      In the expression:
+        [| $(idQ) $(qq) |]
+        pending(rn) [<splice, qq>, <splice, idQ>]
+      In an equation for ‘quote’:
+          quote
+            = [| $(idQ) $(qq) |]
+              pending(rn) [<splice, qq>, <splice, idQ>]
diff --git a/testsuite/tests/th/overloaded/TH_overloaded_csp.hs b/testsuite/tests/th/overloaded/TH_overloaded_csp.hs
new file mode 100644
index 0000000000..c87707c01e
--- /dev/null
+++ b/testsuite/tests/th/overloaded/TH_overloaded_csp.hs
@@ -0,0 +1,18 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Main where
+-- A test to check that CSP works with overloaded quotes
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+import Data.Functor.Identity
+
+
+instance Quote Identity where
+  -- Not the correct implementation, just for testing
+  newName s = Identity (Name (mkOccName s) NameS)
+
+main = do
+  print $ runIdentity ((\x -> [| x |]) ())
+  print $ unType $ runIdentity ((\x -> [|| x ||]) ())
+
diff --git a/testsuite/tests/th/overloaded/TH_overloaded_csp.stdout b/testsuite/tests/th/overloaded/TH_overloaded_csp.stdout
new file mode 100644
index 0000000000..5a64654110
--- /dev/null
+++ b/testsuite/tests/th/overloaded/TH_overloaded_csp.stdout
@@ -0,0 +1,2 @@
+ConE GHC.Tuple.()
+ConE GHC.Tuple.()
diff --git a/testsuite/tests/th/overloaded/TH_overloaded_extract.hs b/testsuite/tests/th/overloaded/TH_overloaded_extract.hs
new file mode 100644
index 0000000000..23c5ac5257
--- /dev/null
+++ b/testsuite/tests/th/overloaded/TH_overloaded_extract.hs
@@ -0,0 +1,23 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Main where
+-- A simple test to check that defining a custom instance is easily
+-- possible and extraction works as expected.
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+import Data.Functor.Identity
+
+
+instance Quote Identity where
+  -- Not the correct implementation, just for testing
+  newName s = Identity (Name (mkOccName s) NameS)
+
+main = do
+  print $ runIdentity [| 1 + 2 |]
+  print $ runIdentity [| \x -> 1 + 2 |]
+  print $ runIdentity [d| data Foo = Foo |]
+  print $ runIdentity [p| () |]
+  print $ runIdentity [t| [Int] |]
+  print $ unType $ runIdentity [|| (+1) ||]
+
diff --git a/testsuite/tests/th/overloaded/TH_overloaded_extract.stdout b/testsuite/tests/th/overloaded/TH_overloaded_extract.stdout
new file mode 100644
index 0000000000..e636c0c4f1
--- /dev/null
+++ b/testsuite/tests/th/overloaded/TH_overloaded_extract.stdout
@@ -0,0 +1,6 @@
+InfixE (Just (LitE (IntegerL 1))) (VarE GHC.Num.+) (Just (LitE (IntegerL 2)))
+LamE [VarP x] (InfixE (Just (LitE (IntegerL 1))) (VarE GHC.Num.+) (Just (LitE (IntegerL 2))))
+[DataD [] Foo [] Nothing [NormalC Foo []] []]
+ConP GHC.Tuple.() []
+AppT ListT (ConT GHC.Types.Int)
+InfixE Nothing (VarE GHC.Num.+) (Just (LitE (IntegerL 1)))
diff --git a/testsuite/tests/th/overloaded/TH_overloaded_no_instance.hs b/testsuite/tests/th/overloaded/TH_overloaded_no_instance.hs
new file mode 100644
index 0000000000..18dd9e7a3e
--- /dev/null
+++ b/testsuite/tests/th/overloaded/TH_overloaded_no_instance.hs
@@ -0,0 +1,14 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE TemplateHaskell #-}
+module TH_overloaded_constraints_no_instance where
+-- Test the error message when there is no instance
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+data NewType a
+
+-- No instance for Quote NewType
+quote2 :: NewType Exp
+quote2 = [| 5 |]
+
diff --git a/testsuite/tests/th/overloaded/TH_overloaded_no_instance.stderr b/testsuite/tests/th/overloaded/TH_overloaded_no_instance.stderr
new file mode 100644
index 0000000000..78f70c4d85
--- /dev/null
+++ b/testsuite/tests/th/overloaded/TH_overloaded_no_instance.stderr
@@ -0,0 +1,5 @@
+
+TH_overloaded_no_instance.hs:13:10: error:
+    • No instance for (Quote NewType) arising from a quotation bracket
+    • In the expression: [| 5 |]
+      In an equation for ‘quote2’: quote2 = [| 5 |]
diff --git a/testsuite/tests/th/overloaded/all.T b/testsuite/tests/th/overloaded/all.T
new file mode 100644
index 0000000000..e5c9194ee2
--- /dev/null
+++ b/testsuite/tests/th/overloaded/all.T
@@ -0,0 +1,23 @@
+# NOTICE TO DEVELOPERS
+# ~~~~~~~~~~~~~~~~~~~~
+# Adding a TemplateHaskell test?  If it only contains (non-quasi) quotes
+# and no splices, consider adding it to the quotes/ directory instead
+# of the th/ directory; this way, we can test it on the stage 1 compiler too!
+
+def f(name, opts):
+    opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell'
+setTestOpts(f)
+setTestOpts(req_interp)
+# TH should work with -fexternal-interpreter too
+if config.have_ext_interp :
+     setTestOpts(extra_ways(['ext-interp']))
+     setTestOpts(only_ways(['normal','ghci','ext-interp']))
+
+     if llvm_build():
+         setTestOpts(fragile_for(16087, ['ext-interp']))
+
+test('TH_overloaded_extract', normal, compile_and_run, [''])
+test('TH_overloaded_constraints', normal, compile, ['-v0'])
+test('TH_overloaded_constraints_fail', normal, compile_fail, ['-v0'])
+test('TH_overloaded_no_instance', normal, compile_fail, ['-v0'])
+test('TH_overloaded_csp', normal, compile_and_run, ['-v0'])
diff --git a/testsuite/tests/th/should_compile/T8025/A.hs b/testsuite/tests/th/should_compile/T8025/A.hs
index c0e3083a01..f02a57a7c5 100644
--- a/testsuite/tests/th/should_compile/T8025/A.hs
+++ b/testsuite/tests/th/should_compile/T8025/A.hs
@@ -1,3 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module A where
+
 a = [|3|]