Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115)

I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind
module. Instead, these TcRnMessage messages were introduced:
  TcRnMultipleFixityDecls
  TcRnIllegalPatternSynonymDecl
  TcRnIllegalClassBiding
  TcRnOrphanCompletePragma
  TcRnEmptyCase
  TcRnNonStdGuards
  TcRnDuplicateSigDecl
  TcRnMisplacedSigDecl
  TcRnUnexpectedDefaultSig
  TcRnBindInBootFile
  TcRnDuplicateMinimalSig

2 files changed, 281 insertions, 0 deletions

diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 3d6dfab2a4..9880c13a9c 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -1241,6 +1241,71 @@ instance Diagnostic TcRnMessage where
                 <+> ppr (nameSrcLoc lcl_name)
     TcRnBindingOfExistingName name -> mkSimpleDecorated $
       text "Illegal binding of an existing name:" <+> ppr (filterCTuple name)
+    TcRnMultipleFixityDecls loc rdr_name -> mkSimpleDecorated $
+      vcat [text "Multiple fixity declarations for" <+> quotes (ppr rdr_name),
+            text "also at " <+> ppr loc]
+    TcRnIllegalPatternSynonymDecl -> mkSimpleDecorated $
+      text "Illegal pattern synonym declaration"
+    TcRnIllegalClassBinding dsort bind -> mkSimpleDecorated $
+      vcat [ what <+> text "not allowed in" <+> decl_sort
+              , nest 2 (ppr bind) ]
+      where
+        decl_sort = case dsort of
+          ClassDeclSort -> text "class declaration:"
+          InstanceDeclSort -> text "instance declaration:"
+        what = case bind of
+                  PatBind {}    -> text "Pattern bindings (except simple variables)"
+                  PatSynBind {} -> text "Pattern synonyms"
+                                   -- Associated pattern synonyms are not implemented yet
+                  _ -> pprPanic "rnMethodBind" (ppr bind)
+    TcRnOrphanCompletePragma -> mkSimpleDecorated $
+      text "Orphan COMPLETE pragmas not supported" $$
+      text "A COMPLETE pragma must mention at least one data constructor" $$
+      text "or pattern synonym defined in the same module."
+    TcRnEmptyCase ctxt -> mkSimpleDecorated message
+      where
+        pp_ctxt = case ctxt of
+          CaseAlt                                  -> text "case expression"
+          LamCaseAlt LamCase                       -> text "\\case expression"
+          ArrowMatchCtxt (ArrowLamCaseAlt LamCase) -> text "\\case command"
+          ArrowMatchCtxt ArrowCaseAlt              -> text "case command"
+          ArrowMatchCtxt KappaExpr                 -> text "kappa abstraction"
+          _                                        -> text "(unexpected)"
+                                                      <+> pprMatchContextNoun ctxt
+
+        message = case ctxt of
+          LamCaseAlt LamCases -> lcases_msg <+> text "expression"
+          ArrowMatchCtxt (ArrowLamCaseAlt LamCases) -> lcases_msg <+> text "command"
+          _ -> text "Empty list of alternatives in" <+> pp_ctxt
+
+        lcases_msg =
+          text "Empty list of alternatives is not allowed in \\cases"
+    TcRnNonStdGuards (NonStandardGuards guards) -> mkSimpleDecorated $
+      text "accepting non-standard pattern guards" $$
+      nest 4 (interpp'SP guards)
+    TcRnDuplicateSigDecl pairs@((L _ name, sig) :| _) -> mkSimpleDecorated $
+      vcat [ text "Duplicate" <+> what_it_is
+            <> text "s for" <+> quotes (ppr name)
+          , text "at" <+> vcat (map ppr $ sortBy leftmost_smallest
+                                        $ map (getLocA . fst)
+                                        $ NE.toList pairs)
+          ]
+      where
+        what_it_is = hsSigDoc sig
+    TcRnMisplacedSigDecl sig -> mkSimpleDecorated $
+      sep [text "Misplaced" <+> hsSigDoc sig <> colon, ppr sig]
+    TcRnUnexpectedDefaultSig sig -> mkSimpleDecorated $
+      hang (text "Unexpected default signature:")
+         2 (ppr sig)
+    TcRnBindInBootFile -> mkSimpleDecorated $
+      text "Bindings in hs-boot files are not allowed"
+    TcRnDuplicateMinimalSig sig1 sig2 otherSigs -> mkSimpleDecorated $
+      vcat [ text "Multiple minimal complete definitions"
+           , text "at" <+> vcat (map ppr $ sortBy leftmost_smallest $ map getLocA sigs)
+           , text "Combine alternative minimal complete definitions with `|'" ]
+      where
+        sigs = sig1 : sig2 : otherSigs
+
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -1647,6 +1712,28 @@ instance Diagnostic TcRnMessage where
       -> WarningWithFlag Opt_WarnTermVariableCapture
     TcRnBindingOfExistingName{}
       -> ErrorWithoutFlag
+    TcRnMultipleFixityDecls{}
+      -> ErrorWithoutFlag
+    TcRnIllegalPatternSynonymDecl{}
+      -> ErrorWithoutFlag
+    TcRnIllegalClassBinding{}
+      -> ErrorWithoutFlag
+    TcRnOrphanCompletePragma{}
+      -> ErrorWithoutFlag
+    TcRnEmptyCase{}
+      -> ErrorWithoutFlag
+    TcRnNonStdGuards{}
+      -> WarningWithoutFlag
+    TcRnDuplicateSigDecl{}
+      -> ErrorWithoutFlag
+    TcRnMisplacedSigDecl{}
+      -> ErrorWithoutFlag
+    TcRnUnexpectedDefaultSig{}
+      -> ErrorWithoutFlag
+    TcRnBindInBootFile{}
+      -> ErrorWithoutFlag
+    TcRnDuplicateMinimalSig{}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -2062,6 +2149,30 @@ instance Diagnostic TcRnMessage where
       -> [SuggestRenameTypeVariable]
     TcRnBindingOfExistingName{}
       -> noHints
+    TcRnMultipleFixityDecls{}
+      -> noHints
+    TcRnIllegalPatternSynonymDecl{}
+      -> [suggestExtension LangExt.PatternSynonyms]
+    TcRnIllegalClassBinding{}
+      -> noHints
+    TcRnOrphanCompletePragma{}
+      -> noHints
+    TcRnEmptyCase ctxt -> case ctxt of
+      LamCaseAlt LamCases -> noHints -- cases syntax doesn't support empty case.
+      ArrowMatchCtxt (ArrowLamCaseAlt LamCases) -> noHints
+      _ -> [suggestExtension LangExt.EmptyCase]
+    TcRnNonStdGuards{}
+      -> [suggestExtension LangExt.PatternGuards]
+    TcRnDuplicateSigDecl{}
+      -> noHints
+    TcRnMisplacedSigDecl{}
+      -> noHints
+    TcRnUnexpectedDefaultSig{}
+      -> [suggestExtension LangExt.DefaultSignatures]
+    TcRnBindInBootFile{}
+      -> noHints
+    TcRnDuplicateMinimalSig{}
+      -> noHints
 
   diagnosticCode = constructorCode
 
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index c377e32eaa..c1b8461839 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -88,6 +88,8 @@ module GHC.Tc.Errors.Types (
   , IllegalDecls(..)
   , EmptyStatementGroupErrReason(..)
   , UnexpectedStatement(..)
+  , DeclSort(..)
+  , NonStandardGuards(..)
   ) where
 
 import GHC.Prelude
@@ -2762,6 +2764,165 @@ data TcRnMessage where
                  th/T13968
   -}
   TcRnBindingOfExistingName :: RdrName -> TcRnMessage
