Allow configuration of error message printing

This MR implements the idea of #21731 that the printing of a diagnostic
method should be configurable at the printing time.

The interface of the `Diagnostic` class is modified from:

```
class Diagnostic a where
  diagnosticMessage :: a -> DecoratedSDoc
  diagnosticReason  :: a -> DiagnosticReason
  diagnosticHints   :: a -> [GhcHint]
```

to

```
class Diagnostic a where
  type DiagnosticOpts a
  defaultDiagnosticOpts :: DiagnosticOpts a
  diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc
  diagnosticReason  :: a -> DiagnosticReason
  diagnosticHints   :: a -> [GhcHint]
```

and so each `Diagnostic` can implement their own configuration record
which can then be supplied by a client in order to dictate how to print
out the error message.

At the moment this only allows us to implement #21722 nicely but in
future it is more natural to separate the configuration of how much
information we put into an error message and how much we decide to print
out of it.

Updates Haddock submodule

2 files changed, 3 insertions, 3 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 6cbf4dffb9..4efb35f35e 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -3136,7 +3136,7 @@ newDynFlags interactive_only minus_opts = do
       idflags0 <- GHC.getInteractiveDynFlags
       (idflags1, leftovers, warns) <- DynFlags.parseDynamicFlagsCmdLine idflags0 lopts
 
-      liftIO $ handleFlagWarnings logger (initDiagOpts idflags1) warns
+      liftIO $ handleFlagWarnings logger (initPrintConfig idflags1) (initDiagOpts idflags1) warns
       when (not $ null leftovers)
            (throwGhcException . CmdLineError
             $ "Some flags have not been recognized: "
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 16075284c0..ae862a7014 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -247,7 +247,7 @@ main' postLoadMode units dflags0 args flagWarnings = do
   handleSourceError (\e -> do
        GHC.printException e
        liftIO $ exitWith (ExitFailure 1)) $ do
-         liftIO $ handleFlagWarnings logger4 (initDiagOpts dflags4) flagWarnings'
+         liftIO $ handleFlagWarnings logger4 (initPrintConfig dflags4) (initDiagOpts dflags4) flagWarnings'
 
   liftIO $ showBanner postLoadMode dflags4
 
@@ -779,7 +779,7 @@ initMulti unitArgsFiles  = do
     handleSourceError (\e -> do
        GHC.printException e
        liftIO $ exitWith (ExitFailure 1)) $ do
-         liftIO $ handleFlagWarnings logger (initDiagOpts dflags2) warns
+         liftIO $ handleFlagWarnings logger (initPrintConfig dflags2) (initDiagOpts dflags2) warns
 
     let (dflags3, srcs, objs) = parseTargetFiles dflags2 (map unLoc fileish_args)
         dflags4 = offsetDynFlags dflags3