Add GhcMessage and ancillary types

This commit adds GhcMessage and ancillary (PsMessage, TcRnMessage, ..)
types.
These types will be expanded to represent more errors generated
by different subsystems within GHC. Right now, they are underused,
but more will come in the glorious future.

See
https://gitlab.haskell.org/ghc/ghc/-/wikis/Errors-as-(structured)-values
for a design overview.

Along the way, lots of other things had to happen:

* Adds Semigroup and Monoid instance for Bag

* Fixes #19746 by parsing OPTIONS_GHC pragmas into Located Strings.
  See GHC.Parser.Header.toArgs (moved from GHC.Utils.Misc, where it
  didn't belong anyway).

* Addresses (but does not completely fix) #19709, now reporting
  desugarer warnings and errors appropriately for TH splices.
  Not done: reporting type-checker warnings for TH splices.

* Some small refactoring around Safe Haskell inference, in order
  to keep separate classes of messages separate.

* Some small refactoring around initDsTc, in order to keep separate
  classes of messages separate.

* Separate out the generation of messages (that is, the construction
  of the text block) from the wrapping of messages (that is, assigning
  a SrcSpan). This is more modular than the previous design, which
  mixed the two.

Close #19746.

This was a collaborative effort by Alfredo di Napoli and
Richard Eisenberg, with a key assist on #19746 by Iavor
Diatchki.

Metric Increase:
    MultiLayerModules

42 files changed, 143 insertions, 41 deletions

diff --git a/testsuite/tests/driver/StringListOptions.hs b/testsuite/tests/driver/StringListOptions.hs
new file mode 100644
index 0000000000..51f8b6db4d
--- /dev/null
+++ b/testsuite/tests/driver/StringListOptions.hs
@@ -0,0 +1,3 @@
+{-# OPTIONS_GHC [   ] #-}
+
+module StringListOptions where
diff --git a/testsuite/tests/driver/T2464.stderr b/testsuite/tests/driver/T2464.stderr
index 3d0074fc82..bba952fd30 100644
--- a/testsuite/tests/driver/T2464.stderr
+++ b/testsuite/tests/driver/T2464.stderr
@@ -1,3 +1,3 @@
 
-T2464.hs:3:16: warning: [-Wdeprecated-flags (in -Wdefault)]
+T2464.hs:3:17: warning: [-Wdeprecated-flags (in -Wdefault)]
     -fffi is deprecated: use -XForeignFunctionInterface or pragma {-# LANGUAGE ForeignFunctionInterface #-} instead
diff --git a/testsuite/tests/driver/T2499.stderr b/testsuite/tests/driver/T2499.stderr
index 9a082d34b1..88d8dbe56a 100644
--- a/testsuite/tests/driver/T2499.stderr
+++ b/testsuite/tests/driver/T2499.stderr
@@ -1,4 +1,6 @@
 
-T2499.hs:1:12: unknown flag in  {-# OPTIONS_GHC #-} pragma: -package
+T2499.hs:1:13: error:
+    unknown flag in  {-# OPTIONS_GHC #-} pragma: -package
 
-T2499.hs:1:12: unknown flag in  {-# OPTIONS_GHC #-} pragma: blargh
+T2499.hs:1:22: error:
+    unknown flag in  {-# OPTIONS_GHC #-} pragma: blargh
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index 94ecb3006c..447a4d0800 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -234,6 +234,7 @@ test('T10970', normal, compile_and_run, [''])
 test('T4931', normal, compile_and_run, [''])
 test('T11182', normal, compile_and_run, [''])
 test('T11381', normal, compile_fail, [''])
+test('StringListOptions', normal, compile, [''])
 test('T11429a', normal, compile, ['-Wunrecognised-warning-flags -Wfoobar'])
 test('T11429b', normal, compile, ['-Wno-unrecognised-warning-flags -Wfoobar'])
 test('T11429c', normal, compile_fail, ['-Wunrecognised-warning-flags -Werror -Wfoobar'])
diff --git a/testsuite/tests/ghc-api/T18522-dbg-ppr.hs b/testsuite/tests/ghc-api/T18522-dbg-ppr.hs
index e0b6a57764..7c16e7f0d0 100644
--- a/testsuite/tests/ghc-api/T18522-dbg-ppr.hs
+++ b/testsuite/tests/ghc-api/T18522-dbg-ppr.hs
@@ -49,7 +49,7 @@ main = do
       let (warnings, errors) = partitionMessages messages
       case mres of
         Nothing -> do
-          printBagOfErrors logger dflags warnings
-          printBagOfErrors logger dflags errors
+          printMessages logger dflags warnings
+          printMessages logger dflags errors
         Just (t, _) -> do
           putStrLn $ showSDoc dflags (debugPprType t)
diff --git a/testsuite/tests/parser/should_compile/T16619.stderr b/testsuite/tests/parser/should_compile/T16619.stderr
index 68a8bf5da8..aab7175abd 100644
--- a/testsuite/tests/parser/should_compile/T16619.stderr
+++ b/testsuite/tests/parser/should_compile/T16619.stderr
@@ -1,3 +1,3 @@
 
-T16619.hs:2:12: warning: [-Wdeprecated-flags (in -Wdefault)]
+T16619.hs:2:13: warning: [-Wdeprecated-flags (in -Wdefault)]
     -Wmissing-space-after-bang is deprecated: bang patterns can no longer be written with a space
diff --git a/testsuite/tests/parser/should_fail/T16270.stderr b/testsuite/tests/parser/should_fail/T16270.stderr
index 6666ac7963..323d9c93e3 100644
--- a/testsuite/tests/parser/should_fail/T16270.stderr
+++ b/testsuite/tests/parser/should_fail/T16270.stderr
@@ -1,5 +1,5 @@
 
-T16270.hs:3:12: warning: [-Wdeprecated-flags (in -Wdefault)]
+T16270.hs:3:13: warning: [-Wdeprecated-flags (in -Wdefault)]
     -Werror=missing-space-after-bang is deprecated: bang patterns can no longer be written with a space
 
 T16270.hs:8:1: warning: [-Wtabs (in -Wdefault)]
diff --git a/testsuite/tests/parser/should_fail/readFail044.stderr b/testsuite/tests/parser/should_fail/readFail044.stderr
index 27becac67c..1976b56079 100644
--- a/testsuite/tests/parser/should_fail/readFail044.stderr
+++ b/testsuite/tests/parser/should_fail/readFail044.stderr
@@ -1,6 +1,6 @@
 
-readFail044.hs:3:16:
+readFail044.hs:3:17: error:
     unknown flag in  {-# OPTIONS_GHC #-} pragma: -this-flag-does-not-exist
 
-readFail044.hs:3:16:
+readFail044.hs:3:43: error:
     unknown flag in  {-# OPTIONS_GHC #-} pragma: -nor-does-this-one
diff --git a/testsuite/tests/parser/should_run/CountAstDeps.stdout b/testsuite/tests/parser/should_run/CountAstDeps.stdout
index a9479a9d8d..cb96d95d78 100644
--- a/testsuite/tests/parser/should_run/CountAstDeps.stdout
+++ b/testsuite/tests/parser/should_run/CountAstDeps.stdout
@@ -1,4 +1,4 @@
-Found 245 Language.Haskell.Syntax module dependencies
+Found 255 Language.Haskell.Syntax module dependencies
 GHC.Builtin.Names
 GHC.Builtin.PrimOps
 GHC.Builtin.Types
@@ -83,6 +83,8 @@ GHC.Driver.CmdLine
 GHC.Driver.Env
 GHC.Driver.Env.Types
 GHC.Driver.Errors
+GHC.Driver.Errors.Ppr
+GHC.Driver.Errors.Types
 GHC.Driver.Flags
 GHC.Driver.Hooks
 GHC.Driver.Monad
@@ -103,12 +105,18 @@ GHC.Hs.Lit
 GHC.Hs.Pat
 GHC.Hs.Type
 GHC.Hs.Utils
+GHC.HsToCore.Errors.Ppr
+GHC.HsToCore.Errors.Types
 GHC.Iface.Ext.Fields
 GHC.Iface.Recomp.Binary
 GHC.Iface.Syntax
 GHC.Iface.Type
 GHC.Linker.Types
 GHC.Parser.Annotation
+GHC.Parser.Errors
+GHC.Parser.Errors.Ppr
+GHC.Parser.Errors.Types
+GHC.Parser.Types
 GHC.Platform
 GHC.Platform.AArch64
 GHC.Platform.ARM
@@ -138,6 +146,8 @@ GHC.StgToCmm.Types
 GHC.SysTools.BaseDir
 GHC.SysTools.Terminal
 GHC.Tc.Errors.Hole.FitTypes
+GHC.Tc.Errors.Ppr
+GHC.Tc.Errors.Types
 GHC.Tc.Types
 GHC.Tc.Types.Constraint
 GHC.Tc.Types.Evidence
diff --git a/testsuite/tests/parser/should_run/CountParserDeps.stdout b/testsuite/tests/parser/should_run/CountParserDeps.stdout
index 73a238fd09..82daac1a97 100644
--- a/testsuite/tests/parser/should_run/CountParserDeps.stdout
+++ b/testsuite/tests/parser/should_run/CountParserDeps.stdout
@@ -1,4 +1,4 @@
-Found 253 GHC.Parser module dependencies
+Found 261 GHC.Parser module dependencies
 GHC.Builtin.Names
 GHC.Builtin.PrimOps
 GHC.Builtin.Types
@@ -84,6 +84,8 @@ GHC.Driver.CmdLine
 GHC.Driver.Env
 GHC.Driver.Env.Types
 GHC.Driver.Errors
+GHC.Driver.Errors.Ppr
+GHC.Driver.Errors.Types
 GHC.Driver.Flags
 GHC.Driver.Hooks
 GHC.Driver.Monad
@@ -104,6 +106,8 @@ GHC.Hs.Lit
 GHC.Hs.Pat
 GHC.Hs.Type
 GHC.Hs.Utils
+GHC.HsToCore.Errors.Ppr
+GHC.HsToCore.Errors.Types
 GHC.Iface.Ext.Fields
 GHC.Iface.Recomp.Binary
 GHC.Iface.Syntax
@@ -113,6 +117,8 @@ GHC.Parser
 GHC.Parser.Annotation
 GHC.Parser.CharClass
 GHC.Parser.Errors
+GHC.Parser.Errors.Ppr
+GHC.Parser.Errors.Types
 GHC.Parser.Lexer
 GHC.Parser.PostProcess
 GHC.Parser.PostProcess.Haddock
@@ -146,6 +152,8 @@ GHC.StgToCmm.Types
 GHC.SysTools.BaseDir
 GHC.SysTools.Terminal
 GHC.Tc.Errors.Hole.FitTypes
+GHC.Tc.Errors.Ppr
+GHC.Tc.Errors.Types
 GHC.Tc.Types
 GHC.Tc.Types.Constraint
 GHC.Tc.Types.Evidence
diff --git a/testsuite/tests/regalloc/regalloc_unit_tests.hs b/testsuite/tests/regalloc/regalloc_unit_tests.hs
index b956f2579a..4e84261264 100644
--- a/testsuite/tests/regalloc/regalloc_unit_tests.hs
+++ b/testsuite/tests/regalloc/regalloc_unit_tests.hs
@@ -124,7 +124,7 @@ compileCmmForRegAllocStats logger dflags' cmmFile ncgImplF us = do
         errorMsgs   = fmap mkParserErr errors
 
     -- print parser errors or warnings
-    mapM_ (printBagOfErrors logger dflags) [warningMsgs, errorMsgs]
+    mapM_ (printMessages logger dflags . mkMessages) [warningMsgs, errorMsgs]
 
     let initTopSRT = emptySRT thisMod
     cmmGroup <- fmap snd $ cmmPipeline hscEnv initTopSRT $ fst $ fromJust parsedCmm
diff --git a/testsuite/tests/safeHaskell/check/Check05.stderr b/testsuite/tests/safeHaskell/check/Check05.stderr
index 9db0875f44..c14f8c02b2 100644
--- a/testsuite/tests/safeHaskell/check/Check05.stderr
+++ b/testsuite/tests/safeHaskell/check/Check05.stderr
@@ -1,3 +1,3 @@
 
-Check05.hs:1:16:
+Check05.hs:1:17:
     Warning: -fpackage-trust ignored; must be specified with a Safe Haskell flag
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags18.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags18.stderr
index 2766f41512..603cb636a7 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags18.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags18.stderr
@@ -1,3 +1,3 @@
 
-SafeFlags18.hs:1:16: error: [-Werror]
+SafeFlags18.hs:1:17: error: [-Werror]
     -fpackage-trust ignored; must be specified with a Safe Haskell flag
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags19.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags19.stderr
index adbc757494..e47c40a558 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags19.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags19.stderr
@@ -1,3 +1,3 @@
 
-SafeFlags19.hs:1:16:
+SafeFlags19.hs:1:17:
     unknown flag in  {-# OPTIONS_GHC #-} pragma: -fno-package-trust
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags22.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags22.stderr
index 9d93e5e332..cc4d8b7ae1 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags22.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags22.stderr
@@ -1,5 +1,5 @@
 
-SafeFlags22.hs:2:16: warning: [-Wunsafe]
+SafeFlags22.hs:2:17: warning: [-Wunsafe]
     ‘SafeFlags22’ has been inferred as unsafe!
     Reason:
         SafeFlags22.hs:8:1: error:
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags23.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags23.stderr
index 6fef7a3e4c..3bb3d3b02a 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags23.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags23.stderr
@@ -1,5 +1,5 @@
 
-SafeFlags23.hs:2:16: error: [-Wunsafe, -Werror=unsafe]
+SafeFlags23.hs:2:17: error: [-Wunsafe, -Werror=unsafe]
     ‘SafeFlags22’ has been inferred as unsafe!
     Reason:
         SafeFlags23.hs:8:1: error:
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags25.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags25.stderr
index e26a813e83..57bcdaa192 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags25.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags25.stderr
@@ -1,3 +1,3 @@
 
-SafeFlags25.hs:2:16: warning: [-Wsafe]
+SafeFlags25.hs:2:17: warning: [-Wsafe]
     ‘SafeFlags25’ has been inferred as safe!
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags26.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags26.stderr
index dabbd92c00..f4b084a9a5 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags26.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags26.stderr
@@ -1,3 +1,3 @@
 
-SafeFlags26.hs:2:16: error: [-Wsafe, -Werror=safe]
+SafeFlags26.hs:2:17: error: [-Wsafe, -Werror=safe]
     ‘SafeFlags26’ has been inferred as safe!
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags28.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags28.stderr
index 46dcabb9fd..13fdaf0c1a 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags28.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags28.stderr
@@ -1,12 +1,12 @@
 
-SafeFlags28.hs:1:16:
+SafeFlags28.hs:1:17: error:
     unknown flag in  {-# OPTIONS_GHC #-} pragma: -trust
 
-SafeFlags28.hs:1:16:
+SafeFlags28.hs:1:24: error:
     unknown flag in  {-# OPTIONS_GHC #-} pragma: base,
 
-SafeFlags28.hs:1:16:
+SafeFlags28.hs:1:30: error:
     unknown flag in  {-# OPTIONS_GHC #-} pragma: -trust
 
-SafeFlags28.hs:1:16:
+SafeFlags28.hs:1:37: error:
     unknown flag in  {-# OPTIONS_GHC #-} pragma: bytestring
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags29.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags29.stderr
index ee0d13b957..2c32e70254 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags29.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags29.stderr
@@ -1,12 +1,12 @@
 
-SafeFlags29.hs:2:16:
+SafeFlags29.hs:2:17: error:
     unknown flag in  {-# OPTIONS_GHC #-} pragma: -trust
 
-SafeFlags29.hs:2:16:
+SafeFlags29.hs:2:24: error:
     unknown flag in  {-# OPTIONS_GHC #-} pragma: base
 
-SafeFlags29.hs:2:16:
+SafeFlags29.hs:2:29: error:
     unknown flag in  {-# OPTIONS_GHC #-} pragma: -trust
 
-SafeFlags29.hs:2:16:
+SafeFlags29.hs:2:36: error:
     unknown flag in  {-# OPTIONS_GHC #-} pragma: bytestring
diff --git a/testsuite/tests/safeHaskell/overlapping/SH_Overlap11.stderr b/testsuite/tests/safeHaskell/overlapping/SH_Overlap11.stderr
index 9eb029951f..0e990b4f97 100644
--- a/testsuite/tests/safeHaskell/overlapping/SH_Overlap11.stderr
+++ b/testsuite/tests/safeHaskell/overlapping/SH_Overlap11.stderr
@@ -2,7 +2,7 @@
 [2 of 3] Compiling SH_Overlap11_A   ( SH_Overlap11_A.hs, SH_Overlap11_A.o )
 [3 of 3] Compiling SH_Overlap11     ( SH_Overlap11.hs, SH_Overlap11.o )
 
-SH_Overlap11.hs:2:16: warning: [-Wunsafe]
+SH_Overlap11.hs:2:17: warning: [-Wunsafe]
     ‘SH_Overlap11’ has been inferred as unsafe!
     Reason:
         SH_Overlap11.hs:18:8: warning:
diff --git a/testsuite/tests/safeHaskell/overlapping/SH_Overlap7.stderr b/testsuite/tests/safeHaskell/overlapping/SH_Overlap7.stderr
index 4a4fb3779c..dda1490ce0 100644
--- a/testsuite/tests/safeHaskell/overlapping/SH_Overlap7.stderr
+++ b/testsuite/tests/safeHaskell/overlapping/SH_Overlap7.stderr
@@ -2,7 +2,7 @@
 [2 of 3] Compiling SH_Overlap7_A    ( SH_Overlap7_A.hs, SH_Overlap7_A.o )
 [3 of 3] Compiling SH_Overlap7      ( SH_Overlap7.hs, SH_Overlap7.o )
 
-SH_Overlap7.hs:2:16: error: [-Wunsafe, -Werror=unsafe]
+SH_Overlap7.hs:2:17: error: [-Wunsafe, -Werror=unsafe]
     ‘SH_Overlap7’ has been inferred as unsafe!
     Reason:
         SH_Overlap7.hs:15:8:
diff --git a/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.stderr b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.stderr
index 2e9e92a696..664d3fa298 100644
--- a/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.stderr
@@ -3,6 +3,6 @@ SafeInfered05.hs:3:14: warning: [-Wdeprecated-flags (in -Wdefault)]
     -XOverlappingInstances is deprecated: instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS
 [1 of 2] Compiling SafeInfered05_A  ( SafeInfered05_A.hs, SafeInfered05_A.o )
 
-SafeInfered05_A.hs:3:16: warning: [-Wsafe]
+SafeInfered05_A.hs:3:17: warning: [-Wsafe]
     ‘SafeInfered05_A’ has been inferred as safe!
 [2 of 2] Compiling SafeInfered05    ( SafeInfered05.hs, SafeInfered05.o )
diff --git a/testsuite/tests/safeHaskell/safeInfered/SafeWarn01.stderr b/testsuite/tests/safeHaskell/safeInfered/SafeWarn01.stderr
index 7efaba3490..13155f3043 100644
--- a/testsuite/tests/safeHaskell/safeInfered/SafeWarn01.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/SafeWarn01.stderr
@@ -1,3 +1,3 @@
 
-SafeWarn01.hs:3:16: warning: [-Wsafe]
+SafeWarn01.hs:3:17: warning: [-Wsafe]
     ‘SafeWarn01’ has been inferred as safe!
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr
index 919eec4e6b..31a8488b74 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr
@@ -1,6 +1,6 @@
 [1 of 2] Compiling UnsafeInfered11_A ( UnsafeInfered11_A.hs, UnsafeInfered11_A.o )
 
-UnsafeInfered11_A.hs:2:16: warning: [-Wunsafe]
+UnsafeInfered11_A.hs:2:17: warning: [-Wunsafe]
     ‘UnsafeInfered11_A’ has been inferred as unsafe!
     Reason:
         UnsafeInfered11_A.hs:18:11: warning:
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr
index e3529474bd..22a07d9f96 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr
@@ -1,5 +1,5 @@
 
-UnsafeInfered12.hs:3:16: error: [-Wunsafe, -Werror=unsafe]
+UnsafeInfered12.hs:3:17: error: [-Wunsafe, -Werror=unsafe]
     ‘UnsafeInfered12’ has been inferred as unsafe!
     Reason:
         UnsafeInfered12.hs:2:14:
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn01.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn01.stderr
index 5424c5f2a2..1bced3b94a 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn01.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn01.stderr
@@ -1,5 +1,5 @@
 
-UnsafeWarn01.hs:3:16: warning: [-Wunsafe]
+UnsafeWarn01.hs:3:17: warning: [-Wunsafe]
     ‘UnsafeWarn01’ has been inferred as unsafe!
     Reason:
         UnsafeWarn01.hs:8:1: error:
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn02.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn02.stderr
index 881db587d5..0061ed3e1d 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn02.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn02.stderr
@@ -1,5 +1,5 @@
 
-UnsafeWarn02.hs:3:16: warning: [-Wunsafe]
+UnsafeWarn02.hs:3:17: warning: [-Wunsafe]
     ‘UnsafeWarn02’ has been inferred as unsafe!
     Reason:
         UnsafeWarn02.hs:5:14:
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn03.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn03.stderr
index ba23b72ee1..c48a136f74 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn03.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn03.stderr
@@ -1,5 +1,5 @@
 
-UnsafeWarn03.hs:4:16: warning: [-Wunsafe]
+UnsafeWarn03.hs:4:17: warning: [-Wunsafe]
     ‘UnsafeWarn03’ has been inferred as unsafe!
     Reason:
         UnsafeWarn03.hs:9:1: error:
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn04.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn04.stderr
index 90e6d5b6f1..94f0203f46 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn04.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn04.stderr
@@ -1,5 +1,5 @@
 
-UnsafeWarn04.hs:4:16: warning: [-Wunsafe]
+UnsafeWarn04.hs:4:17: warning: [-Wunsafe]
     ‘UnsafeWarn04’ has been inferred as unsafe!
     Reason:
         UnsafeWarn04.hs:9:1: error:
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.stderr
index 2977504457..471443ea12 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.stderr
@@ -1,12 +1,12 @@
 
-UnsafeWarn05.hs:5:16: warning: [-Wunsafe]
+UnsafeWarn05.hs:5:17: warning: [-Wunsafe]
     ‘UnsafeWarn05’ has been inferred as unsafe!
     Reason:
         UnsafeWarn05.hs:11:1: error:
             System.IO.Unsafe: Can't be safely imported!
             The module itself isn't safe.
 
-UnsafeWarn05.hs:5:16: warning: [-Wunsafe]
+UnsafeWarn05.hs:5:17: warning: [-Wunsafe]
     ‘UnsafeWarn05’ has been inferred as unsafe!
     Reason:
         UnsafeWarn05.hs:16:11: warning:
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.stderr
index 98b1360202..b494f02eec 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.stderr
@@ -1,5 +1,5 @@
 
-UnsafeWarn06.hs:4:16: warning: [-Wunsafe]
+UnsafeWarn06.hs:4:17: warning: [-Wunsafe]
     ‘UnsafeWarn06’ has been inferred as unsafe!
     Reason:
         UnsafeWarn06.hs:9:11: warning:
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.stderr
index 91a4ec3547..0b3370cb59 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.stderr
@@ -1,5 +1,5 @@
 
-UnsafeWarn07.hs:5:16: warning: [-Wunsafe]
+UnsafeWarn07.hs:5:17: warning: [-Wunsafe]
     ‘UnsafeWarn07’ has been inferred as unsafe!
     Reason:
         UnsafeWarn07.hs:10:11: warning:
diff --git a/testsuite/tests/th/T19709a.hs b/testsuite/tests/th/T19709a.hs
new file mode 100644
index 0000000000..8c0e5fd665
--- /dev/null
+++ b/testsuite/tests/th/T19709a.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell, ExplicitForAll, PolyKinds #-}
+
+module T19709a where
+
+import GHC.Exts
+
+$( let levid :: forall (r :: RuntimeRep) (a :: TYPE r). a -> a
+       levid x = x
+   in return [] )
diff --git a/testsuite/tests/th/T19709a.stderr b/testsuite/tests/th/T19709a.stderr
new file mode 100644
index 0000000000..4cb72aeed7
--- /dev/null
+++ b/testsuite/tests/th/T19709a.stderr
@@ -0,0 +1,6 @@
+
+T19709a.hs:8:14: error:
+    A levity-polymorphic type is not allowed here:
+      Type: a
+      Kind: TYPE r
+    In the type of binder ‘x’
diff --git a/testsuite/tests/th/T19709b.hs b/testsuite/tests/th/T19709b.hs
new file mode 100644
index 0000000000..afc9ed5769
--- /dev/null
+++ b/testsuite/tests/th/T19709b.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell, ExplicitForAll, PolyKinds, TypeApplications #-}
+
+module T19709b where
+
+import GHC.Exts
+import Language.Haskell.TH
+
+$( let levfun :: forall (r :: RuntimeRep) (a :: TYPE r). a -> ()
+       levfun = error "e1"  -- NB: this, so far, is OK: no levity-polymorphic binder
+
+   in levfun (error @Any "e2")  -- but this is very naughty: levity-polymorphic argument
+      `seq` return [] )
diff --git a/testsuite/tests/th/T19709b.stderr b/testsuite/tests/th/T19709b.stderr
new file mode 100644
index 0000000000..78405ebaea
--- /dev/null
+++ b/testsuite/tests/th/T19709b.stderr
@@ -0,0 +1,6 @@
+
+T19709b.hs:11:14: error:
+    A levity-polymorphic type is not allowed here:
+      Type: Any
+      Kind: TYPE Any
+    In the type of expression: (error @Any "e2")
diff --git a/testsuite/tests/th/T19709c.hs b/testsuite/tests/th/T19709c.hs
new file mode 100644
index 0000000000..588b269fc3
--- /dev/null
+++ b/testsuite/tests/th/T19709c.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wincomplete-patterns -Werror #-}
+
+module T19709c where
+
+import Language.Haskell.TH
+
+$( do runIO $ putStrLn "compiling the splice"
+      case tail "hello" of "hello" -> return [] )
diff --git a/testsuite/tests/th/T19709c.stderr b/testsuite/tests/th/T19709c.stderr
new file mode 100644
index 0000000000..3bedc08dc9
--- /dev/null
+++ b/testsuite/tests/th/T19709c.stderr
@@ -0,0 +1,10 @@
+
+T19709c.hs:9:7: error: [-Wincomplete-patterns (in -Wextra), -Werror=incomplete-patterns]
+    Pattern match(es) are non-exhaustive
+    In a case alternative:
+        Patterns of type ‘String’ not matched:
+            []
+            [p] where p is not one of {'h'}
+            (p:_:_) where p is not one of {'h'}
+            ['h']
+            ...
diff --git a/testsuite/tests/th/T19709d.hs b/testsuite/tests/th/T19709d.hs
new file mode 100644
index 0000000000..81985e80db
--- /dev/null
+++ b/testsuite/tests/th/T19709d.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wincomplete-patterns #-}
+
+module T19709d where
+
+$( case tail "hello" of "hello" -> return [] )
diff --git a/testsuite/tests/th/T19709d.stderr b/testsuite/tests/th/T19709d.stderr
new file mode 100644
index 0000000000..4adadd09ba
--- /dev/null
+++ b/testsuite/tests/th/T19709d.stderr
@@ -0,0 +1,16 @@
+
+T19709d.hs:6:4: warning: [-Wincomplete-patterns (in -Wextra)]
+    Pattern match(es) are non-exhaustive
+    In a case alternative:
+        Patterns of type ‘String’ not matched:
+            []
+            [p] where p is not one of {'h'}
+            (p:_:_) where p is not one of {'h'}
+            ['h']
+            ...
+
+T19709d.hs:1:1: error:
+    Exception when trying to run compile-time code:
+      T19709d.hs:6:4-44: Non-exhaustive patterns in case
+
+    Code: (case tail "hello" of "hello" -> return [])
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index fb3bc7fb49..c34b92977a 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -514,6 +514,10 @@ test('TH_BytesShowEqOrd', normal, compile_and_run, [''])
 test('T18102', normal, compile_fail, [''])
 test('T18102b', extra_files(['T18102b_aux.hs']), compile_and_run, [''])
 test('T18121', normal, compile, [''])
+test('T19709a', normal, compile_fail, [''])
+test('T19709b', normal, compile_fail, [''])
+test('T19709c', normal, compile_fail, [''])
+test('T19709d', normal, compile_fail, [''])
 test('T18123', normal, compile, [''])
 test('T18388', normal, compile, [''])
 test('T18612', normal, compile, [''])