new datatypes for parsedResultActionwip/T20803-followup

Previously, the warnings and errors were given and returned as a tuple
(Messages PsWarnings, Messages PsErrors). Now, it's just PsMessages.

This, together with the HsParsedModule the parser plugin gets and
returns, has been wrapped up as ParsedResult.

8 files changed, 69 insertions, 56 deletions

diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 3fa3d581ce..7fd07d31cf 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -493,10 +493,11 @@ hscParse' mod_summary
 
             -- apply parse transformation of plugins
             let applyPluginAction p opts
-                  = uncurry (parsedResultAction p opts mod_summary)
+                  = parsedResultAction p opts mod_summary
             hsc_env <- getHscEnv
-            (transformed, (warns, errs)) <-
-              withPlugins (hsc_plugins hsc_env) applyPluginAction (res, getPsMessages pst)
+            (ParsedResult transformed (PsMessages warns errs)) <-
+              withPlugins (hsc_plugins hsc_env) applyPluginAction
+                (ParsedResult res (uncurry PsMessages $ getPsMessages pst))
 
             logDiagnostics (GhcPsMessage <$> warns)
             unless (isEmptyMessages errs) $ throwErrors (GhcPsMessage <$> errs)
diff --git a/compiler/GHC/Driver/Plugins.hs b/compiler/GHC/Driver/Plugins.hs
index 64e82c42b6..67d8422562 100644
--- a/compiler/GHC/Driver/Plugins.hs
+++ b/compiler/GHC/Driver/Plugins.hs
@@ -12,6 +12,8 @@ module GHC.Driver.Plugins (
     , Plugin(..)
     , defaultPlugin
     , CommandLineOption
+    , PsMessages(..)
+    , ParsedResult(..)
       -- ** Recompilation checking
     , purePlugin, impurePlugin, flagRecompile
     , PluginRecompile(..)
@@ -89,6 +91,19 @@ import GHC.Types.Unique.DFM
 -- are given to you as this type
 type CommandLineOption = String
 
+-- | Errors and warnings produced by the parser
+data PsMessages = PsMessages { psWarnings :: Messages PsWarning
+                             , psErrors   :: Messages PsError
+                             }
+
+-- | Result of running the parser and the parser plugin
+data ParsedResult = ParsedResult
+  { -- | Parsed module, potentially modified by a plugin
+    parsedResultModule :: HsParsedModule
+  , -- | Warnings and errors from parser, potentially modified by a plugin
+    parsedResultMessages :: PsMessages
+  }
+
 -- | 'Plugin' is the compiler plugin data type. Try to avoid
 -- constructing one of these directly, and just modify some fields of
 -- 'defaultPlugin' instead: this is to try and preserve source-code
@@ -121,9 +136,8 @@ data Plugin = Plugin {
 
   , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
     -- ^ Specify how the plugin should affect recompilation.
-  , parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
-                       -> (Messages PsWarning, Messages PsError)
-                       -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
+  , parsedResultAction :: [CommandLineOption] -> ModSummary
+                       -> ParsedResult -> Hsc ParsedResult
     -- ^ Modify the module when it is parsed. This is called by
     -- "GHC.Driver.Main" when the parser has produced no or only non-fatal
     -- errors.
@@ -237,7 +251,7 @@ defaultPlugin = Plugin {
       , driverPlugin          = const return
       , pluginRecompile       = impurePlugin
       , renamedResultAction   = \_ env grp -> return (env, grp)
-      , parsedResultAction    = \_ _ mod msgs -> return (mod, msgs)
+      , parsedResultAction    = \_ _ -> return
       , typeCheckResultAction = \_ _ -> return
       , spliceRunAction       = \_ -> return
       , interfaceLoadAction   = \_ -> return
diff --git a/docs/users_guide/9.4.1-notes.rst b/docs/users_guide/9.4.1-notes.rst
index 3ccbf4c3ec..a77b6b451b 100644
--- a/docs/users_guide/9.4.1-notes.rst
+++ b/docs/users_guide/9.4.1-notes.rst
@@ -64,11 +64,12 @@ Compiler
   defaults for ambiguous variables that would otherwise cause errors
   just like the built-in defaulting mechanism.
 
-- ``GHC.Plugins.parsedResultAction`` now takes and returns a tuple of warnings
-  and errors encountered by the parser before they're shown to the user, as
-  long as none of the errors prevented the AST from being built. This means
-  plugins can remove, modify, or add any of these, or simply pass them through
-  unchanged.
+- ``GHC.Plugins.parsedResultAction`` now takes and returns a value of type
+  ``ParsedResult``, containing the ``HsParsedModule`` as well as ``PsMessages``,
+  which contains warnings and errors encountered by the parser before
+  they're shown to the user, as long as none of the errors prevented the AST
+  from being built. This means plugins can remove, modify, or add any of these,
+  or simply pass them through unchanged.
 
 - The way GHC checks for representation polymorphism has been overhauled:
   all the checks are now done during typechecking. The error messages
diff --git a/docs/users_guide/extending_ghc.rst b/docs/users_guide/extending_ghc.rst
index 4a987bca87..b2b555c005 100644
--- a/docs/users_guide/extending_ghc.rst
+++ b/docs/users_guide/extending_ghc.rst
@@ -754,23 +754,24 @@ in the source code as well as the original syntax tree of the compiled module.
 
 ::
 
-    parsed :: [CommandLineOption] -> ModSummary -> HsParsedModule
-                -> (Messages PsWarning, Messages PsError)
-                -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError)
+    parsed :: [CommandLineOption] -> ModSummary
+                -> ParsedResult -> Hsc ParsedResult
 
 The ``ModSummary`` contains useful
-meta-information about the compiled module. The ``HsParsedModule`` contains the
-lexical and syntactical information we mentioned before. The result that you
-return will change the result of the parsing. If you don't want to change the
-result, just return the ``HsParsedModule`` that you received as the argument.
+meta-information about the compiled module. The ``ParsedResult`` contains a
+``HsParsedModule``, which contains the lexical and syntactical information we
+mentioned before. The result that you return will change the result of the
+parsing. If you don't want to change the result, just return the
+``ParsedResult`` that you received as the argument.
 
 If the parser encounters any errors that prevent an AST from being constructed,
 the plugin will not be run, but other kinds of errors, as well as warnings,
-will be given to the plugin via the ``Messages`` tuple. This allows you to
-modify, remove, and add warnings or errors before they are displayed to the
-user, although in most cases, you will likely want to return the tuple
-unmodified. The parsing pass will fail if the returned ``Messages PsError``
-collection is not empty after all parsing plugins have been run.
+will be given to the plugin via the ``PsMessages`` value of the
+``ParsedResult``. This allows you to modify, remove, and add warnings or errors
+before they are displayed to the user, although in most cases, you will likely
+want to return the messages unmodified. The parsing pass will fail if the
+``Messages PsError`` collection inside the return ``ParsedResult`` is not empty
+after all parsing plugins have been run.
 
 Type checked representation
 ^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -892,6 +893,7 @@ displayed.
     import GHC.Types.Avail
     import GHC.Utils.Outputable
     import GHC.Hs.Doc
+    import GHC
 
     plugin :: Plugin
     plugin = defaultPlugin
@@ -902,15 +904,14 @@ displayed.
       , interfaceLoadAction = interfaceLoadPlugin
       }
 
-    parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule
-                 -> (Messages PsWarning, Messages PsError)
-                 -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
-    parsedPlugin _ _ pm msgs@(warns, errs)
+    parsedPlugin :: [CommandLineOption] -> ModSummary
+                 -> ParsedResult -> Hsc ParsedResult
+    parsedPlugin _ _ parsed@(ParsedResult pm msgs)
          = do dflags <- getDynFlags
-           liftIO $ putStrLn $ "parsePlugin: \n" ++ (showSDoc dflags $ ppr $ hpm_module pm)
-           liftIO $ putStrLn $ "parsePlugin warnings: \n" ++ (showSDoc dflags $ ppr warns)
-           liftIO $ putStrLn $ "parsePlugin errors: \n" ++ (showSDoc dflags $ ppr errs)
-           return (pm, msgs)
+              liftIO $ putStrLn $ "parsePlugin: \n" ++ (showSDoc dflags $ ppr $ hpm_module pm)
+              liftIO $ putStrLn $ "parsePlugin warnings: \n" ++ (showSDoc dflags $ ppr $ psWarnings msgs)
+              liftIO $ putStrLn $ "parsePlugin errors: \n" ++ (showSDoc dflags $ ppr $ psErrors msgs)
+              return parsed
 
     renamedAction :: [CommandLineOption] -> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
     renamedAction _ tc gr = do
@@ -1320,10 +1321,10 @@ Defaulting plugins have a single access point in the `GHC.Tc.Types` module
         , deProposalCts :: [Ct]
           -- ^ The constraints against which defaults are checked.
         }