+  {-| TcRnMultipleFixityDecls is an error triggered by multiple
+      fixity declarations for the same operator.
+
+     Example(s):
+
+       infixr 6 $$
+       infixl 4 $$
+
+     Test cases: rename/should_fail/RnMultipleFixityFail
+  -}
+  TcRnMultipleFixityDecls :: SrcSpan -> RdrName -> TcRnMessage
+
+  {-| TcRnIllegalPatternSynonymDecl is an error thrown when a user
+      defines a pattern synonyms without enabling the PatternSynonyms extension.
+
+     Example:
+
+       pattern O :: Int
+       pattern O = 0
+
+     Test cases: rename/should_fail/RnPatternSynonymFail
+  -}
+  TcRnIllegalPatternSynonymDecl :: TcRnMessage
+
+  {-| TcRnIllegalClassBinding is an error triggered by a binding
+      in a class or instance declaration of an illegal form.
+
+     Examples:
+
+        class ZeroOne a where
+          zero :: a
+          one :: a
+        instance ZeroOne Int where
+          (zero,one) = (0,1)
+
+        class C a where
+           pattern P = ()
+
+     Test cases: module/mod48
+                 patsyn/should_fail/T9705-1
+                 patsyn/should_fail/T9705-2
+                 typecheck/should_fail/tcfail021
+
+  -}
+  TcRnIllegalClassBinding :: DeclSort -> HsBindLR GhcPs GhcPs -> TcRnMessage
+
+  {-| TcRnOrphanCompletePragma is an error triggered by a {-# COMPLETE #-}
+      pragma which does not mention any data constructors or pattern synonyms
+      defined in the current module.
+
+     Test cases: patsyn/should_fail/T13349
+  -}
+  TcRnOrphanCompletePragma :: TcRnMessage
+
+  {-| TcRnEmptyCase is an error thrown when a user uses
+      a case expression with an empty list of alternatives without
+      enabling the EmptyCase extension.
+
+     Example(s):
+
+       case () of
+
+     Test cases: rename/should_fail/RnEmptyCaseFail
+  -}
+  TcRnEmptyCase :: HsMatchContext GhcRn -> TcRnMessage
+
+  {-| TcRnNonStdGuards is a warning thrown when a user uses
+      non-standard guards (e.g. patterns in guards) without
+      enabling the PatternGuards extension.
+      More realistically: the user has explicitly disabled PatternGuards,
+      as it is enabled by default with `-XHaskell2010`.
+
+     Example(s):
+
+       f | 5 <- 2 + 3 = ...
+
+     Test cases: rename/should_compile/rn049
+  -}
+  TcRnNonStdGuards :: NonStandardGuards -> TcRnMessage
+
+  {-| TcRnDuplicateSigDecl is an error triggered by two or more
+      signatures for one entity.
+
+     Examples:
+
+       f :: Int -> Bool
+       f :: Int -> Bool
+       f _ = True
+
+       g x = x
+       {-# INLINE g #-}
+       {-# NOINLINE g #-}
+
+       pattern P = ()
+       {-# COMPLETE P #-}
+       {-# COMPLETE P #-}
+
+     Test cases: module/mod68
+                 parser/should_fail/OpaqueParseFail4
+                 patsyn/should_fail/T12165
+                 rename/should_fail/rnfail048
+                 rename/should_fail/T5589
+                 rename/should_fail/T7338
+                 rename/should_fail/T7338a
+  -}
+  TcRnDuplicateSigDecl :: NE.NonEmpty (LocatedN RdrName, Sig GhcPs) -> TcRnMessage
+
+  {-| TcRnMisplacedSigDecl is an error triggered by the pragma application
+      in the wrong context, like `MINIMAL` applied to a function or
+      `SPECIALIZE` to an instance.
+
+     Example:
+
+       f x = x
+       {-# MINIMAL f #-}
+
+     Test cases: rename/should_fail/T18138
+                 warnings/minimal/WarnMinimalFail1
+  -}
+  TcRnMisplacedSigDecl :: Sig GhcRn -> TcRnMessage
+
+  {-| TcRnUnexpectedDefaultSig is an error thrown when a user uses
+      default signatures without enabling the DefaultSignatures extension.
+
+     Example:
+
+       class C a where
+         m :: a
+         default m :: Num a => a
+         m = 0
+
+     Test cases: rename/should_fail/RnDefaultSigFail
+  -}
+  TcRnUnexpectedDefaultSig :: Sig GhcPs -> TcRnMessage
+
+  {-| TcRnBindInBootFile is an error triggered by a binding in hs-boot file.
+
+     Example:
+
+       -- in an .hs-boot file:
+       x = 3
+
+     Test cases: rename/should_fail/T19781
+  -}
+  TcRnBindInBootFile :: TcRnMessage
+
+  {-| TcRnDuplicateMinimalSig is an error triggered by two or more minimal
+      signatures for one type class.
+
+     Example:
+
+       class C where
+         f :: ()
+         {-# MINIMAL f #-}
+         {-# MINIMAL f #-}
+
+     Test cases: rename/should_fail/RnMultipleMinimalPragmaFail
+  -}
+  TcRnDuplicateMinimalSig :: LSig GhcPs -> LSig GhcPs -> [LSig GhcPs] -> TcRnMessage
 
   deriving Generic
 
@@ -3991,3 +4152,12 @@ data UnexpectedStatement where
     :: Outputable (StmtLR GhcPs GhcPs body)
     => StmtLR GhcPs GhcPs body
     -> UnexpectedStatement
+
+data DeclSort = ClassDeclSort | InstanceDeclSort
+
+data NonStandardGuards where
+  NonStandardGuards
+    :: (Outputable body,
+        Anno (Stmt GhcRn body) ~ SrcSpanAnnA)
+    => [LStmtLR GhcRn GhcRn body]
+    -> NonStandardGuards