Check quoted TH names are in the correct namespace

When quoting (using a TH single or double quote) a built-in
name such as the list constructor (:), we didn't always check
that the resulting 'Name' was in the correct namespace.

This patch adds a check in GHC.Rename.Splice to ensure
we get a Name that is in the term-level/type-level namespace,
when using a single/double tick, respectively.

Fixes #20884.

15 files changed, 132 insertions, 44 deletions

diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index 3c2b332ece..97f5b2c2eb 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -123,6 +123,7 @@ rnBracket e br_body
 rn_bracket :: ThStage -> HsBracket GhcPs -> RnM (HsBracket GhcRn, FreeVars)
 rn_bracket outer_stage br@(VarBr x flg rdr_name)
   = do { name <- lookupOccRn (unLoc rdr_name)
+       ; check_namespace flg name
        ; this_mod <- getModule
 
        ; when (flg && nameIsLocalOrFrom this_mod name) $
@@ -185,6 +186,15 @@ rn_bracket _ (DecBrG {}) = panic "rn_bracket: unexpected DecBrG"
 rn_bracket _ (TExpBr x e) = do { (e', fvs) <- rnLExpr e
                                ; return (TExpBr x e', fvs) }
 
+-- | Ensure that we are not using a term-level name in a type-level namespace
+-- or vice-versa. Throws a 'TcRnIncorrectNameSpace' error if there is a problem.
+check_namespace :: Bool -> Name -> RnM ()
+check_namespace is_single_tick nm
+  = unless (isValNameSpace ns == is_single_tick) $
+      failWithTc $ (TcRnIncorrectNameSpace nm True)
+  where
+    ns = nameNameSpace nm
+
 quotationCtxtDoc :: HsBracket GhcPs -> SDoc
 quotationCtxtDoc br_body
   = hang (text "In the Template Haskell quotation")
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 5353280438..fe3536157c 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -526,6 +526,21 @@ instance Diagnostic TcRnMessage where
       -> mkSimpleDecorated $
             fsep [ text "Pattern matching on GADTs without MonoLocalBinds"
                  , text "is fragile." ]
+    TcRnIncorrectNameSpace name _
+      -> mkSimpleDecorated $ msg
+        where
+          msg
+            -- We are in a type-level namespace,
+            -- and the name is incorrectly at the term-level.
+            | isValNameSpace ns
+            = text "The" <+> what <+> text "does not live in the type-level namespace"
+
+            -- We are in a term-level namespace,
+            -- and the name is incorrectly at the type-level.
+            | otherwise
+            = text "Illegal term-level use of the" <+> what
+          ns = nameNameSpace name
+          what = pprNameSpace ns <+> quotes (ppr name)
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -746,6 +761,8 @@ instance Diagnostic TcRnMessage where
       -> WarningWithFlag Opt_WarnForallIdentifier
     TcRnGADTMonoLocalBinds {}
       -> WarningWithFlag Opt_WarnGADTMonoLocalBinds
+    TcRnIncorrectNameSpace {}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -960,6 +977,11 @@ instance Diagnostic TcRnMessage where
       -> [SuggestRenameForall]
     TcRnGADTMonoLocalBinds {}
       -> [suggestAnyExtension [LangExt.GADTs, LangExt.TypeFamilies]]
+    TcRnIncorrectNameSpace nm is_th_use
+      | is_th_use
+      -> [SuggestAppropriateTHTick $ nameNameSpace nm]
+      | otherwise
+      -> noHints
 
 deriveInstanceErrReasonHints :: Class
                              -> UsingGeneralizedNewtypeDeriving
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index accd611e68..e84f30a7c0 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -1432,6 +1432,22 @@ data TcRnMessage where
   -}
   TcRnGADTMonoLocalBinds :: TcRnMessage
 
+  {-| TcRnIncorrectNameSpace is an error that occurs when a 'Name'
+      is used in the incorrect 'NameSpace', e.g. a type constructor
+      or class used in a term, or a term variable used in a type.
+
+      Example:
+
+        f x = Int
+
+      Test cases: T18740a, T20884.
+  -}
+  TcRnIncorrectNameSpace :: Name
+                         -> Bool -- ^ whether the error is happening
+                                 -- in a Template Haskell tick
+                                 -- (so we should give a Template Haskell hint)
+                         -> TcRnMessage
+
 -- | Which parts of a record field are affected by a particular error or warning.
 data RecordFieldPart
   = RecordFieldConstructor !Name
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index 9fbd972f8a..216b7c057e 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -71,6 +71,7 @@ import GHC.Tc.Types.Evidence
 import GHC.Builtin.Types( multiplicityTy )
 import GHC.Builtin.Names
 import GHC.Builtin.Names.TH( liftStringName, liftName )
+import GHC.Driver.Env
 import GHC.Driver.Session
 import GHC.Types.SrcLoc
 import GHC.Utils.Misc
@@ -759,21 +760,25 @@ tc_infer_id id_name
                   ppr thing <+> text "used where a value identifier was expected" }
   where
     fail_tycon tc = do
-      gre <- getGlobalRdrEnv
-      let msg = text "Illegal term-level use of the type constructor"
-                  <+> quotes (ppr (tyConName tc))
-          pprov = case lookupGRE_Name gre (tyConName tc) of
-            Just gre -> nest 2 (pprNameProvenance gre)
-            Nothing  -> empty
-      suggestions <- get_suggestions dataName
-      failWithTc (TcRnUnknownMessage $ mkPlainError noHints (msg $$ pprov $$ suggestions))
+       gre <- getGlobalRdrEnv
+       suggestions <- get_suggestions dataName
+       unit_state <- hsc_units <$> getTopEnv
+       let pprov = case lookupGRE_Name gre (tyConName tc) of
+                      Just gre -> nest 2 (pprNameProvenance gre)
+                      Nothing  -> empty
+           info = ErrInfo { errInfoContext = pprov, errInfoSupplementary = suggestions }
+           msg = TcRnMessageWithInfo unit_state
+               $ TcRnMessageDetailed info (TcRnIncorrectNameSpace (tyConName tc) False)
+       failWithTc msg
 
     fail_tyvar name = do
-      let msg = text "Illegal term-level use of the type variable"
-                  <+> quotes (ppr name)
-          pprov = nest 2 (text "bound at" <+> ppr (getSrcLoc name))
-      suggestions <- get_suggestions varName
-      failWithTc (TcRnUnknownMessage $ mkPlainError noHints (msg $$ pprov $$ suggestions))
+       suggestions <- get_suggestions varName
+       unit_state <- hsc_units <$> getTopEnv
+       let pprov = nest 2 (text "bound at" <+> ppr (getSrcLoc name))
+           info = ErrInfo { errInfoContext = pprov, errInfoSupplementary = suggestions }
+           msg = TcRnMessageWithInfo unit_state
+               $ TcRnMessageDetailed info (TcRnIncorrectNameSpace name False)
+       failWithTc msg
 
     get_suggestions ns = do
        let occ = mkOccNameFS ns (occNameFS (occName id_name))
diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs
index 1f76f028d7..519e55edb1 100644
--- a/compiler/GHC/Types/Hint.hs
+++ b/compiler/GHC/Types/Hint.hs
@@ -24,7 +24,7 @@ import Data.Typeable
 import GHC.Unit.Module (ModuleName, Module)
 import GHC.Hs.Extension (GhcTc)
 import GHC.Core.Coercion
-import GHC.Types.Name (Name)
+import GHC.Types.Name (Name, NameSpace)
 import GHC.Types.Basic (Activation, RuleName)
 import GHC.Parser.Errors.Basic
 import {-# SOURCE #-} Language.Haskell.Syntax.Expr
@@ -314,6 +314,14 @@ data GhcHint
     -}
   | SuggestRenameForall
 
+    {-| Suggests to use the appropriate Template Haskell tick:
+        a single tick for a term-level 'NameSpace', or a double tick
+        for a type-level 'NameSpace'.
+
+        Triggered by: 'GHC.Tc.Errors.Types.TcRnIncorrectNameSpace'.
+    -}
+  | SuggestAppropriateTHTick NameSpace
+
 -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated
 -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
 -- to instantiate a particular signature, where the first argument is
diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs
index 1419078df6..a11be60209 100644
--- a/compiler/GHC/Types/Hint/Ppr.hs
+++ b/compiler/GHC/Types/Hint/Ppr.hs
@@ -14,6 +14,7 @@ import GHC.Types.Hint
 
 import GHC.Hs.Expr ()   -- instance Outputable
 import GHC.Types.Id
+import GHC.Types.Name (isValNameSpace)
 import GHC.Unit.Types
 import GHC.Utils.Outputable
 
@@ -131,6 +132,12 @@ instance Outputable GhcHint where
               , quotes (text "forAll") <> comma <+>
                 quotes (text "for_all") <> comma <+> text "or" <+>
                 quotes (text "forall_") <> dot ]
+    SuggestAppropriateTHTick ns
+      -> text "Perhaps use a" <+> how_many <+> text "tick"
+        where
+          how_many
+            | isValNameSpace ns = text "single"
+            | otherwise         = text "double"
 
 perhapsAsPat :: SDoc
 perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
diff --git a/testsuite/tests/module/mod132.stderr b/testsuite/tests/module/mod132.stderr
index 31d9c8eeb6..0c901d090c 100644
--- a/testsuite/tests/module/mod132.stderr
+++ b/testsuite/tests/module/mod132.stderr
@@ -1,8 +1,8 @@
 
 mod132.hs:6:7: error:
-    • Illegal term-level use of the type constructor ‘Foo’
-        imported from ‘Mod132_B’ at mod132.hs:4:1-15
-        (and originally defined in ‘Mod132_A’ at Mod132_A.hs:3:1-14)
-      Perhaps you meant variable ‘foo’ (line 6)
+    • Illegal term-level use of the type constructor or class ‘Foo’
+    • imported from ‘Mod132_B’ at mod132.hs:4:1-15
+      (and originally defined in ‘Mod132_A’ at Mod132_A.hs:3:1-14)
+    • Perhaps you meant variable ‘foo’ (line 6)
     • In the expression: Foo
       In an equation for ‘foo’: foo = Foo
diff --git a/testsuite/tests/module/mod147.stderr b/testsuite/tests/module/mod147.stderr
index 80267f8f24..5500abc5bd 100644
--- a/testsuite/tests/module/mod147.stderr
+++ b/testsuite/tests/module/mod147.stderr
@@ -1,7 +1,7 @@
 
-mod147.hs:6:5:
-     Illegal term-level use of the type constructor ‘D’
-        imported from ‘Mod147_A’ at mod147.hs:4:1-15
-        (and originally defined at Mod147_A.hs:3:1-14)
-     In the expression: D 4
+mod147.hs:6:5: error:
+    • Illegal term-level use of the type constructor or class ‘D’
+    • imported from ‘Mod147_A’ at mod147.hs:4:1-15
+      (and originally defined at Mod147_A.hs:3:1-14)
+    • In the expression: D 4
       In an equation for ‘x’: x = D 4
diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr
index 8beac36a43..6367162c68 100644
--- a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr
+++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr
@@ -1,7 +1,7 @@
 
-RnStaticPointersFail02.hs:5:12:
-Illegal term-level use of the type constructor ‘T’
-  defined at RnStaticPointersFail02.hs:7:1
-In the body of a static form: T
-  In the expression: static T
-  In an equation for ‘f’: f = static T
+RnStaticPointersFail02.hs:5:12: error:
+    • Illegal term-level use of the type constructor or class ‘T’
+    • defined at RnStaticPointersFail02.hs:7:1
+    • In the body of a static form: T
+      In the expression: static T
+      In an equation for ‘f’: f = static T
diff --git a/testsuite/tests/rename/should_fail/T18740a.stderr b/testsuite/tests/rename/should_fail/T18740a.stderr
index 2a0463adf0..c814f2bf36 100644
--- a/testsuite/tests/rename/should_fail/T18740a.stderr
+++ b/testsuite/tests/rename/should_fail/T18740a.stderr
@@ -1,7 +1,7 @@
 
 T18740a.hs:3:5: error:
-    • Illegal term-level use of the type constructor ‘Int’
-        imported from ‘Prelude’ at T18740a.hs:1:8-14
-        (and originally defined in ‘GHC.Types’)
+    • Illegal term-level use of the type constructor or class ‘Int’
+    • imported from ‘Prelude’ at T18740a.hs:1:8-14
+      (and originally defined in ‘GHC.Types’)
     • In the expression: Int
       In an equation for ‘x’: x = Int
diff --git a/testsuite/tests/th/T14627.stderr b/testsuite/tests/th/T14627.stderr
index e9e8486256..9d9b9785f0 100644
--- a/testsuite/tests/th/T14627.stderr
+++ b/testsuite/tests/th/T14627.stderr
@@ -1,7 +1,7 @@
 
-T14627.hs:4:1:
-Illegal term-level use of the type constructor ‘Bool’
-  imported from ‘Prelude’ at T14627.hs:1:1
-  (and originally defined in ‘GHC.Types’)
-In the expression: Bool
- In an equation for ‘f’: f = Bool
+T14627.hs:4:1: error:
+    • Illegal term-level use of the type constructor or class ‘Bool’
+    • imported from ‘Prelude’ at T14627.hs:1:1
+      (and originally defined in ‘GHC.Types’)
+    • In the expression: Bool
+      In an equation for ‘f’: f = Bool
diff --git a/testsuite/tests/th/T20884.hs b/testsuite/tests/th/T20884.hs
new file mode 100644
index 0000000000..0901cd1808
--- /dev/null
+++ b/testsuite/tests/th/T20884.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T20884 where
+
+import Language.Haskell.TH
+
+list1 = $( conE '(:) `appE` litE (IntegerL 5) `appE` conE '[] )
+  -- OK
+
+list2 = $( conE ''(:) `appE` litE (IntegerL 5) `appE` conE '[] )
+  -- should fail because we are trying to quote a type named (:),
+  -- but (:) is not in the type namespace.
diff --git a/testsuite/tests/th/T20884.stderr b/testsuite/tests/th/T20884.stderr
new file mode 100644
index 0000000000..20c1c34fd1
--- /dev/null
+++ b/testsuite/tests/th/T20884.stderr
@@ -0,0 +1,7 @@
+
+T20884.hs:10:17: error:
+    • The data constructor ‘:’ does not live in the type-level namespace
+    • In the Template Haskell quotation ''(:)
+      In the untyped splice:
+        $(conE ''(:) `appE` litE (IntegerL 5) `appE` conE '[])
+    Suggested fix: Perhaps use a single tick
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index cfd40a40df..b04f9cae85 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -539,3 +539,4 @@ test('T17820d', normal, compile_fail, [''])
 test('T17820e', normal, compile_fail, [''])
 test('T20590', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T20773', only_ways(['ghci']), ghci_script, ['T20773.script'])
+test('T20884', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_fail/T19978.stderr b/testsuite/tests/typecheck/should_fail/T19978.stderr
index 7f41c37ad4..4ea25fcf04 100644
--- a/testsuite/tests/typecheck/should_fail/T19978.stderr
+++ b/testsuite/tests/typecheck/should_fail/T19978.stderr
@@ -1,9 +1,9 @@
 
 T19978.hs:8:7: error:
-    • Illegal term-level use of the type constructor ‘Bool’
-        imported from ‘Prelude’ at T19978.hs:3:8-13
-        (and originally defined in ‘GHC.Types’)
-      Perhaps you meant one of these:
+    • Illegal term-level use of the type constructor or class ‘Bool’
+    • imported from ‘Prelude’ at T19978.hs:3:8-13
+      (and originally defined in ‘GHC.Types’)
+    • Perhaps you meant one of these:
         ‘Bowl’ (line 11), variable ‘bool’ (line 12)
     • In the expression: Bool
       In an equation for ‘ex1’: ex1 = Bool
@@ -14,8 +14,8 @@ T19978.hs:14:7: error:
 
 T19978.hs:21:7: error:
     • Illegal term-level use of the type variable ‘mytv’
-        bound at T19978.hs:20:15
-      Perhaps you meant one of these:
+    • bound at T19978.hs:20:15
+    • Perhaps you meant one of these:
         data constructor ‘Mytv’ (line 24), ‘myvv’ (line 25)
     • In the expression: mytv
       In an equation for ‘ex3’: ex3 = mytv