Support registering Plugins through the GHC API

This allows tooling using the GHC API to use plugins internally.
Hopefully this will make it possible to decouple the development of
useful plugins from (currently) kitchen-sink type tooling projects
such as ghc-mod or HIE -- at least to some extent.

Test Plan: validate

Reviewers: bgamari, mpickering

Subscribers: mpickering, alanz, rwbarton, carter

GHC Trac Issues: #15826

Differential Revision: https://phabricator.haskell.org/D5278

4 files changed, 113 insertions, 0 deletions

diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T
index 9a1a7ea398..72a42da91a 100644
--- a/testsuite/tests/plugins/all.T
+++ b/testsuite/tests/plugins/all.T
@@ -193,3 +193,9 @@ test('plugin-recomp-change-prof',
       when(not config.have_profiling,skip)
       ],
      run_command, ['$MAKE -s --no-print-directory plugin-recomp-change-prof'])
+
+test('static-plugins',
+     [extra_files(['simple-plugin/']),
+      extra_run_opts('"' + config.libdir + '"')],
+     compile_and_run,
+     ['-package ghc -isimple-plugin/'])
diff --git a/testsuite/tests/plugins/static-plugins-module.hs b/testsuite/tests/plugins/static-plugins-module.hs
new file mode 100644
index 0000000000..4aafd0de8a
--- /dev/null
+++ b/testsuite/tests/plugins/static-plugins-module.hs
@@ -0,0 +1,2 @@
+module Main where
+main = print "Hello world!"
diff --git a/testsuite/tests/plugins/static-plugins.hs b/testsuite/tests/plugins/static-plugins.hs
new file mode 100644
index 0000000000..36e18b86b5
--- /dev/null
+++ b/testsuite/tests/plugins/static-plugins.hs
@@ -0,0 +1,80 @@
+module Main where
+
+import Avail
+import Control.Monad.IO.Class
+import DynFlags
+  (getDynFlags, parseDynamicFlagsCmdLine, defaultFatalMessager, defaultFlushOut)
+import GHC
+import GHC.Fingerprint.Type
+import HsDecls
+import HsDoc
+import HsExpr
+import HsExtension
+import HsImpExp
+import HscTypes
+import Outputable
+import Plugins
+import System.Environment
+import TcRnTypes
+
+import Simple.SourcePlugin (plugin)
+
+main = do
+  libdir:args <- getArgs
+  defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
+    runGhc (Just libdir) $ do
+      dflags <- getSessionDynFlags
+      -- liftIO $ print args
+      -- (dflags,_,_)
+      --     <- parseDynamicFlagsCmdLine dflags (map noLoc args)
+      -- we need to LinkInMemory otherwise `setTarget [] >> load LoadAllTargets`
+      -- below will fail.
+      setSessionDynFlags dflags { ghcLink = LinkInMemory}
+
+      -- Start with a pure plugin, this should trigger recomp.
+      liftIO $ putStrLn "==pure.0"
+      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin0_pure []]
+
+      -- The same (or a different) pure plugin shouldn't trigger recomp.
+      liftIO $ putStrLn "==pure.1"
+      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin0_pure []]
+
+      -- Next try with a fingerprint plugin, should trigger recomp.
+      liftIO $ putStrLn "==fp0.0"
+      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin_fp0 []]
+
+      -- With the same fingerprint plugin, should not trigger recomp.
+      liftIO $ putStrLn "==fp0.1"
+      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin_fp0 []]
+
+      -- Change the plugin fingerprint, should trigger recomp.
+      liftIO $ putStrLn "==fp1"
+      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin_fp1 []]
+
+      -- TODO: this currently doesn't work, patch pending
+      -- -- Even though the plugin is now pure we should still recomp since we
+      -- -- used a potentially impure plugin before
+      -- liftIO $ putStrLn "pure.2"
+      -- loadWithPlugins [StaticPlugin $ PluginWithArgs plugin0_pure []]
+
+  where
+    loadWithPlugins the_plugins = do
+      -- first unload (like GHCi :load does)
+      GHC.setTargets []
+      _ <- GHC.load LoadAllTargets
+
+      target <- guessTarget "static-plugins-module.hs" Nothing
+      setTargets [target]
+
+      dflags <- getSessionDynFlags
+      setSessionDynFlags dflags { staticPlugins = the_plugins
+                                , outputFile = Nothing }
+      load LoadAllTargets
+
+
+plugin_fp0   =
+  plugin { pluginRecompile = \_ -> pure $ MaybeRecompile $ Fingerprint 0 0 }
+plugin_fp1   =
+  plugin { pluginRecompile = \_ -> pure $ MaybeRecompile $ Fingerprint 0 1 }
+plugin0_pure =
+  plugin { pluginRecompile = \_ -> pure $ NoForceRecompile }
diff --git a/testsuite/tests/plugins/static-plugins.stdout b/testsuite/tests/plugins/static-plugins.stdout
new file mode 100644
index 0000000000..f7520a7cfb
--- /dev/null
+++ b/testsuite/tests/plugins/static-plugins.stdout
@@ -0,0 +1,25 @@
+==pure.0
+parsePlugin()
+interfacePlugin: Prelude
+interfacePlugin: GHC.Float
+interfacePlugin: GHC.Base
+interfacePlugin: System.IO
+typeCheckPlugin (rn)
+interfacePlugin: GHC.Prim
+interfacePlugin: GHC.Show
+interfacePlugin: GHC.Types
+interfacePlugin: GHC.TopHandler
+typeCheckPlugin (tc)
+interfacePlugin: GHC.CString
+interfacePlugin: GHC.Integer.Type
+interfacePlugin: GHC.Natural
+==pure.1
+==fp0.0
+parsePlugin()
+typeCheckPlugin (rn)
+typeCheckPlugin (tc)
+==fp0.1
+==fp1
+parsePlugin()
+typeCheckPlugin (rn)
+typeCheckPlugin (tc)