Rework plugin initialisation points

In general this patch pushes plugin initialisation points to earlier in
the pipeline. As plugins can modify the `HscEnv`, it's imperative that
the plugins are initialised as soon as possible and used thereafter.

For example, there are some new tests which modify hsc_logger and other
hooks which failed to fire before (and now do)

One consequence of this change is that the error for specifying the
usage of a HPT plugin from the command line has changed, because it's
now attempted to be loaded at initialisation rather than causing a
cyclic module import.

Closes #21279

Co-authored-by: Matthew Pickering <matthewtpickering@gmail.com>

1 files changed, 42 insertions, 0 deletions

diff --git a/testsuite/tests/plugins/hooks-plugin/Hooks/MetaPlugin.hs b/testsuite/tests/plugins/hooks-plugin/Hooks/MetaPlugin.hs
new file mode 100644
index 0000000000..29c1dab2b7
--- /dev/null
+++ b/testsuite/tests/plugins/hooks-plugin/Hooks/MetaPlugin.hs
@@ -0,0 +1,42 @@
+{-# OPTIONS_GHC -Wall #-}
+module Hooks.MetaPlugin (plugin) where
+
+import GHC.Types.SourceText
+import GHC.Plugins
+import GHC.Hs.Expr
+import Language.Haskell.Syntax.Extension
+import GHC.Hs.Extension
+import GHC.Hs.Lit
+import GHC.Driver.Hooks
+import GHC.Tc.Utils.Monad
+import GHC.Parser.Annotation
+import System.IO
+
+plugin :: Plugin
+plugin = defaultPlugin { driverPlugin = hooksP }
+
+hooksP :: [CommandLineOption] -> HscEnv -> IO HscEnv
+hooksP opts hsc_env = do
+    let hooks  = hsc_hooks hsc_env
+        hooks' = hooks { runMetaHook = Just (fakeRunMeta opts) }
+        hsc_env' = hsc_env { hsc_hooks = hooks' }
+    return hsc_env'
+
+-- This meta hook doesn't actually care running code in splices,
+-- it just replaces any expression splice with the "0"
+-- integer literal, and errors out on all other types of
+-- meta requests.
+fakeRunMeta :: [CommandLineOption] -> MetaHook TcM
+fakeRunMeta opts (MetaE r) _ = do
+  liftIO . putStrLn $ "Options = " ++ show opts
+
+  -- TODO: Remove #20791
+  liftIO $ hFlush stdout
+
+  pure $ r zero
+
+  where zero :: LHsExpr GhcPs
+        zero = noLocA $ HsLit noAnn $
+          HsInt NoExtField (mkIntegralLit (0 :: Int))
+
+fakeRunMeta _ _ _ = error "fakeRunMeta: unimplemented"