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, 11 insertions, 8 deletions

diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 8dae970dee..993b62a7ea 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -1,9 +1,10 @@
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage
 
@@ -95,15 +96,16 @@ import Data.Ord ( comparing )
 import Data.Bifunctor
 import GHC.Types.Name.Env
 
-
 instance Diagnostic TcRnMessage where
-  diagnosticMessage = \case
-    TcRnUnknownMessage m
-      -> diagnosticMessage m
+  type DiagnosticOpts TcRnMessage = NoDiagnosticOpts
+  defaultDiagnosticOpts = NoDiagnosticOpts
+  diagnosticMessage opts = \case
+    TcRnUnknownMessage (UnknownDiagnostic @e m)
+      -> diagnosticMessage (defaultDiagnosticOpts @e) m
     TcRnMessageWithInfo unit_state msg_with_info
       -> case msg_with_info of
            TcRnMessageDetailed err_info msg
-             -> messageWithInfoDiagnosticMessage unit_state err_info (diagnosticMessage msg)
+             -> messageWithInfoDiagnosticMessage unit_state err_info (diagnosticMessage opts msg)
     TcRnSolverReport msg _ _
       -> mkSimpleDecorated $ pprSolverReportWithCtxt msg
     TcRnRedundantConstraints redundants (info, show_info)
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 854ebd3bf6..d0d40366d9 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -182,12 +182,13 @@ data TcRnMessageDetailed
                         !TcRnMessage
   deriving Generic
 
-mkTcRnUnknownMessage :: (Diagnostic a, Typeable a) => a -> TcRnMessage
+mkTcRnUnknownMessage :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts)
+                     => a -> TcRnMessage
 mkTcRnUnknownMessage diag = TcRnUnknownMessage (UnknownDiagnostic diag)
 
 -- | An error which might arise during typechecking/renaming.
 data TcRnMessage where
-  {-| Simply wraps a generic 'Diagnostic' message @a@. It can be used by plugins
+  {-| Simply wraps an unknown 'Diagnostic' message @a@. It can be used by plugins
       to provide custom diagnostic messages originated during typechecking/renaming.
   -}
   TcRnUnknownMessage :: UnknownDiagnostic -> TcRnMessage