Add typed holes support in Template Haskell.

Fixes #10267. Typed holes in typed Template Haskell currently don't work.
See #10945 and #10946.

6 files changed, 91 insertions, 8 deletions

diff --git a/testsuite/tests/th/T10267.hs b/testsuite/tests/th/T10267.hs
new file mode 100644
index 0000000000..009d0f035c
--- /dev/null
+++ b/testsuite/tests/th/T10267.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T10267 where
+
+import Language.Haskell.TH
+import T10267a
+
+[d| i :: a -> a
+    i = _foo
+
+    j :: a -> a
+    j x = _ |]
+
+$(return [
+   SigD (mkName "k")
+        (ForallT [PlainTV (mkName "a")]
+                 []
+                 (AppT (AppT ArrowT (VarT (mkName "a"))) (VarT (mkName "a"))))
+ , FunD (mkName "k")
+        [Clause [] (NormalB (UnboundVarE (mkName "_foo"))) []]
+ ])
+
+$(return [
+   SigD (mkName "l")
+        (ForallT [PlainTV (mkName "a")]
+                 []
+                 (AppT (AppT ArrowT (VarT (mkName "a"))) (VarT (mkName "a"))))
+ , FunD (mkName "l")
+        [Clause [VarP (mkName "x")] (NormalB (UnboundVarE (mkName "_"))) []]
+ ])
+
+foo :: a -> a
+foo x = $varX
diff --git a/testsuite/tests/th/T10267.stderr b/testsuite/tests/th/T10267.stderr
new file mode 100644
index 0000000000..442a779e44
--- /dev/null
+++ b/testsuite/tests/th/T10267.stderr
@@ -0,0 +1,46 @@
+
+T10267.hs:8:1: error:
+    Found hole: _ :: a0
+    Where: ‘a0’ is a rigid type variable bound by
+                the type signature for:
+                  j :: a0 -> a0
+                at T10267.hs:8:1
+    Relevant bindings include
+      x :: a0 (bound at T10267.hs:8:1)
+      j :: a0 -> a0 (bound at T10267.hs:8:1)
+    In the expression: _
+    In an equation for ‘j’: j x = _
+
+T10267.hs:8:1: error:
+    Found hole: _foo :: a0 -> a0
+    Where: ‘a0’ is a rigid type variable bound by
+                the type signature for:
+                  i :: a0 -> a0
+                at T10267.hs:8:1
+    Or perhaps ‘_foo’ is mis-spelled, or not in scope
+    Relevant bindings include i :: a0 -> a0 (bound at T10267.hs:8:1)
+    In the expression: _foo
+    In an equation for ‘i’: i = _foo
+
+T10267.hs:14:3: error:
+    Found hole: _foo :: a -> a
+    Where: ‘a’ is a rigid type variable bound by
+               the type signature for:
+                 k :: a -> a
+               at T10267.hs:14:3
+    Or perhaps ‘_foo’ is mis-spelled, or not in scope
+    Relevant bindings include k :: a -> a (bound at T10267.hs:14:3)
+    In the expression: _foo
+    In an equation for ‘k’: k = _foo
+
+T10267.hs:23:3: error:
+    Found hole: _ :: a
+    Where: ‘a’ is a rigid type variable bound by
+               the type signature for:
+                 l :: a -> a
+               at T10267.hs:23:3
+    Relevant bindings include
+      x :: a (bound at T10267.hs:23:3)
+      l :: a -> a (bound at T10267.hs:23:3)
+    In the expression: _
+    In an equation for ‘l’: l x = _
diff --git a/testsuite/tests/th/T10267a.hs b/testsuite/tests/th/T10267a.hs
new file mode 100644
index 0000000000..cabe97ef2c
--- /dev/null
+++ b/testsuite/tests/th/T10267a.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T10267a where
+
+import Language.Haskell.TH
+
+varX :: Q Exp
+varX = [| x |]
diff --git a/testsuite/tests/th/T1476b.hs b/testsuite/tests/th/T1476b.hs
index 918a3978dd..7d62850904 100644
--- a/testsuite/tests/th/T1476b.hs
+++ b/testsuite/tests/th/T1476b.hs
@@ -6,5 +6,3 @@ import Language.Haskell.TH
 
 baz = [| \ $( return $ VarP $ mkName "x" ) -> x |]
 
--- If this test starts passing, nested pattern splices scope correctly.
--- Good for you! Now, update the TH manual accordingly.
diff --git a/testsuite/tests/th/T1476b.stderr b/testsuite/tests/th/T1476b.stderr
index 65b0814501..e69de29bb2 100644
--- a/testsuite/tests/th/T1476b.stderr
+++ b/testsuite/tests/th/T1476b.stderr
@@ -1,5 +0,0 @@
-
-T1476b.hs:7:47:
-    Not in scope: ‘x’
-    In the Template Haskell quotation
-      [| \ $(return $ VarP $ mkName "x") -> x |]
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 9ded8108df..1e05d72171 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -340,12 +340,15 @@ test('T9064', normal, compile, ['-v0'])
 test('T9209', normal, compile_fail, ['-v0'])
 test('T7484', normal, compile_fail, ['-v0'])
 test('T1476', normal, compile, ['-v0'])
-test('T1476b', normal, compile_fail, ['-v0'])
+test('T1476b', normal, compile, ['-v0'])
 test('T8031', normal, compile, ['-v0'])
 test('T8624', normal, run_command, ['$MAKE -s --no-print-directory T8624'])
 test('TH_Lift', normal, compile, ['-v0'])
 test('T10047', normal, ghci_script, ['T10047.script'])
 test('T10019', normal, ghci_script, ['T10019.script'])
+test('T10267', extra_clean(['T10267a.hi', 'T10267a.o']),
+               multimod_compile_fail,
+               ['T10267', '-dsuppress-uniques -v0'])
 test('T10279', normal, compile_fail, ['-v0'])
 test('T10306', normal, compile, ['-v0'])
 test('T10596', normal, compile, ['-v0'])