Remove TcRnUnknownMessage usage from GHC.Rename.Env #20115

6 files changed, 127 insertions, 49 deletions

diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index e5c1c17f3c..13343135ab 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -77,7 +77,7 @@ import GHC.Types.Hint
 import GHC.Types.Error
 import GHC.Unit.Module
 import GHC.Unit.Module.ModIface
-import GHC.Unit.Module.Warnings  ( WarningTxt, pprWarningTxtForMsg )
+import GHC.Unit.Module.Warnings  ( WarningTxt )
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.TyCon
@@ -275,7 +275,7 @@ lookupTopBndrRn which_suggest rdr_name =
           let occ = rdrNameOcc rdr_name
         ; when (isTcOcc occ && isSymOcc occ)
                (do { op_ok <- xoptM LangExt.TypeOperators
-                   ; unless op_ok (addErr (opDeclErr rdr_name)) })
+                   ; unless op_ok (addErr (TcRnIllegalTypeOperatorDecl rdr_name)) })
 
         ; env <- getGlobalRdrEnv
         ; case filter isLocalGRE (lookupGRE_RdrName rdr_name env) of
@@ -1111,10 +1111,10 @@ lookup_promoted rdr_name
 
 badVarInType :: RdrName -> RnM Name
 badVarInType rdr_name
