Make warnings for TH splices opt-in

In #17270 we have the pattern-match checker emit incorrect warnings. The
reason for that behavior is ultimately an inconsistency in whether we
treat TH splices as written by the user (`FromSource :: Origin`) or as
generated code (`Generated`). This was first reported in #14838.

The current solution is to TH splices as `Generated` by default and only
treat them as `FromSource` when the user requests so
(-fenable-th-splice-warnings). There are multiple reasons for opt-in
rather than opt-out:

  * It's not clear that the user that compiles a splice is the author of the code
    that produces the warning. Think of the situation where she just splices in
    code from a third-party library that produces incomplete pattern matches.
    In this scenario, the user isn't even able to fix that warning.
  * Gathering information for producing the warnings (pattern-match check
    warnings in particular) is costly. There's no point in doing so if the user
    is not interested in those warnings.

Fixes #17270, but not #14838, because the proper solution needs a GHC
proposal extending the TH AST syntax.

3 files changed, 17 insertions, 8 deletions

diff --git a/testsuite/tests/th/T17270.hs b/testsuite/tests/th/T17270.hs
new file mode 100644
index 0000000000..72f85dddd6
--- /dev/null
+++ b/testsuite/tests/th/T17270.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -Wall #-}
+module T17270 where
+
+import Data.Type.Equality
+
+f :: a :~: Int -> b :~: Bool -> a :~: b -> void
+f Refl Refl x = case x of {}
+
+$([d| g :: a :~: Int -> b :~: Bool -> a :~: b -> void
+      g Refl Refl x = case x of {}
+    |])
diff --git a/testsuite/tests/th/TH_repUnboxedTuples.stderr b/testsuite/tests/th/TH_repUnboxedTuples.stderr
index 8439b12547..3687b77a0e 100644
--- a/testsuite/tests/th/TH_repUnboxedTuples.stderr
+++ b/testsuite/tests/th/TH_repUnboxedTuples.stderr
@@ -3,11 +3,3 @@ case (# 'b', GHC.Types.False #) of
     (# 'a', GHC.Types.True #) -> (# "One", 1 #)
     (# 'b', GHC.Types.False #) -> (# "Two", 2 #)
     (# _, _ #) -> (# "Three", 3 #)
-
-TH_repUnboxedTuples.hs:18:13: warning: [-Woverlapping-patterns (in -Wdefault)]
-    Pattern match is redundant
-    In a case alternative: (# 'a', True #) -> ...
-
-TH_repUnboxedTuples.hs:18:13: warning: [-Woverlapping-patterns (in -Wdefault)]
-    Pattern match is redundant
-    In a case alternative: (# _, _ #) -> ...
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index b63b0ceb01..9e07d5035b 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -486,6 +486,8 @@ test('T16976f', normal, compile_fail, [''])
 test('T16976z', normal, compile_fail, [''])
 test('T16980', normal, compile, [''])
 test('T16980a', normal, compile_fail, [''])
+test('T17270a', extra_files(['T17270.hs']), multimod_compile, ['T17270', '-v0'])
+test('T17270b', extra_files(['T17270.hs']), multimod_compile, ['T17270', '-fenable-th-splice-warnings -v0'])
 test('T17296', normal, compile, ['-v0'])
 test('T17380', normal, compile_fail, [''])
 test('T17394', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])