1{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE CPP #-}
3
4-- | Definitions for writing /plugins/ for GHC. Plugins can hook into
5-- several areas of the compiler. See the 'Plugin' type. These plugins
6-- include type-checker plugins, source plugins, and core-to-core plugins.
7
8module Plugins (
9      -- * Plugins
10      Plugin(..)
11    , defaultPlugin
12    , CommandLineOption
13      -- ** Recompilation checking
14    , purePlugin, impurePlugin, flagRecompile
15    , PluginRecompile(..)
16
17      -- * Plugin types
18      -- ** Frontend plugins
19    , FrontendPlugin(..), defaultFrontendPlugin, FrontendPluginAction
20      -- ** Core plugins
21      -- | Core plugins allow plugins to register as a Core-to-Core pass.
22    , CorePlugin
23      -- ** Typechecker plugins
24      -- | Typechecker plugins allow plugins to provide evidence to the
25      -- typechecker.
26    , TcPlugin
27      -- ** Source plugins
28      -- | GHC offers a number of points where plugins can access and modify its
29      -- front-end (\"source\") representation. These include:
30      --
31      -- - access to the parser result with 'parsedResultAction'
32      -- - access to the renamed AST with 'renamedResultAction'
33      -- - access to the typechecked AST with 'typeCheckResultAction'
34      -- - access to the Template Haskell splices with 'spliceRunAction'
35      -- - access to loaded interface files with 'interfaceLoadAction'
36      --
37    , keepRenamedSource
38      -- ** Hole fit plugins
39      -- | hole fit plugins allow plugins to change the behavior of valid hole
40      -- fit suggestions
41    , HoleFitPluginR
42
43      -- * Internal
44    , PluginWithArgs(..), plugins, pluginRecompile'
45    , LoadedPlugin(..), lpModuleName
46    , StaticPlugin(..)
47    , mapPlugins, withPlugins, withPlugins_
48    ) where
49
50import GhcPrelude
51
52import {-# SOURCE #-} CoreMonad ( CoreToDo, CoreM )
53import qualified TcRnTypes
54import TcRnTypes ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports  )
55import TcHoleFitTypes ( HoleFitPluginR )
56import GHC.Hs
57import DynFlags
58import HscTypes
59import GhcMonad
60import DriverPhases
61import Module ( ModuleName, Module(moduleName))
62import Fingerprint
63import Data.List (sort)
64import Outputable (Outputable(..), text, (<+>))
65
66--Qualified import so we can define a Semigroup instance
67-- but it doesn't clash with Outputable.<>
68import qualified Data.Semigroup
69
70import Control.Monad
71
72-- | Command line options gathered from the -PModule.Name:stuff syntax
73-- are given to you as this type
74type CommandLineOption = String
75
76-- | 'Plugin' is the compiler plugin data type. Try to avoid
77-- constructing one of these directly, and just modify some fields of
78-- 'defaultPlugin' instead: this is to try and preserve source-code
79-- compatibility when we add fields to this.
80--
81-- Nonetheless, this API is preliminary and highly likely to change in
82-- the future.
83data Plugin = Plugin {
84    installCoreToDos :: CorePlugin
85    -- ^ Modify the Core pipeline that will be used for compilation.
86    -- This is called as the Core pipeline is built for every module
87    -- being compiled, and plugins get the opportunity to modify the
88    -- pipeline in a nondeterministic order.
89  , tcPlugin :: TcPlugin
90    -- ^ An optional typechecker plugin, which may modify the
91    -- behaviour of the constraint solver.
92  , holeFitPlugin :: HoleFitPlugin
93    -- ^ An optional plugin to handle hole fits, which may re-order
94    --   or change the list of valid hole fits and refinement hole fits.
95  , dynflagsPlugin :: [CommandLineOption] -> DynFlags -> IO DynFlags
96    -- ^ An optional plugin to update 'DynFlags', right after
97    --   plugin loading. This can be used to register hooks
98    --   or tweak any field of 'DynFlags' before doing
99    --   actual work on a module.
100    --
101    --   @since 8.10.1
102  , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
103    -- ^ Specify how the plugin should affect recompilation.
104  , parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
105                            -> Hsc HsParsedModule
106    -- ^ Modify the module when it is parsed. This is called by
107    -- HscMain when the parsing is successful.
108  , renamedResultAction :: [CommandLineOption] -> TcGblEnv
109                                -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
110    -- ^ Modify each group after it is renamed. This is called after each
111    -- `HsGroup` has been renamed.
112  , typeCheckResultAction :: [CommandLineOption] -> ModSummary -> TcGblEnv
113                               -> TcM TcGblEnv
114    -- ^ Modify the module when it is type checked. This is called at the
115    -- very end of typechecking.
116  , spliceRunAction :: [CommandLineOption] -> LHsExpr GhcTc
117                         -> TcM (LHsExpr GhcTc)
118    -- ^ Modify the TH splice or quasiqoute before it is run.
119  , interfaceLoadAction :: forall lcl . [CommandLineOption] -> ModIface
120                                          -> IfM lcl ModIface
121    -- ^ Modify an interface that have been loaded. This is called by
122    -- LoadIface when an interface is successfully loaded. Not applied to
123    -- the loading of the plugin interface. Tools that rely on information from
124    -- modules other than the currently compiled one should implement this
125    -- function.
126  }
127
128-- Note [Source plugins]
129-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
130-- The `Plugin` datatype have been extended by fields that allow access to the
131-- different inner representations that are generated during the compilation
132-- process. These fields are `parsedResultAction`, `renamedResultAction`,
133-- `typeCheckResultAction`, `spliceRunAction` and `interfaceLoadAction`.
134--
135-- The main purpose of these plugins is to help tool developers. They allow
136-- development tools to extract the information about the source code of a big
137-- Haskell project during the normal build procedure. In this case the plugin
138-- acts as the tools access point to the compiler that can be controlled by
139-- compiler flags. This is important because the manipulation of compiler flags
140-- is supported by most build environment.
141--
142-- For the full discussion, check the full proposal at:
143-- https://gitlab.haskell.org/ghc/ghc/wikis/extended-plugins-proposal
144
145data PluginWithArgs = PluginWithArgs
146  { paPlugin :: Plugin
147    -- ^ the actual callable plugin
148  , paArguments :: [CommandLineOption]
149    -- ^ command line arguments for the plugin
150  }
151
152-- | A plugin with its arguments. The result of loading the plugin.
153data LoadedPlugin = LoadedPlugin
154  { lpPlugin :: PluginWithArgs
155  -- ^ the actual plugin together with its commandline arguments
156  , lpModule :: ModIface
157  -- ^ the module containing the plugin
158  }
159
160-- | A static plugin with its arguments. For registering compiled-in plugins
161-- through the GHC API.
162data StaticPlugin = StaticPlugin
163  { spPlugin :: PluginWithArgs
164  -- ^ the actual plugin together with its commandline arguments
165  }
166
167lpModuleName :: LoadedPlugin -> ModuleName
168lpModuleName = moduleName . mi_module . lpModule
169
170pluginRecompile' :: PluginWithArgs -> IO PluginRecompile
171pluginRecompile' (PluginWithArgs plugin args) = pluginRecompile plugin args
172
173data PluginRecompile = ForceRecompile | NoForceRecompile | MaybeRecompile Fingerprint
174
175instance Outputable PluginRecompile where
176  ppr ForceRecompile = text "ForceRecompile"
177  ppr NoForceRecompile = text "NoForceRecompile"
178  ppr (MaybeRecompile fp) = text "MaybeRecompile" <+> ppr fp
179
180instance Semigroup PluginRecompile where
181  ForceRecompile <> _ = ForceRecompile
182  NoForceRecompile <> r = r
183  MaybeRecompile fp <> NoForceRecompile   = MaybeRecompile fp
184  MaybeRecompile fp <> MaybeRecompile fp' = MaybeRecompile (fingerprintFingerprints [fp, fp'])
185  MaybeRecompile _fp <> ForceRecompile     = ForceRecompile
186
187instance Monoid PluginRecompile where
188  mempty = NoForceRecompile
189
190type CorePlugin = [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
191type TcPlugin = [CommandLineOption] -> Maybe TcRnTypes.TcPlugin
192type HoleFitPlugin = [CommandLineOption] -> Maybe HoleFitPluginR
193
194purePlugin, impurePlugin, flagRecompile :: [CommandLineOption] -> IO PluginRecompile
195purePlugin _args = return NoForceRecompile
196
197impurePlugin _args = return ForceRecompile
198
199flagRecompile =
200  return . MaybeRecompile . fingerprintFingerprints . map fingerprintString . sort
201
202-- | Default plugin: does nothing at all, except for marking that safe
203-- inference has failed unless @-fplugin-trustworthy@ is passed. For
204-- compatibility reaso you should base all your plugin definitions on this
205-- default value.
206defaultPlugin :: Plugin
207defaultPlugin = Plugin {
208        installCoreToDos      = const return
209      , tcPlugin              = const Nothing
210      , holeFitPlugin         = const Nothing
211      , dynflagsPlugin        = const return
212      , pluginRecompile       = impurePlugin
213      , renamedResultAction   = \_ env grp -> return (env, grp)
214      , parsedResultAction    = \_ _ -> return
215      , typeCheckResultAction = \_ _ -> return
216      , spliceRunAction       = \_ -> return
217      , interfaceLoadAction   = \_ -> return
218    }
219
220
221-- | A renamer plugin which mades the renamed source available in
222-- a typechecker plugin.
223keepRenamedSource :: [CommandLineOption] -> TcGblEnv
224                  -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
225keepRenamedSource _ gbl_env group =
226  return (gbl_env { tcg_rn_decls = update (tcg_rn_decls gbl_env)
227                  , tcg_rn_exports = update_exports (tcg_rn_exports gbl_env) }, group)
228  where
229    update_exports Nothing = Just []
230    update_exports m = m
231
232    update Nothing = Just emptyRnGroup
233    update m       = m
234
235
236type PluginOperation m a = Plugin -> [CommandLineOption] -> a -> m a
237type ConstPluginOperation m a = Plugin -> [CommandLineOption] -> a -> m ()
238
239plugins :: DynFlags -> [PluginWithArgs]
240plugins df =
241  map lpPlugin (cachedPlugins df) ++
242  map spPlugin (staticPlugins df)
243
244-- | Perform an operation by using all of the plugins in turn.
245withPlugins :: Monad m => DynFlags -> PluginOperation m a -> a -> m a
246withPlugins df transformation input = foldM go input (plugins df)
247  where
248    go arg (PluginWithArgs p opts) = transformation p opts arg
249
250mapPlugins :: DynFlags -> (Plugin -> [CommandLineOption] -> a) -> [a]
251mapPlugins df f = map (\(PluginWithArgs p opts) -> f p opts) (plugins df)
252
253-- | Perform a constant operation by using all of the plugins in turn.
254withPlugins_ :: Monad m => DynFlags -> ConstPluginOperation m a -> a -> m ()
255withPlugins_ df transformation input
256  = mapM_ (\(PluginWithArgs p opts) -> transformation p opts input)
257          (plugins df)
258
259type FrontendPluginAction = [String] -> [(String, Maybe Phase)] -> Ghc ()
260data FrontendPlugin = FrontendPlugin {
261      frontend :: FrontendPluginAction
262    }
263defaultFrontendPlugin :: FrontendPlugin
264defaultFrontendPlugin = FrontendPlugin { frontend = \_ _ -> return () }
265