Add GhcMessage and ancillary types

This commit adds GhcMessage and ancillary (PsMessage, TcRnMessage, ..)
types.
These types will be expanded to represent more errors generated
by different subsystems within GHC. Right now, they are underused,
but more will come in the glorious future.

See
https://gitlab.haskell.org/ghc/ghc/-/wikis/Errors-as-(structured)-values
for a design overview.

Along the way, lots of other things had to happen:

* Adds Semigroup and Monoid instance for Bag

* Fixes #19746 by parsing OPTIONS_GHC pragmas into Located Strings.
  See GHC.Parser.Header.toArgs (moved from GHC.Utils.Misc, where it
  didn't belong anyway).

* Addresses (but does not completely fix) #19709, now reporting
  desugarer warnings and errors appropriately for TH splices.
  Not done: reporting type-checker warnings for TH splices.

* Some small refactoring around Safe Haskell inference, in order
  to keep separate classes of messages separate.

* Some small refactoring around initDsTc, in order to keep separate
  classes of messages separate.

* Separate out the generation of messages (that is, the construction
  of the text block) from the wrapping of messages (that is, assigning
  a SrcSpan). This is more modular than the previous design, which
  mixed the two.

Close #19746.

This was a collaborative effort by Alfredo di Napoli and
Richard Eisenberg, with a key assist on #19746 by Iavor
Diatchki.

Metric Increase:
    MultiLayerModules

2 files changed, 31 insertions, 16 deletions

diff --git a/utils/check-exact/Parsers.hs b/utils/check-exact/Parsers.hs
index 03616f846a..93ddfd4f07 100644
--- a/utils/check-exact/Parsers.hs
+++ b/utils/check-exact/Parsers.hs
@@ -54,6 +54,7 @@ import qualified Control.Monad.IO.Class as GHC
 import qualified GHC.Data.FastString    as GHC
 import qualified GHC.Data.StringBuffer  as GHC
 import qualified GHC.Driver.Config      as GHC
+import qualified GHC.Driver.Errors.Types as GHC
 import qualified GHC.Driver.Session     as GHC
 import qualified GHC.Parser             as GHC
 import qualified GHC.Parser.Header      as GHC
@@ -61,7 +62,6 @@ import qualified GHC.Parser.Lexer       as GHC
 import qualified GHC.Parser.PostProcess as GHC
 import qualified GHC.Parser.Errors.Ppr  as GHC
 import qualified GHC.Types.SrcLoc       as GHC
-import qualified GHC.Utils.Error        as GHC
 
 import qualified GHC.LanguageExtensions as LangExt
 
@@ -79,8 +79,10 @@ parseWith :: GHC.DynFlags
           -> ParseResult w
 parseWith dflags fileName parser s =
   case runParser parser dflags fileName s of
-    GHC.PFailed pst                     -> Left (fmap GHC.mkParserErr $ GHC.getErrorMessages pst)
-    GHC.POk _ pmod -> Right pmod
+    GHC.PFailed pst
+      -> Left (GHC.foldPsMessages GHC.mkParserErr (GHC.getErrorMessages pst))
+    GHC.POk _ pmod
+      -> Right pmod
 
 
 parseWithECP :: (GHC.DisambECP w)
@@ -91,8 +93,10 @@ parseWithECP :: (GHC.DisambECP w)
           -> ParseResult (GHC.LocatedA w)
 parseWithECP dflags fileName parser s =
     case runParser (parser >>= \p -> GHC.runPV $ GHC.unECP p) dflags fileName s of
-      GHC.PFailed pst                     -> Left (fmap GHC.mkParserErr $ GHC.getErrorMessages pst)
-      GHC.POk _ pmod -> Right pmod
+      GHC.PFailed pst
+        -> Left (GHC.foldPsMessages GHC.mkParserErr (GHC.getErrorMessages pst))
+      GHC.POk _ pmod
+        -> Right pmod
 
 -- ---------------------------------------------------------------------
 
@@ -182,8 +186,10 @@ parseModuleFromStringInternal :: Parser GHC.ParsedSource
 parseModuleFromStringInternal dflags fileName str =
   let (str1, lp) = stripLinePragmas str
       res        = case runParser GHC.parseModule dflags fileName str1 of
-        GHC.PFailed pst     -> Left (fmap GHC.mkParserErr $ GHC.getErrorMessages pst)
-        GHC.POk     _  pmod -> Right (lp, dflags, pmod)
+        GHC.PFailed pst
+          -> Left (GHC.foldPsMessages GHC.mkParserErr (GHC.getErrorMessages pst))
+        GHC.POk     _  pmod
+          -> Right (lp, dflags, pmod)
   in  postParseTransform res
 
 parseModuleWithOptions :: FilePath -- ^ GHC libdir
@@ -253,9 +259,10 @@ parseModuleEpAnnsWithCppInternal cppOptions dflags file = do
         return (contents1,lp,dflags)
   return $
     case parseFile dflags' file fileContents of
-      GHC.PFailed pst -> Left (fmap GHC.mkParserErr $ GHC.getErrorMessages pst)
-      GHC.POk _ pmod  ->
-        Right $ (injectedComments, dflags', pmod)
+      GHC.PFailed pst
+        -> Left (GHC.foldPsMessages GHC.mkParserErr (GHC.getErrorMessages pst))
+      GHC.POk _ pmod
+        -> Right $ (injectedComments, dflags', pmod)
 
 -- | Internal function. Exposed if you want to muck with DynFlags
 -- before parsing. Or after parsing.
diff --git a/utils/check-exact/Preprocess.hs b/utils/check-exact/Preprocess.hs
index 58cb6d028c..a2d3b53f49 100644
--- a/utils/check-exact/Preprocess.hs
+++ b/utils/check-exact/Preprocess.hs
@@ -16,26 +16,28 @@ module Preprocess
 import qualified GHC            as GHC hiding (parseModule)
 
 import qualified Control.Monad.IO.Class as GHC
-import qualified GHC.Data.Bag          as GHC
 import qualified GHC.Data.FastString   as GHC
 import qualified GHC.Data.StringBuffer as GHC
 import qualified GHC.Driver.Config     as GHC
 import qualified GHC.Driver.Env        as GHC
+import qualified GHC.Driver.Errors.Types as GHC
 import qualified GHC.Driver.Phases     as GHC
 import qualified GHC.Driver.Pipeline   as GHC
 import qualified GHC.Fingerprint.Type  as GHC
 import qualified GHC.Parser.Errors.Ppr as GHC
-import qualified GHC.Parser.Lexer      as GHC
+import qualified GHC.Parser.Lexer      as GHC hiding (getMessages)
 import qualified GHC.Settings          as GHC
+import qualified GHC.Types.Error       as GHC (getMessages)
 import qualified GHC.Types.SourceError as GHC
 import qualified GHC.Types.SourceFile  as GHC
 import qualified GHC.Types.SrcLoc      as GHC
 import qualified GHC.Utils.Error       as GHC
 import qualified GHC.Utils.Fingerprint as GHC
+import qualified GHC.Utils.Outputable  as GHC
 import GHC.Types.SrcLoc (mkSrcSpan, mkSrcLoc)
 import GHC.Data.FastString (mkFastString)
 
-import Data.List (isPrefixOf, intercalate)
+import Data.List (isPrefixOf)
 import Data.Maybe
 import Types
 import Utils
@@ -221,8 +223,13 @@ getPreprocessedSrcDirectPrim cppOptions src_fn = do
       txt <- GHC.liftIO $ readFileGhc hspp_fn
       return (txt, buf, dflags')
 
-showErrorMessages :: GHC.ErrorMessages -> String
-showErrorMessages msgs = intercalate "\n" $ map show $ GHC.bagToList msgs
+showErrorMessages :: GHC.Messages GHC.DriverMessage -> String
+showErrorMessages msgs =
+  GHC.renderWithContext GHC.defaultSDocContext
+    $ GHC.vcat
+    $ GHC.pprMsgEnvelopeBagWithLoc
+    $ GHC.getMessages
+    $ msgs
 
 injectCppOptions :: CppOptions -> GHC.DynFlags -> GHC.DynFlags
 injectCppOptions CppOptions{..} dflags =
@@ -276,7 +283,8 @@ parseError pst = do
      let
        -- (warns,errs) = GHC.getMessages pst dflags
      -- throw $ GHC.mkSrcErr (GHC.unitBag $ GHC.mkPlainErrMsg dflags sspan err)
-     GHC.throwErrors (fmap GHC.mkParserErr (GHC.getErrorMessages pst))
+     GHC.throwErrors $
+       (GHC.foldPsMessages GHC.mkParserErr (GHC.getErrorMessages pst))
 
 -- ---------------------------------------------------------------------