Give plugins a better interface (#17957)

Plugins were directly fetched from HscEnv (hsc_static_plugins and
hsc_plugins). The tight coupling of plugins and of HscEnv is undesirable
and it's better to store them in a new Plugins datatype and to use it in
the plugins' API (e.g. withPlugins, mapPlugins...).

In the process, the interactive context (used by GHCi) got proper
support for different static plugins than those used for loaded modules.

Bump haddock submodule

15 files changed, 91 insertions, 75 deletions

diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index 7062865ed7..6b68ccee64 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -92,7 +92,7 @@ core2core hsc_env guts@(ModGuts { mg_module  = mod
        ; (guts2, stats) <- runCoreM hsc_env hpt_rule_base uniq_mask mod
                                     orph_mods print_unqual loc $
                            do { hsc_env' <- getHscEnv
-                              ; all_passes <- withPlugins hsc_env'
+                              ; all_passes <- withPlugins (hsc_plugins hsc_env')
                                                 installCoreToDos
                                                 builtin_passes
                               ; runCorePasses all_passes guts }
diff --git a/compiler/GHC/Driver/Env/Types.hs b/compiler/GHC/Driver/Env/Types.hs
index 0c58ac8855..b0fcc6fd64 100644
--- a/compiler/GHC/Driver/Env/Types.hs
+++ b/compiler/GHC/Driver/Env/Types.hs
@@ -85,21 +85,8 @@ data HscEnv
                 -- ^ target code interpreter (if any) to use for TH and GHCi.
                 -- See Note [Target code interpreter]
 
-        , hsc_plugins :: ![LoadedPlugin]
-                -- ^ plugins dynamically loaded after processing arguments. What
-                -- will be loaded here is directed by DynFlags.pluginModNames.
-                -- Arguments are loaded from DynFlags.pluginModNameOpts.
-                --
-                -- The purpose of this field is to cache the plugins so they
-                -- don't have to be loaded each time they are needed.  See
-                -- 'GHC.Runtime.Loader.initializePlugins'.
-
-        , hsc_static_plugins :: ![StaticPlugin]
-                -- ^ static plugins which do not need dynamic loading. These plugins are
-                -- intended to be added by GHC API users directly to this list.
-                --
-                -- To add dynamically loaded plugins through the GHC API see
-                -- 'addPluginModuleName' instead.
+        , hsc_plugins :: !Plugins
+                -- ^ Plugins
 
         , hsc_unit_env :: UnitEnv
                 -- ^ Unit environment (unit state, home unit, etc.).
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index c403b3e85a..39c1f7af4e 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -265,8 +265,7 @@ newHscEnv dflags = do
                   ,  hsc_type_env_vars  = emptyKnotVars
                   ,  hsc_interp         = Nothing
                   ,  hsc_unit_env       = unit_env
-                  ,  hsc_plugins        = []
-                  ,  hsc_static_plugins = []
+                  ,  hsc_plugins        = emptyPlugins
                   ,  hsc_hooks          = emptyHooks
                   ,  hsc_tmpfs          = tmpfs
                   }
@@ -479,7 +478,7 @@ hscParse' mod_summary
             let applyPluginAction p opts
                   = parsedResultAction p opts mod_summary
             hsc_env <- getHscEnv
-            withPlugins hsc_env applyPluginAction res
+            withPlugins (hsc_plugins hsc_env) applyPluginAction res
 
 checkBidirectionFormatChars :: PsLoc -> StringBuffer -> Maybe (NonEmpty (PsLoc, Char, String))
 checkBidirectionFormatChars start_loc sb
diff --git a/compiler/GHC/Driver/Plugins.hs b/compiler/GHC/Driver/Plugins.hs
index 83d41a6695..4fbbd5ce32 100644
--- a/compiler/GHC/Driver/Plugins.hs
+++ b/compiler/GHC/Driver/Plugins.hs
@@ -7,7 +7,9 @@
 
 module GHC.Driver.Plugins (
       -- * Plugins
-      Plugin(..)
+      Plugins (..)
+    , emptyPlugins
+    , Plugin(..)
     , defaultPlugin
     , CommandLineOption
       -- ** Recompilation checking
@@ -45,7 +47,7 @@ module GHC.Driver.Plugins (
     , HoleFitPluginR
 
       -- * Internal
-    , PluginWithArgs(..), plugins, pluginRecompile'
+    , PluginWithArgs(..), pluginsWithArgs, pluginRecompile'
     , LoadedPlugin(..), lpModuleName
     , StaticPlugin(..)
     , mapPlugins, withPlugins, withPlugins_
@@ -251,25 +253,47 @@ keepRenamedSource _ gbl_env group =
 type PluginOperation m a = Plugin -> [CommandLineOption] -> a -> m a
 type ConstPluginOperation m a = Plugin -> [CommandLineOption] -> a -> m ()
 
-plugins :: HscEnv -> [PluginWithArgs]
-plugins hsc_env =
-  map lpPlugin (hsc_plugins hsc_env) ++
-  map spPlugin (hsc_static_plugins hsc_env)
+data Plugins = Plugins
+  { staticPlugins :: ![StaticPlugin]
+      -- ^ Static plugins which do not need dynamic loading. These plugins are
+      -- intended to be added by GHC API users directly to this list.
+      --
+      -- To add dynamically loaded plugins through the GHC API see
+      -- 'addPluginModuleName' instead.
+
+  , loadedPlugins :: ![LoadedPlugin]
+      -- ^ Plugins dynamically loaded after processing arguments. What
+      -- will be loaded here is directed by DynFlags.pluginModNames.
+      -- Arguments are loaded from DynFlags.pluginModNameOpts.
+      --
+      -- The purpose of this field is to cache the plugins so they
+      -- don't have to be loaded each time they are needed.  See
+      -- 'GHC.Runtime.Loader.initializePlugins'.
+  }
+
+emptyPlugins :: Plugins
+emptyPlugins = Plugins [] []
+
+
+pluginsWithArgs :: Plugins -> [PluginWithArgs]
+pluginsWithArgs plugins =
+  map lpPlugin (loadedPlugins plugins) ++
+  map spPlugin (staticPlugins plugins)
 
 -- | Perform an operation by using all of the plugins in turn.
-withPlugins :: Monad m => HscEnv -> PluginOperation m a -> a -> m a
-withPlugins hsc_env transformation input = foldM go input (plugins hsc_env)
+withPlugins :: Monad m => Plugins -> PluginOperation m a -> a -> m a
+withPlugins plugins transformation input = foldM go input (pluginsWithArgs plugins)
   where
     go arg (PluginWithArgs p opts) = transformation p opts arg
 
-mapPlugins :: HscEnv -> (Plugin -> [CommandLineOption] -> a) -> [a]
-mapPlugins hsc_env f = map (\(PluginWithArgs p opts) -> f p opts) (plugins hsc_env)
+mapPlugins :: Plugins -> (Plugin -> [CommandLineOption] -> a) -> [a]
+mapPlugins plugins f = map (\(PluginWithArgs p opts) -> f p opts) (pluginsWithArgs plugins)
 
 -- | Perform a constant operation by using all of the plugins in turn.
-withPlugins_ :: Monad m => HscEnv -> ConstPluginOperation m a -> a -> m ()
-withPlugins_ hsc_env transformation input
+withPlugins_ :: Monad m => Plugins -> ConstPluginOperation m a -> a -> m ()
+withPlugins_ plugins transformation input
   = mapM_ (\(PluginWithArgs p opts) -> transformation p opts input)
-          (plugins hsc_env)
+          (pluginsWithArgs plugins)
 
 type FrontendPluginAction = [String] -> [(String, Maybe Phase)] -> Ghc ()
 data FrontendPlugin = FrontendPlugin {
diff --git a/compiler/GHC/Driver/Plugins.hs-boot b/compiler/GHC/Driver/Plugins.hs-boot
index 7b5f8ca161..15b3657dd0 100644
--- a/compiler/GHC/Driver/Plugins.hs-boot
+++ b/compiler/GHC/Driver/Plugins.hs-boot
@@ -5,6 +5,9 @@ module GHC.Driver.Plugins where
 import GHC.Prelude ()
 
 data Plugin
+data Plugins
+
+emptyPlugins :: Plugins
 
 data LoadedPlugin
 data StaticPlugin
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index d55bdf7115..a7bbbf16aa 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -22,6 +22,7 @@ import GHC.Driver.Session
 import GHC.Driver.Config
 import GHC.Driver.Env
 import GHC.Driver.Backend
+import GHC.Driver.Plugins
 
 import GHC.Hs
 
@@ -90,7 +91,6 @@ import GHC.Unit.Module.Deps
 
 import Data.List (partition)
 import Data.IORef
-import GHC.Driver.Plugins ( LoadedPlugin(..) )
 
 {-
 ************************************************************************
@@ -196,7 +196,7 @@ deSugar hsc_env
         ; endPassIO hsc_env print_unqual CoreDesugarOpt ds_binds ds_rules_for_imps
 
         ; let used_names = mkUsedNames tcg_env
-              pluginModules = map lpModule (hsc_plugins hsc_env)
+              pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env))
               home_unit = hsc_home_unit hsc_env
         ; let deps = mkDependencies home_unit
                                     (tcg_mod tcg_env)
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 78005781d4..f1da9d7e0a 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -575,7 +575,7 @@ loadInterface doc_str mod from
 
         ; -- invoke plugins with *full* interface, not final_iface, to ensure
           -- that plugins have access to declarations, etc.
-          res <- withPlugins hsc_env (\p -> interfaceLoadAction p) iface
+          res <- withPlugins (hsc_plugins hsc_env) (\p -> interfaceLoadAction p) iface
         ; return (Succeeded res)
     }}}}
 
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index fd0516ca87..9627752811 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -51,7 +51,7 @@ import GHC.Core.Unify( RoughMatchTc(..) )
 import GHC.Driver.Env
 import GHC.Driver.Backend
 import GHC.Driver.Session
-import GHC.Driver.Plugins (LoadedPlugin(..))
+import GHC.Driver.Plugins
 
 import GHC.Types.Id
 import GHC.Types.Fixity.Env
@@ -197,7 +197,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary
                     }
   = do
           let used_names = mkUsedNames tc_result
