Diagnostics conversions, part 6 (#20116)

Replaces uses of `TcRnUnknownMessage` with proper diagnostics
constructors in `GHC.Tc.Gen.Match`, `GHC.Tc.Gen.Pat`, and
`GHC.Tc.Gen.Sig`.

1 files changed, 8 insertions, 29 deletions

diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 16a46f4454..66c7c80ced 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -68,9 +68,10 @@ import GHC.Utils.Misc as Utils ( singleton )
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 
-import GHC.Data.Maybe( orElse )
+import GHC.Data.Maybe( orElse, whenIsJust )
 
 import Data.Maybe( mapMaybe )
+import qualified Data.List.NonEmpty as NE
 import Control.Monad( unless )
 
 
@@ -631,15 +632,9 @@ addInlinePrags poly_id prags_for_me
          warn_multiple_inlines inl2 inls
        | otherwise
        = setSrcSpanA loc $
-         let dia = TcRnUnknownMessage $
-               mkPlainDiagnostic WarningWithoutFlag noHints $
-                 (hang (text "Multiple INLINE pragmas for" <+> ppr poly_id)
-                   2 (vcat (text "Ignoring all but the first"
-                            : map pp_inl (inl1:inl2:inls))))
+         let dia = TcRnMultipleInlinePragmas poly_id inl1 (inl2 NE.:| inls)
          in addDiagnosticTc dia
 
-    pp_inl (L loc prag) = ppr prag <+> parens (ppr loc)
-
 
 {- Note [Pattern synonym inline arity]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -776,7 +771,7 @@ tcSpecPrags :: Id -> [LSig GhcRn]
 -- Reason: required by tcSubExp
 tcSpecPrags poly_id prag_sigs
   = do { traceTc "tcSpecPrags" (ppr poly_id <+> ppr spec_sigs)
-       ; unless (null bad_sigs) warn_discarded_sigs
+       ; whenIsJust (NE.nonEmpty bad_sigs) warn_discarded_sigs
        ; pss <- mapAndRecoverM (wrapLocMA (tcSpecPrag poly_id)) spec_sigs
        ; return $ concatMap (\(L l ps) -> map (L (locA l)) ps) pss }
   where
@@ -784,11 +779,8 @@ tcSpecPrags poly_id prag_sigs
     bad_sigs  = filter is_bad_sig prag_sigs
     is_bad_sig s = not (isSpecLSig s || isInlineLSig s || isSCCFunSig s)
 
-    warn_discarded_sigs
-      = let dia = TcRnUnknownMessage $
-              mkPlainDiagnostic WarningWithoutFlag noHints $
-                (hang (text "Discarding unexpected pragmas for" <+> ppr poly_id)
-                    2 (vcat (map (ppr . getLoc) bad_sigs)))
+    warn_discarded_sigs bad_sigs_ne
+      = let dia = TcRnUnexpectedPragmas poly_id bad_sigs_ne
         in addDiagnosticTc dia
 
 --------------
@@ -803,9 +795,7 @@ tcSpecPrag poly_id prag@(SpecSig _ fun_name hs_tys inl)
 -- what the user wrote (#8537)
   = addErrCtxt (spec_ctxt prag) $
     do  { warnIf (not (isOverloadedTy poly_ty || isInlinePragma inl)) $
-                 TcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints
-                   (text "SPECIALISE pragma for non-overloaded function"
-                    <+> quotes (ppr fun_name))
+                 TcRnNonOverloadedSpecialisePragma fun_name
                     -- Note [SPECIALISE pragmas]
         ; spec_prags <- mapM tc_one hs_tys
         ; traceTc "tcSpecPrag" (ppr poly_id $$ nest 2 (vcat (map ppr spec_prags)))
@@ -867,21 +857,10 @@ tcImpSpec (name, prag)
       ; if hasSomeUnfolding (realIdUnfolding id)
            -- See Note [SPECIALISE pragmas for imported Ids]
         then tcSpecPrag id prag
-        else do { let dia = TcRnUnknownMessage $
-                        mkPlainDiagnostic WarningWithoutFlag noHints (impSpecErr name)
+        else do { let dia = TcRnSpecialiseNotVisible name
                 ; addDiagnosticTc dia
                 ; return [] } }
 
-impSpecErr :: Name -> SDoc
-impSpecErr name
-  = hang (text "You cannot SPECIALISE" <+> quotes (ppr name))
-       2 (vcat [ text "because its definition is not visible in this module"
-               , text "Hint: make sure" <+> ppr mod <+> text "is compiled with -O"
-               , text "      and that" <+> quotes (ppr name)
-                 <+> text "has an INLINABLE pragma" ])
-  where
-    mod = nameModule name
-
 {- Note [SPECIALISE pragmas for imported Ids]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 An imported Id may or may not have an unfolding.  If not, we obviously