Plugins.hs 2.92 KB
Newer Older
Matthew Pickering's avatar
Matthew Pickering committed
1
{-# LANGUAGE RankNTypes #-}
Adam Gundry's avatar
Adam Gundry committed
2
module Plugins (
3
    FrontendPlugin(..), defaultFrontendPlugin, FrontendPluginAction,
Matthew Pickering's avatar
Matthew Pickering committed
4 5
    Plugin(..), CommandLineOption, LoadedPlugin(..),
    defaultPlugin, withPlugins, withPlugins_
Adam Gundry's avatar
Adam Gundry committed
6 7
    ) where

8 9
import GhcPrelude

Adam Gundry's avatar
Adam Gundry committed
10
import CoreMonad ( CoreToDo, CoreM )
Matthew Pickering's avatar
Matthew Pickering committed
11 12
import TcRnTypes ( TcPlugin)
import DynFlags
Edward Z. Yang's avatar
Edward Z. Yang committed
13 14
import GhcMonad
import DriverPhases
Matthew Pickering's avatar
Matthew Pickering committed
15
import Module ( ModuleName )
Adam Gundry's avatar
Adam Gundry committed
16

Matthew Pickering's avatar
Matthew Pickering committed
17
import Control.Monad
Adam Gundry's avatar
Adam Gundry committed
18 19 20 21 22

-- | Command line options gathered from the -PModule.Name:stuff syntax
-- are given to you as this type
type CommandLineOption = String

Matthew Pickering's avatar
Matthew Pickering committed
23
-- | 'Plugin' is the compiler plugin data type. Try to avoid
Adam Gundry's avatar
Adam Gundry committed
24 25
-- constructing one of these directly, and just modify some fields of
-- 'defaultPlugin' instead: this is to try and preserve source-code
Gabor Greif's avatar
Gabor Greif committed
26
-- compatibility when we add fields to this.
Adam Gundry's avatar
Adam Gundry committed
27 28 29 30 31 32 33 34 35 36 37 38 39 40
--
-- Nonetheless, this API is preliminary and highly likely to change in
-- the future.
data Plugin = Plugin {
    installCoreToDos :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
    -- ^ Modify the Core pipeline that will be used for compilation.
    -- This is called as the Core pipeline is built for every module
    -- being compiled, and plugins get the opportunity to modify the
    -- pipeline in a nondeterministic order.
  , tcPlugin :: [CommandLineOption] -> Maybe TcPlugin
    -- ^ An optional typechecker plugin, which may modify the
    -- behaviour of the constraint solver.
  }

Matthew Pickering's avatar
Matthew Pickering committed
41 42 43 44 45 46 47 48 49 50
-- | A plugin with its arguments. The result of loading the plugin.
data LoadedPlugin = LoadedPlugin {
    lpPlugin :: Plugin
    -- ^ the actual callable plugin
  , lpModuleName :: ModuleName
    -- ^ the qualified name of the module containing the plugin
  , lpArguments :: [CommandLineOption]
    -- ^ command line arguments for the plugin
  }

Gabor Greif's avatar
Gabor Greif committed
51
-- | Default plugin: does nothing at all! For compatibility reasons
Adam Gundry's avatar
Adam Gundry committed
52 53 54 55 56 57
-- you should base all your plugin definitions on this default value.
defaultPlugin :: Plugin
defaultPlugin = Plugin {
        installCoreToDos = const return
      , tcPlugin         = const Nothing
    }
Edward Z. Yang's avatar
Edward Z. Yang committed
58

Matthew Pickering's avatar
Matthew Pickering committed
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
type PluginOperation m a = Plugin -> [CommandLineOption] -> a -> m a
type ConstPluginOperation m a = Plugin -> [CommandLineOption] -> a -> m ()

-- | Perform an operation by using all of the plugins in turn.
withPlugins :: Monad m => DynFlags -> PluginOperation m a -> a -> m a
withPlugins df transformation input
  = foldM (\arg (LoadedPlugin p _ opts) -> transformation p opts arg)
          input (plugins df)

-- | Perform a constant operation by using all of the plugins in turn.
withPlugins_ :: Monad m => DynFlags -> ConstPluginOperation m a -> a -> m ()
withPlugins_ df transformation input
  = mapM_ (\(LoadedPlugin p _ opts) -> transformation p opts input)
          (plugins df)

Edward Z. Yang's avatar
Edward Z. Yang committed
74 75 76 77 78 79
type FrontendPluginAction = [String] -> [(String, Maybe Phase)] -> Ghc ()
data FrontendPlugin = FrontendPlugin {
      frontend :: FrontendPluginAction
    }
defaultFrontendPlugin :: FrontendPlugin
defaultFrontendPlugin = FrontendPlugin { frontend = \_ _ -> return () }