-    
+
     type DefaultingPluginResult = [DefaultingProposal]
     type FillDefaulting = WantedConstraints -> TcPluginM DefaultingPluginResult
-    
+
     -- | A plugin for controlling defaulting.
     data DefaultingPlugin = forall s. DefaultingPlugin
       { dePluginInit :: TcPluginM s
diff --git a/testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs b/testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs
index e055204acf..74738a75f1 100644
--- a/testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs
+++ b/testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs
@@ -17,14 +17,13 @@ import System.IO
 plugin :: Plugin
 plugin = defaultPlugin {parsedResultAction = parsedAction}
 
-parsedAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
-             -> (Messages PsWarning, Messages PsError)
-             -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
-parsedAction _ _ pm (warns, _) = do
+parsedAction :: [CommandLineOption] -> ModSummary
+             -> ParsedResult -> Hsc ParsedResult
+parsedAction _ _ (ParsedResult pm msgs) = do
   liftIO $ putStrLn "parsePlugin"
   -- TODO: Remove #20791
   liftIO $ hFlush stdout
-  pure (pm, (warns, mkMessages $ unitBag err))
+  pure (ParsedResult pm msgs{psErrors = mkMessages $ unitBag err})
   where
     err = MsgEnvelope
       { errMsgSpan = UnhelpfulSpan UnhelpfulNoLocationInfo
diff --git a/testsuite/tests/plugins/T20803-plugin/FixErrorsPlugin.hs b/testsuite/tests/plugins/T20803-plugin/FixErrorsPlugin.hs
index 1cf44edd8a..b8c761a82e 100644
--- a/testsuite/tests/plugins/T20803-plugin/FixErrorsPlugin.hs
+++ b/testsuite/tests/plugins/T20803-plugin/FixErrorsPlugin.hs
@@ -30,20 +30,19 @@ replaceHoles new = gmapT \case
         Eq.Refl | HsUnboundVar _ _ <- d -> Just new
         _                               -> Nothing
 
-parsedAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
-             -> (Messages PsWarning, Messages PsError)
-             -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
-parsedAction _ _ (HsParsedModule lmod srcFiles) (warns, errs) = do
+parsedAction :: [CommandLineOption] -> ModSummary
+             -> ParsedResult -> Hsc ParsedResult
+parsedAction _ _ (ParsedResult (HsParsedModule lmod srcFiles) msgs) = do
   liftIO $ putStrLn "parsePlugin"
   liftIO $ putStrLn $ showPprUnsafe newModule
   -- TODO: Remove #20791
   liftIO $ hFlush stdout
-  pure (HsParsedModule newModule srcFiles, (warns, otherErrs))
+  pure (ParsedResult (HsParsedModule newModule srcFiles) msgs{psErrors = otherErrs})
 
   where
     PsErrBangPatWithoutSpace (L _ holeExpr) = errMsgDiagnostic noSpaceBang
     (bagToList -> [noSpaceBang], mkMessages -> otherErrs) =
-      partitionBag (isNoSpaceBang . errMsgDiagnostic) . getMessages $ errs
+      partitionBag (isNoSpaceBang . errMsgDiagnostic) . getMessages $ psErrors msgs
 
     isNoSpaceBang (PsErrBangPatWithoutSpace _) = True
     isNoSpaceBang _ = False
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
index 8cb2d87c85..24ed240cfc 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
@@ -27,12 +27,11 @@ plugin = defaultPlugin { parsedResultAction = parsedPlugin
                        , interfaceLoadAction = interfaceLoadPlugin'
                        }
 
-parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule
-             -> (Messages PsWarning, Messages PsError)
-             -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
-parsedPlugin [name, "parse"] _ pm msgs
-  = return (pm { hpm_module = removeParsedBinding name (hpm_module pm) }, msgs)
-parsedPlugin _ _ pm msgs = return (pm, msgs)
+parsedPlugin :: [CommandLineOption] -> ModSummary
+             -> ParsedResult -> Hsc ParsedResult
+parsedPlugin [name, "parse"] _ (ParsedResult pm msgs)
+  = return (ParsedResult pm { hpm_module = removeParsedBinding name (hpm_module pm) } msgs)
+parsedPlugin _ _ parsed = return parsed
 
 removeParsedBinding :: String -> Located HsModule
                          -> Located HsModule
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs
index 172a052817..e918b02cc9 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs
@@ -25,14 +25,13 @@ plugin = defaultPlugin { parsedResultAction = parsedPlugin
                        , renamedResultAction = renamedAction
                        }
 
-parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule
-             -> (Messages PsWarning, Messages PsError)
-             -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
-parsedPlugin opts _ pm msgs
+parsedPlugin :: [CommandLineOption] -> ModSummary
+             -> ParsedResult -> Hsc ParsedResult
+parsedPlugin opts _ parsed
   = do liftIO $ putStrLn $ "parsePlugin(" ++ intercalate "," opts ++ ")"
        -- TODO: Remove #20791
        liftIO $ hFlush stdout
-       return (pm, msgs)
+       return parsed
 
 renamedAction :: [CommandLineOption]
                     -> TcGblEnv -> HsGroup GhcRn