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>

11 files changed, 95 insertions, 5 deletions

diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T
index ef0096f064..c782ad13cd 100644
--- a/testsuite/tests/plugins/all.T
+++ b/testsuite/tests/plugins/all.T
@@ -317,3 +317,17 @@ test('plugins-external',
       pre_cmd('$MAKE -s --no-print-directory -C shared-plugin package.plugins01 TOP={top}'),
       when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))],
      makefile_test, [])
+
+test('test-phase-hooks-plugin',
+     [extra_files(['hooks-plugin/']),
+      pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.test-phase-hooks-plugin TOP={top}'),
+
+      when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))],
+     compile,
+     ['-package-db hooks-plugin/pkg.test-phase-hooks-plugin/local.package.conf -fplugin Hooks.PhasePlugin -package hooks-plugin ' + config.plugin_way_flags])
+
+test('test-log-hooks-plugin',
+     [extra_files(['hooks-plugin/']),
+      pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.test-log-hooks-plugin TOP={top}')],
+     compile_fail,
+     ['-package-db hooks-plugin/pkg.test-log-hooks-plugin/local.package.conf -fplugin Hooks.LogPlugin -package hooks-plugin ' + config.plugin_way_flags])
diff --git a/testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs b/testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs
new file mode 100644
index 0000000000..10591240f9
--- /dev/null
+++ b/testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs
@@ -0,0 +1,24 @@
+module Hooks.LogPlugin (plugin) where
+
+import GHC.Plugins
+import GHC.Driver.Hooks
+import GHC.Tc.Utils.Monad
+import GHC.Utils.Logger
+import GHC.Driver.Pipeline.Execute
+import System.IO
+
+plugin :: Plugin
+plugin = defaultPlugin { driverPlugin = hooksP }
+
+hooksP :: [CommandLineOption] -> HscEnv -> IO HscEnv
+hooksP opts hsc_env = do
+  hSetBuffering stdout NoBuffering
+  let logger  = hsc_logger hsc_env
+      logger' = pushLogHook logHook logger
+      hsc_env' = hsc_env { hsc_logger = logger' }
+  return hsc_env'
+
+logHook :: LogAction -> LogAction
+logHook action logFlags messageClass srcSpan msgDoc = do
+  putStrLn "Log hook called"
+  action logFlags messageClass srcSpan msgDoc
diff --git a/testsuite/tests/plugins/hooks-plugin/Hooks/Plugin.hs b/testsuite/tests/plugins/hooks-plugin/Hooks/MetaPlugin.hs
index bf717b26c0..29c1dab2b7 100644
--- a/testsuite/tests/plugins/hooks-plugin/Hooks/Plugin.hs
+++ b/testsuite/tests/plugins/hooks-plugin/Hooks/MetaPlugin.hs
@@ -1,5 +1,5 @@
 {-# OPTIONS_GHC -Wall #-}
-module Hooks.Plugin (plugin) where
+module Hooks.MetaPlugin (plugin) where
 
 import GHC.Types.SourceText
 import GHC.Plugins
diff --git a/testsuite/tests/plugins/hooks-plugin/Hooks/PhasePlugin.hs b/testsuite/tests/plugins/hooks-plugin/Hooks/PhasePlugin.hs
new file mode 100644
index 0000000000..51cff77404
--- /dev/null
+++ b/testsuite/tests/plugins/hooks-plugin/Hooks/PhasePlugin.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE GADTs #-}
+{-# OPTIONS_GHC -Wall #-}
+module Hooks.PhasePlugin (plugin) where
+
+import GHC.Plugins
+import GHC.Driver.Hooks
+import GHC.Tc.Utils.Monad
+import GHC.Driver.Pipeline.Execute
+import GHC.Driver.Pipeline.Phases
+import System.IO
+
+plugin :: Plugin
+plugin = defaultPlugin { driverPlugin = hooksP }
+
+hooksP :: [CommandLineOption] -> HscEnv -> IO HscEnv
+hooksP opts hsc_env = do
+  hSetBuffering stdout NoBuffering
+  let hooks  = hsc_hooks hsc_env
+      hooks' = hooks { runPhaseHook = Just fakeRunPhaseHook }
+      hsc_env' = hsc_env { hsc_hooks = hooks' }
+  return hsc_env'
+
+fakeRunPhaseHook :: PhaseHook
+fakeRunPhaseHook = PhaseHook $ \tPhase -> do
+  liftIO $ case tPhase of
+    T_Cpp{} -> putStrLn "Cpp hook fired"
+    T_Hsc{} -> putStrLn "Hsc hook fired"
+    T_FileArgs{} -> putStrLn "FileArgs hook fired"
+    _ -> pure ()
+  runPhase tPhase
diff --git a/testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal b/testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal
index 3c1cf61184..b19ad6f18e 100644
--- a/testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal
+++ b/testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal
@@ -4,6 +4,6 @@ version:             0.1
 build-type:          Simple
 
 library
-  exposed-modules:     Hooks.Plugin
+  exposed-modules:     Hooks.MetaPlugin, Hooks.PhasePlugin, Hooks.LogPlugin
   build-depends:       base, ghc
   default-language:    Haskell2010
diff --git a/testsuite/tests/plugins/plugins04.stderr b/testsuite/tests/plugins/plugins04.stderr
index 67922911fb..a56ed56856 100644
--- a/testsuite/tests/plugins/plugins04.stderr
+++ b/testsuite/tests/plugins/plugins04.stderr
@@ -1,2 +1 @@
-Module graph contains a cycle:
-  module ‘HomePackagePlugin’ (./HomePackagePlugin.hs) imports itself
+attempting to use module ‘main:HomePackagePlugin’ (./HomePackagePlugin.hs) which is not loaded
diff --git a/testsuite/tests/plugins/test-hooks-plugin.hs b/testsuite/tests/plugins/test-hooks-plugin.hs
index bf324f9966..c7bfa9dbce 100644
--- a/testsuite/tests/plugins/test-hooks-plugin.hs
+++ b/testsuite/tests/plugins/test-hooks-plugin.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -fplugin=Hooks.Plugin #-}
+{-# OPTIONS -fplugin=Hooks.MetaPlugin #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Main where
 
diff --git a/testsuite/tests/plugins/test-log-hooks-plugin.hs b/testsuite/tests/plugins/test-log-hooks-plugin.hs
new file mode 100644
index 0000000000..f0308a3fe6
--- /dev/null
+++ b/testsuite/tests/plugins/test-log-hooks-plugin.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = pure "type error"
diff --git a/testsuite/tests/plugins/test-log-hooks-plugin.stderr b/testsuite/tests/plugins/test-log-hooks-plugin.stderr
new file mode 100644
index 0000000000..dba4679f52
--- /dev/null
+++ b/testsuite/tests/plugins/test-log-hooks-plugin.stderr
@@ -0,0 +1,9 @@
+Log hook called
+
+test-log-hooks-plugin.hs:4:13: error: [GHC-83865]
+    • Couldn't match type ‘[Char]’ with ‘()’
+      Expected: ()
+        Actual: String
+    • In the first argument of ‘pure’, namely ‘"type error"’
+      In the expression: pure "type error"
+      In an equation for ‘main’: main = pure "type error"
diff --git a/testsuite/tests/plugins/test-phase-hooks-plugin.hs b/testsuite/tests/plugins/test-phase-hooks-plugin.hs
new file mode 100644
index 0000000000..9271fad67b
--- /dev/null
+++ b/testsuite/tests/plugins/test-phase-hooks-plugin.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE CPP #-}
+module Main where
+
+main :: IO ()
+main = pure ()
diff --git a/testsuite/tests/plugins/test-phase-hooks-plugin.stderr b/testsuite/tests/plugins/test-phase-hooks-plugin.stderr
new file mode 100644
index 0000000000..ae1b36330d
--- /dev/null
+++ b/testsuite/tests/plugins/test-phase-hooks-plugin.stderr
@@ -0,0 +1,5 @@
+FileArgs hook fired
+Cpp hook fired
+FileArgs hook fired
+FileArgs hook fired
+Hsc hook fired