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, 38 insertions, 14 deletions

diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs
index 8f0ffa4a4d..69e3c28740 100644
--- a/compiler/GHC/Driver/Errors/Ppr.hs
+++ b/compiler/GHC/Driver/Errors/Ppr.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic {DriverMessage, GhcMessage}
 
 module GHC.Driver.Errors.Ppr (
@@ -26,6 +28,8 @@ import GHC.Types.SrcLoc
 import Data.Version
 
 import Language.Haskell.Syntax.Decls (RuleDecl(..))
+import GHC.Tc.Errors.Types (TcRnMessage)
+import GHC.HsToCore.Errors.Types (DsMessage)
 
 --
 -- Suggestions
@@ -36,19 +40,23 @@ suggestInstantiatedWith :: ModuleName -> GenInstantiations UnitId -> [Instantiat
 suggestInstantiatedWith pi_mod_name insts =
   [ InstantiationSuggestion k v | (k,v) <- ((pi_mod_name, mkHoleModule pi_mod_name) : insts) ]
 
-
 instance Diagnostic GhcMessage where
-  diagnosticMessage = \case
+  type DiagnosticOpts GhcMessage = GhcMessageOpts
+  defaultDiagnosticOpts = GhcMessageOpts (defaultDiagnosticOpts @PsMessage)
+                                         (defaultDiagnosticOpts @TcRnMessage)
+                                         (defaultDiagnosticOpts @DsMessage)
+                                         (defaultDiagnosticOpts @DriverMessage)
+  diagnosticMessage opts = \case
     GhcPsMessage m
-      -> diagnosticMessage m
+      -> diagnosticMessage (psMessageOpts opts) m
     GhcTcRnMessage m
-      -> diagnosticMessage m
+      -> diagnosticMessage (tcMessageOpts opts) m
     GhcDsMessage m
-      -> diagnosticMessage m
+      -> diagnosticMessage (dsMessageOpts opts) m
     GhcDriverMessage m
-      -> diagnosticMessage m
-    GhcUnknownMessage m
-      -> diagnosticMessage m
+      -> diagnosticMessage (driverMessageOpts opts) m
+    GhcUnknownMessage (UnknownDiagnostic @e m)
+      -> diagnosticMessage (defaultDiagnosticOpts @e) m
 
   diagnosticReason = \case
     GhcPsMessage m
@@ -77,11 +85,13 @@ instance Diagnostic GhcMessage where
   diagnosticCode = constructorCode
 
 instance Diagnostic DriverMessage where
-  diagnosticMessage = \case
-    DriverUnknownMessage m
-      -> diagnosticMessage m
+  type DiagnosticOpts DriverMessage = DriverMessageOpts
+  defaultDiagnosticOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage)
+  diagnosticMessage opts = \case
+    DriverUnknownMessage (UnknownDiagnostic @e m)
+      -> diagnosticMessage (defaultDiagnosticOpts @e) m
     DriverPsHeaderMessage m
-      -> diagnosticMessage m
+      -> diagnosticMessage (psDiagnosticOpts opts) m
     DriverMissingHomeModules missing buildingCabalPackage
       -> let msg | buildingCabalPackage == YesBuildingCabalPackage
                  = hang
diff --git a/compiler/GHC/Driver/Errors/Types.hs b/compiler/GHC/Driver/Errors/Types.hs
index 988f533205..cb7625ca09 100644
--- a/compiler/GHC/Driver/Errors/Types.hs
+++ b/compiler/GHC/Driver/Errors/Types.hs
@@ -4,7 +4,10 @@
 
 module GHC.Driver.Errors.Types (
     GhcMessage(..)
-  , DriverMessage(..), DriverMessages, PsMessage(PsHeaderMessage)
+  , GhcMessageOpts(..)
+  , DriverMessage(..)
+  , DriverMessageOpts(..)
+  , DriverMessages, PsMessage(PsHeaderMessage)
   , BuildingCabalPackage(..)
   , WarningMessages
   , ErrorMessages
@@ -91,13 +94,20 @@ data GhcMessage where
 
   deriving Generic
 
+
+data GhcMessageOpts = GhcMessageOpts { psMessageOpts :: DiagnosticOpts PsMessage
+                                     , tcMessageOpts :: DiagnosticOpts TcRnMessage
+                                     , dsMessageOpts :: DiagnosticOpts DsMessage
+                                     , driverMessageOpts :: DiagnosticOpts DriverMessage
+                                     }
+
 -- | Creates a new 'GhcMessage' out of any diagnostic. This function is also
 -- provided to ease the integration of #18516 by allowing diagnostics to be
 -- wrapped into the general (but structured) 'GhcMessage' type, so that the
 -- conversion can happen gradually. This function should not be needed within
 -- GHC, as it would typically be used by plugin or library authors (see
 -- comment for the 'GhcUnknownMessage' type constructor)
-ghcUnknownMessage :: (Diagnostic a, Typeable a) => a -> GhcMessage
+ghcUnknownMessage :: (DiagnosticOpts a ~ NoDiagnosticOpts, Diagnostic a, Typeable a) => a -> GhcMessage
 ghcUnknownMessage = GhcUnknownMessage . UnknownDiagnostic
 
 -- | Abstracts away the frequent pattern where we are calling 'ioMsgMaybe' on
@@ -117,6 +127,7 @@ type DriverMessages = Messages DriverMessage
 data DriverMessage where
   -- | Simply wraps a generic 'Diagnostic' message @a@.
   DriverUnknownMessage :: UnknownDiagnostic -> DriverMessage
+
   -- | A parse error in parsing a Haskell file header during dependency
   -- analysis
   DriverPsHeaderMessage :: !PsMessage -> DriverMessage
@@ -359,6 +370,9 @@ data DriverMessage where
 
 deriving instance Generic DriverMessage
 
+data DriverMessageOpts =
+  DriverMessageOpts { psDiagnosticOpts :: DiagnosticOpts PsMessage }
+
 -- | Pass to a 'DriverMessage' the information whether or not the
 -- '-fbuilding-cabal-package' flag is set.
 data BuildingCabalPackage