Compute Severity of diagnostics at birth

This commit further expand on the design for #18516 by getting rid of
the `defaultReasonSeverity` in favour of a function called
`diagReasonSeverity` which correctly takes the `DynFlags` as input. The
idea is to compute the `Severity` and the `DiagnosticReason` of each
message "at birth", without doing any later re-classifications, which
are potentially error prone, as the `DynFlags` might evolve during the
course of the program.

In preparation for a proper refactoring, now `pprWarning` from the
Parser.Ppr module has been renamed to `mkParserWarn`, which now takes a
`DynFlags` as input.

We also get rid of the reclassification we were performing inside `printOrThrowWarnings`.

Last but not least, this commit removes the need for reclassify inside GHC.Tc.Errors,
and also simplifies the implementation of `maybeReportError`.

Update Haddock submodule

1 files changed, 6 insertions, 3 deletions

diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 6fb31e2d7d..a8f6cbbc19 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -1033,8 +1033,9 @@ mkLongErrAt :: SrcSpan -> SDoc -> SDoc -> TcRn (MsgEnvelope DiagnosticMessage)
 mkLongErrAt loc msg extra
   = do { printer <- getPrintUnqualified ;
          unit_state <- hsc_units <$> getTopEnv ;
+         dflags <- getDynFlags ;
          let msg' = pprWithUnitState unit_state msg in
-         return $ mkLongMsgEnvelope ErrorWithoutFlag loc printer msg' extra }
+         return $ mkLongMsgEnvelope dflags ErrorWithoutFlag loc printer msg' extra }
 
 mkDecoratedSDocAt :: DiagnosticReason
                   -> SrcSpan
@@ -1048,11 +1049,12 @@ mkDecoratedSDocAt :: DiagnosticReason
 mkDecoratedSDocAt reason loc important context extra
   = do { printer <- getPrintUnqualified ;
          unit_state <- hsc_units <$> getTopEnv ;
+         dflags <- getDynFlags ;
          let f = pprWithUnitState unit_state
              errDoc  = [important, context, extra]
              errDoc' = DiagnosticMessage (mkDecorated $ map f errDoc) reason
          in
-         return $ mkMsgEnvelope (defaultReasonSeverity reason) loc printer errDoc' }
+         return $ mkMsgEnvelope dflags loc printer errDoc' }
 
 addLongErrAt :: SrcSpan -> SDoc -> SDoc -> TcRn ()
 addLongErrAt loc msg extra = mkLongErrAt loc msg extra >>= reportDiagnostic
@@ -1558,7 +1560,8 @@ add_diagnostic reason msg extra_info
 add_diagnostic_at :: DiagnosticReason -> SrcSpan -> SDoc -> SDoc -> TcRn ()
 add_diagnostic_at reason loc msg extra_info
   = do { printer <- getPrintUnqualified ;
-         let { dia = mkLongMsgEnvelope reason
+         dflags  <- getDynFlags ;
+         let { dia = mkLongMsgEnvelope dflags reason
                                        loc printer
                                        msg extra_info } ;
          reportDiagnostic dia }