-          let pluginModules = map lpModule (hsc_plugins hsc_env)
+          let pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env))
           let home_unit = hsc_home_unit hsc_env
           let deps = mkDependencies home_unit
                                     (tcg_mod tc_result)
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 89e10424e3..6b184787fa 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -19,7 +19,7 @@ import GHC.Driver.Config.Finder
 import GHC.Driver.Env
 import GHC.Driver.Session
 import GHC.Driver.Ppr
-import GHC.Driver.Plugins ( PluginRecompile(..), PluginWithArgs(..), pluginRecompile', plugins )
+import GHC.Driver.Plugins
 
 import GHC.Iface.Syntax
 import GHC.Iface.Recomp.Binary
@@ -333,7 +333,7 @@ checkVersions hsc_env mod_summary iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
        ; recomp <- checkDependencies hsc_env mod_summary iface
        ; if recompileRequired recomp then return (recomp, Just iface) else do {
-       ; recomp <- checkPlugins hsc_env iface
+       ; recomp <- checkPlugins (hsc_plugins hsc_env) iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
 
 
@@ -362,28 +362,27 @@ checkVersions hsc_env mod_summary iface
 
 
 -- | Check if any plugins are requesting recompilation
-checkPlugins :: HscEnv -> ModIface -> IfG RecompileRequired
-checkPlugins hsc_env iface = liftIO $ do
-  new_fingerprint <- fingerprintPlugins hsc_env
+checkPlugins :: Plugins -> ModIface -> IfG RecompileRequired
+checkPlugins plugins iface = liftIO $ do
+  recomp <- recompPlugins plugins
+  let new_fingerprint = fingerprintPluginRecompile recomp
   let old_fingerprint = mi_plugin_hash (mi_final_exts iface)
-  pr <- mconcat <$> mapM pluginRecompile' (plugins hsc_env)
-  return $
-    pluginRecompileToRecompileRequired old_fingerprint new_fingerprint pr
-
-fingerprintPlugins :: HscEnv -> IO Fingerprint
-fingerprintPlugins hsc_env =
-  fingerprintPlugins' $ plugins hsc_env
-
-fingerprintPlugins' :: [PluginWithArgs] -> IO Fingerprint
-fingerprintPlugins' plugins = do
-  res <- mconcat <$> mapM pluginRecompile' plugins
-  return $ case res of
-      NoForceRecompile -> fingerprintString "NoForceRecompile"
-      ForceRecompile   -> fingerprintString "ForceRecompile"
-      -- is the chance of collision worth worrying about?
-      -- An alternative is to fingerprintFingerprints [fingerprintString
-      -- "maybeRecompile", fp]
-      (MaybeRecompile fp) -> fp
+  return $ pluginRecompileToRecompileRequired old_fingerprint new_fingerprint recomp
+
+recompPlugins :: Plugins -> IO PluginRecompile
+recompPlugins plugins = mconcat <$> mapM pluginRecompile' (pluginsWithArgs plugins)
+
+fingerprintPlugins :: Plugins -> IO Fingerprint
+fingerprintPlugins plugins = fingerprintPluginRecompile <$> recompPlugins plugins
+
+fingerprintPluginRecompile :: PluginRecompile -> Fingerprint
+fingerprintPluginRecompile recomp = case recomp of
+  NoForceRecompile  -> fingerprintString "NoForceRecompile"
+  ForceRecompile    -> fingerprintString "ForceRecompile"
+  -- is the chance of collision worth worrying about?
+  -- An alternative is to fingerprintFingerprints [fingerprintString
+  -- "maybeRecompile", fp]
+  MaybeRecompile fp -> fp
 
 
 pluginRecompileToRecompileRequired
@@ -1164,7 +1163,7 @@ addFingerprints hsc_env iface0
 
    hpc_hash <- fingerprintHpcFlags dflags putNameLiterally
 
-   plugin_hash <- fingerprintPlugins hsc_env
+   plugin_hash <- fingerprintPlugins (hsc_plugins hsc_env)
 
    -- the ABI hash depends on:
    --   - decls
diff --git a/compiler/GHC/Runtime/Context.hs b/compiler/GHC/Runtime/Context.hs
index a1df5fd029..8222e96ce8 100644
--- a/compiler/GHC/Runtime/Context.hs
+++ b/compiler/GHC/Runtime/Context.hs
@@ -284,7 +284,7 @@ data InteractiveContext
          ic_cwd :: Maybe FilePath,
              -- ^ virtual CWD of the program
 
-         ic_plugins :: ![LoadedPlugin]
+         ic_plugins :: !Plugins
              -- ^ Cache of loaded plugins. We store them here to avoid having to
              -- load them everytime we switch to the interctive context.
     }
@@ -321,7 +321,7 @@ emptyInteractiveContext dflags
        ic_default    = Nothing,
        ic_resume     = [],
        ic_cwd        = Nothing,
-       ic_plugins    = []
+       ic_plugins    = emptyPlugins
        }
 
 icReaderEnv :: InteractiveContext -> GlobalRdrEnv
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index 704f499a4f..e93e6969bc 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -74,14 +74,16 @@ import GHC.Unit.Types (ModuleNameWithIsBoot)
 initializePlugins :: HscEnv -> Maybe ModuleNameWithIsBoot -> IO HscEnv
 initializePlugins hsc_env mnwib
     -- plugins not changed