-  = do { addErr (TcRnUnknownMessage $ mkPlainError noHints
-           (text "Illegal promoted term variable in a type:"
-                 <+> ppr rdr_name))
-       ; return (mkUnboundNameRdr rdr_name) }
+  = do { addErr (TcRnUnpromotableThing name TermVariablePE)
+       ; return name }
+      where
+        name = mkUnboundNameRdr rdr_name
 
 {- Note [Promoted variables in types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1553,34 +1553,22 @@ warnIfDeprecated gre@(GRE { gre_imp = iss })
                    -- See Note [Handling of deprecations]
          do { iface <- loadInterfaceForName doc name
             ; case lookupImpDeprec iface gre of
-                Just txt -> do
-                  let msg = TcRnUnknownMessage $
-                              mkPlainDiagnostic (WarningWithFlag Opt_WarnWarningsDeprecations)
-                                                noHints
-                                                (mk_msg imp_spec txt)
-
-                  addDiagnostic msg
+                Just deprText -> addDiagnostic $
+                  TcRnDeprecated {
+                    depr_occ = occ,
+                    depr_msg = deprText,
+                    depr_import_mod = importSpecModule imp_spec,
+                    depr_defined_mod = definedMod
+                  }
                 Nothing  -> return () } }
   | otherwise
   = return ()
   where
     occ = greOccName gre
     name = greMangledName gre
-    name_mod = assertPpr (isExternalName name) (ppr name) (nameModule name)
+    definedMod = moduleName $ assertPpr (isExternalName name) (ppr name) (nameModule name)
     doc = text "The name" <+> quotes (ppr occ) <+> text "is mentioned explicitly"
 
-    mk_msg imp_spec txt
-      = sep [ sep [ text "In the use of"
-                    <+> pprNonVarNameSpace (occNameSpace occ)
-                    <+> quotes (ppr occ)
-                  , parens imp_msg <> colon ]
-            , pprWarningTxtForMsg txt ]
-      where
-        imp_mod  = importSpecModule imp_spec
-        imp_msg  = text "imported from" <+> ppr imp_mod <> extra
-        extra | imp_mod == moduleName name_mod = Outputable.empty
-              | otherwise = text ", but defined in" <+> ppr name_mod
-
 lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
 lookupImpDeprec iface gre
   = mi_warn_fn (mi_final_exts iface) (greOccName gre) `mplus`  -- Bleat if the thing,
@@ -2093,25 +2081,9 @@ lookupQualifiedDoName ctxt std_name
 
 -- Error messages
 
-opDeclErr :: RdrName -> TcRnMessage
-opDeclErr n
-  = TcRnUnknownMessage $ mkPlainError noHints $
-    hang (text "Illegal declaration of a type or class operator" <+> quotes (ppr n))
-       2 (text "Use TypeOperators to declare operators in type and declarations")
-
 badOrigBinding :: RdrName -> TcRnMessage
 badOrigBinding name
-  | Just _ <- isBuiltInOcc_maybe occ
-  = TcRnUnknownMessage $ mkPlainError noHints $ text "Illegal binding of built-in syntax:" <+> ppr occ
-    -- Use an OccName here because we don't want to print Prelude.(,)
-  | otherwise
-  = TcRnUnknownMessage $ mkPlainError noHints $
-    text "Cannot redefine a Name retrieved by a Template Haskell quote:" <+> ppr name
-    -- This can happen when one tries to use a Template Haskell splice to
-    -- define a top-level identifier with an already existing name, e.g.,
-    --
-    --   $(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []])
-    --
-    -- (See #13968.)
+  | Just _ <- isBuiltInOcc_maybe occ = TcRnIllegalBindingOfBuiltIn occ
+  | otherwise = TcRnNameByTemplateHaskellQuote name
   where
     occ = rdrNameOcc $ filterCTuple name
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 3dc1ea685b..3ab4fc2927 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -69,6 +69,7 @@ import GHC.Types.Var.Env
 
 import GHC.Unit.State (pprWithUnitState, UnitState)
 import GHC.Unit.Module
+import GHC.Unit.Module.Warnings  ( pprWarningTxtForMsg )
 
 import GHC.Data.Bag
 import GHC.Data.FastString
@@ -668,6 +669,9 @@ instance Diagnostic TcRnMessage where
       -> mkSimpleDecorated $
            text "Illegal operator" <+> quotes (ppr op) <+>
            text "in type" <+> quotes (ppr overall_ty)
+    TcRnIllegalTypeOperatorDecl name
+      -> mkSimpleDecorated $
+        text "Illegal declaration of a type or class operator" <+> quotes (ppr name)
     TcRnGADTMonoLocalBinds
       -> mkSimpleDecorated $
             fsep [ text "Pattern matching on GADTs without MonoLocalBinds"
@@ -894,6 +898,7 @@ instance Diagnostic TcRnMessage where
                      RecDataConPE   -> same_rec_group_msg
                      ClassPE        -> same_rec_group_msg
                      TyConPE        -> same_rec_group_msg
+                     TermVariablePE -> text "term variables cannot be promoted"
           same_rec_group_msg = text "it is defined and used in the same recursive group"
     TcRnMatchesHaveDiffNumArgs argsContext match1 bad_matches
       -> mkSimpleDecorated $
@@ -937,6 +942,20 @@ instance Diagnostic TcRnMessage where
       -> mkSimpleDecorated $
          text "You cannot SPECIALISE" <+> quotes (ppr name)
            <+> text "because its definition is not visible in this module"
+    TcRnNameByTemplateHaskellQuote name -> mkSimpleDecorated $
+      text "Cannot redefine a Name retrieved by a Template Haskell quote:" <+> ppr name
+    TcRnIllegalBindingOfBuiltIn name -> mkSimpleDecorated $
+       text "Illegal binding of built-in syntax:" <+> ppr name
+    TcRnDeprecated {depr_occ, depr_msg, depr_import_mod, depr_defined_mod} -> mkSimpleDecorated $
+      sep [ sep [ text "In the use of"
+                <+> pprNonVarNameSpace (occNameSpace depr_occ)
+                <+> quotes (ppr depr_occ)
+                , parens impMsg <> colon ]
+        , pprWarningTxtForMsg depr_msg ]
+        where
+          impMsg  = text "imported from" <+> ppr depr_import_mod <> extra
+          extra | depr_import_mod == depr_defined_mod = empty
+                | otherwise = text ", but defined in" <+> ppr depr_defined_mod
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -1167,6 +1186,8 @@ instance Diagnostic TcRnMessage where
       -> WarningWithFlag Opt_WarnTypeEqualityRequiresOperators
     TcRnIllegalTypeOperator {}
       -> ErrorWithoutFlag
+    TcRnIllegalTypeOperatorDecl {}
+      -> ErrorWithoutFlag
     TcRnGADTMonoLocalBinds {}
       -> WarningWithFlag Opt_WarnGADTMonoLocalBinds
     TcRnIncorrectNameSpace {}
@@ -1243,6 +1264,12 @@ instance Diagnostic TcRnMessage where
       -> WarningWithoutFlag
     TcRnSpecialiseNotVisible{}
       -> WarningWithoutFlag
+    TcRnNameByTemplateHaskellQuote{}
+      -> ErrorWithoutFlag
+    TcRnIllegalBindingOfBuiltIn{}
+      -> ErrorWithoutFlag
+    TcRnDeprecated{}
+      -> WarningWithFlag Opt_WarnWarningsDeprecations
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -1467,6 +1494,8 @@ instance Diagnostic TcRnMessage where
       -> [suggestExtension LangExt.TypeOperators]
     TcRnIllegalTypeOperator {}
       -> [suggestExtension LangExt.TypeOperators]
+    TcRnIllegalTypeOperatorDecl {}
+      -> [suggestExtension LangExt.TypeOperators]
     TcRnGADTMonoLocalBinds {}
       -> [suggestAnyExtension [LangExt.GADTs, LangExt.TypeFamilies]]
     TcRnIncorrectNameSpace nm is_th_use
@@ -1551,6 +1580,9 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnSpecialiseNotVisible name
       -> [SuggestSpecialiseVisibilityHints name]
+    TcRnNameByTemplateHaskellQuote{} -> noHints
+    TcRnIllegalBindingOfBuiltIn{} -> noHints
+    TcRnDeprecated{} -> noHints
 
 
 -- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z",
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index ad5f3db81b..fff6ff7dc9 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -113,6 +113,7 @@ import GHC.Data.FastString (FastString)
 import qualified Data.List.NonEmpty as NE
 import           Data.Typeable hiding (TyCon)
 import qualified Data.Semigroup as Semigroup
+import GHC.Unit.Module.Warnings (WarningTxt)
 
 {-
 Note [Migrating TcM Messages]
@@ -1621,6 +1622,27 @@ data TcRnMessage where
   -}
   TcRnIllegalTypeOperator :: !SDoc -> !RdrName -> TcRnMessage
 
+  {-| TcRnIllegalTypeOperatorDecl is an error that occurs when a type or class
+      operator is declared without the TypeOperators extension.
+
+      See Note [Type and class operator definitions]
+
+      Example:
+        {-# LANGUAGE Haskell2010 #-}
+        {-# LANGUAGE MultiParamTypeClasses #-}
+
+        module T3265 where
+
+        data a :+: b = Left a | Right b
+
+        class a :*: b where {}
+
+
+      Test cases: T3265, tcfail173
+  -}
+  TcRnIllegalTypeOperatorDecl :: !RdrName -> TcRnMessage
+
+
   {-| TcRnGADTMonoLocalBinds is a warning controlled by -Wgadt-mono-local-binds
       that occurs when pattern matching on a GADT when -XMonoLocalBinds is off.
 
@@ -2006,6 +2028,7 @@ data TcRnMessage where
                 polykinds/T15116a
                 saks/should_fail/T16727a
                 saks/should_fail/T16727b
+                rename/should_fail/T12686
   -}
   TcRnUnpromotableThing :: !Name -> !PromotionErr -> TcRnMessage
 
@@ -2109,6 +2132,50 @@ data TcRnMessage where
   -}
   TcRnSpecialiseNotVisible :: !Name -> TcRnMessage
 
+  {- TcRnNameByTemplateHaskellQuote is an error that occurs when one tries
+     to use a Template Haskell splice to define a top-level identifier with
+     an already existing name.
+
+     (See issue #13968 (closed) on GHC's issue tracker for more details)
+
+     Example(s):
+
+       $(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []])
+
+     Test cases:
+      T13968
+  -}
+  TcRnNameByTemplateHaskellQuote :: !RdrName -> TcRnMessage
+
+  {- TcRnIllegalBindingOfBuiltIn is an error that occurs when one uses built-in
+     syntax for data constructors or class names.
+
+     Use an OccName here because we don't want to print Prelude.(,)
+
+     Test cases:
+      rename/should_fail/T14907b
+      rename/should_fail/rnfail042
+  -}
+  TcRnIllegalBindingOfBuiltIn :: !OccName -> TcRnMessage
+
+  {- TcRnDeprecated is a warning that can happen when usage of something
+     is deprecated.
+
+    Test cases:
+      DeprU
+      T5281
+      T5867
+      rn050
+      rn066
+      T3303
+  -}
+  TcRnDeprecated :: {
+    depr_occ :: OccName,
+    depr_msg :: WarningTxt GhcRn,
+    depr_import_mod :: ModuleName,
+    depr_defined_mod :: ModuleName
+  } -> TcRnMessage
+
 -- | Specifies which back ends can handle a requested foreign import or export
 type ExpectedBackends = [Backend]
 
@@ -3081,6 +3148,7 @@ data PromotionErr
 
   | RecDataConPE     -- Data constructor in a recursive loop
                      -- See Note [Recursion and promoting data constructors] in GHC.Tc.TyCl
+  | TermVariablePE   -- See Note [Promoted variables in types]
   | NoDataKindsDC    -- -XDataKinds not enabled (for a datacon)
 
 instance Outputable PromotionErr where
@@ -3092,6 +3160,7 @@ instance Outputable PromotionErr where
                                       <+> parens (ppr pred)
   ppr RecDataConPE                = text "RecDataConPE"
   ppr NoDataKindsDC               = text "NoDataKindsDC"
+  ppr TermVariablePE              = text "TermVariablePE"
 
 pprPECategory :: PromotionErr -> SDoc
 pprPECategory = text . capitalise . peCategory
@@ -3104,6 +3173,7 @@ peCategory FamDataConPE           = "data constructor"
 peCategory ConstrainedDataConPE{} = "data constructor"
 peCategory RecDataConPE           = "data constructor"
 peCategory NoDataKindsDC          = "data constructor"
+peCategory TermVariablePE         = "term variable"
 
 -- | Stores the information to be reported in a representation-polymorphism
 -- error message.
diff --git a/testsuite/tests/rename/should_fail/T12686.stderr b/testsuite/tests/rename/should_fail/T12686.stderr
index 24acc9c8c1..682a3bd8f4 100644
--- a/testsuite/tests/rename/should_fail/T12686.stderr
+++ b/testsuite/tests/rename/should_fail/T12686.stderr
@@ -1,4 +1,8 @@
 
-T12686.hs:7:16: error: Illegal promoted term variable in a type: x
+T12686.hs:7:16:
+    Term variable ‘x’ cannot be used here
+      (term variables cannot be promoted)
 
-T12686.hs:12:19: error: Illegal promoted term variable in a type: a
+T12686.hs:12:19:
+    Term variable ‘a’ cannot be used here
+      (term variables cannot be promoted)
diff --git a/testsuite/tests/rename/should_fail/T3265.stderr b/testsuite/tests/rename/should_fail/T3265.stderr
index 42d89d0b4e..8ef1acdf39 100644
--- a/testsuite/tests/rename/should_fail/T3265.stderr
+++ b/testsuite/tests/rename/should_fail/T3265.stderr
@@ -1,8 +1,8 @@
 
 T3265.hs:8:8: error:
     Illegal declaration of a type or class operator ‘:+:’
-      Use TypeOperators to declare operators in type and declarations
+    Suggested fix: Perhaps you intended to use TypeOperators
 
 T3265.hs:10:9: error:
     Illegal declaration of a type or class operator ‘:*:’
-      Use TypeOperators to declare operators in type and declarations
+    Suggested fix: Perhaps you intended to use TypeOperators
diff --git a/testsuite/tests/typecheck/should_fail/tcfail173.stderr b/testsuite/tests/typecheck/should_fail/tcfail173.stderr
index a3da917f27..bd3a062062 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail173.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail173.stderr
@@ -1,4 +1,4 @@
 
 tcfail173.hs:6:12: error:
     Illegal declaration of a type or class operator ‘<.>’
-      Use TypeOperators to declare operators in type and declarations
+    Suggested fix: Perhaps you intended to use TypeOperators