-  | map lpModuleName (hsc_plugins hsc_env) == reverse (pluginModNames dflags)
+  | loaded_plugins <- loadedPlugins (hsc_plugins hsc_env)
+  , map lpModuleName loaded_plugins == reverse (pluginModNames dflags)
    -- arguments not changed
-  , all same_args (hsc_plugins hsc_env)
-  = return hsc_env -- no need to reload plugins
+  , all same_args loaded_plugins
+  = return hsc_env -- no need to reload plugins FIXME: doesn't take static plugins into account
   | otherwise
   = do loaded_plugins <- loadPlugins hsc_env mnwib
-       let hsc_env' = hsc_env { hsc_plugins = loaded_plugins }
-       withPlugins hsc_env' driverPlugin hsc_env'
+       let plugins' = (hsc_plugins hsc_env) { loadedPlugins = loaded_plugins }
+       let hsc_env' = hsc_env { hsc_plugins = plugins' }
+       withPlugins (hsc_plugins hsc_env') driverPlugin hsc_env'
   where
     plugin_args = pluginModNameOpts dflags
     same_args p = paArguments (lpPlugin p) == argumentsForPlugin p plugin_args
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 9ddff4213b..bba7eeaedc 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -994,7 +994,7 @@ runMeta' show_code ppr_hs run_and_convert expr
 
         -- run plugins
         ; hsc_env <- getTopEnv
-        ; expr' <- withPlugins hsc_env spliceRunAction expr
+        ; expr' <- withPlugins (hsc_plugins hsc_env) spliceRunAction expr
 
         -- Desugar
         ; (ds_msgs, mb_ds_expr) <- initDsTc (dsLExpr expr')
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 06270c1848..68bfba4448 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -3071,7 +3071,7 @@ Type Checker Plugins
 
 withTcPlugins :: HscEnv -> TcM a -> TcM a
 withTcPlugins hsc_env m =
-    case catMaybes $ mapPlugins hsc_env tcPlugin of
+    case catMaybes $ mapPlugins (hsc_plugins hsc_env) tcPlugin of
        []      -> m  -- Common fast case
        plugins -> do
                 ev_binds_var <- newTcEvBinds
@@ -3096,7 +3096,7 @@ withTcPlugins hsc_env m =
 
 withDefaultingPlugins :: HscEnv -> TcM a -> TcM a
 withDefaultingPlugins hsc_env m =
-  do case catMaybes $ mapPlugins hsc_env defaultingPlugin of
+  do case catMaybes $ mapPlugins (hsc_plugins hsc_env) defaultingPlugin of
        [] -> m  -- Common fast case
        plugins  -> do (plugins,stops) <- mapAndUnzipM start_plugin plugins
                       -- This ensures that dePluginStop is called even if a type
@@ -3114,7 +3114,7 @@ withDefaultingPlugins hsc_env m =
 
 withHoleFitPlugins :: HscEnv -> TcM a -> TcM a
 withHoleFitPlugins hsc_env m =
-  case catMaybes $ mapPlugins hsc_env holeFitPlugin of
+  case catMaybes $ mapPlugins (hsc_plugins hsc_env) holeFitPlugin of
     [] -> m  -- Common fast case
     plugins -> do (plugins,stops) <- mapAndUnzipM start_plugin plugins
                   -- This ensures that hfPluginStop is called even if a type
@@ -3136,7 +3136,7 @@ runRenamerPlugin :: TcGblEnv
                  -> TcM (TcGblEnv, HsGroup GhcRn)
 runRenamerPlugin gbl_env hs_group = do
     hsc_env <- getTopEnv
-    withPlugins hsc_env
+    withPlugins (hsc_plugins hsc_env)
       (\p opts (e, g) -> ( mark_plugin_unsafe (hsc_dflags hsc_env)
                             >> renamedResultAction p opts e g))
       (gbl_env, hs_group)
@@ -3159,7 +3159,7 @@ getRenamedStuff tc_result
 runTypecheckerPlugin :: ModSummary -> TcGblEnv -> TcM TcGblEnv
 runTypecheckerPlugin sum gbl_env = do
     hsc_env <- getTopEnv
-    withPlugins hsc_env
+    withPlugins (hsc_plugins hsc_env)
       (\p opts env -> mark_plugin_unsafe (hsc_dflags hsc_env)
                         >> typeCheckResultAction p opts sum env)
       gbl_env
diff --git a/testsuite/tests/plugins/static-plugins.hs b/testsuite/tests/plugins/static-plugins.hs
index 73d91a93e3..5d5afc4dcc 100644
--- a/testsuite/tests/plugins/static-plugins.hs
+++ b/testsuite/tests/plugins/static-plugins.hs
@@ -68,7 +68,9 @@ main = do
       target <- guessTarget "static-plugins-module.hs" Nothing Nothing
       setTargets [target]
 
-      modifySession (\hsc_env -> hsc_env { hsc_static_plugins = the_plugins})
+      modifySession $ \hsc_env ->
+        let old_plugins = hsc_plugins hsc_env
+        in hsc_env { hsc_plugins = old_plugins { staticPlugins = the_plugins } }
 
       dflags <- getSessionDynFlags
       setSessionDynFlags dflags { outputFile_ = Nothing }
diff --git a/utils/haddock b/utils/haddock
-Subproject bbe3c508cc5688683f9febbed814e5230dce0c4
+Subproject 00e7d92f372c706dfd749d824c8c97d38383c25