{-# LANGUAGE CPP #-}
module Development.IDE.GHC.Compat.Plugins (
Plugin(..),
defaultPlugin,
PluginWithArgs(..),
applyPluginsParsedResultAction,
initializePlugins,
initPlugins,
StaticPlugin(..),
hsc_static_plugins,
PsMessages(..),
getPsMessages
) where
import Development.IDE.GHC.Compat.Core
import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags)
import Development.IDE.GHC.Compat.Parser as Parser
import qualified GHC.Driver.Env as Env
import GHC.Driver.Plugins (Plugin (..),
PluginWithArgs (..),
StaticPlugin (..),
defaultPlugin,
withPlugins)
import qualified GHC.Runtime.Loader as Loader
#if !MIN_VERSION_ghc(9,3,0)
import Data.Bifunctor (bimap)
import Development.IDE.GHC.Compat.Outputable as Out
import Development.IDE.GHC.Compat.Util (Bag)
#endif
#if MIN_VERSION_ghc(9,3,0)
import GHC.Driver.Plugins (ParsedResult (..),
PsMessages (..),
staticPlugins)
import qualified GHC.Parser.Lexer as Lexer
#endif
#if !MIN_VERSION_ghc(9,3,0)
type PsMessages = (Bag WarnMsg, Bag ErrMsg)
#endif
getPsMessages :: PState -> PsMessages
getPsMessages :: PState -> PsMessages
getPsMessages PState
pst =
#if MIN_VERSION_ghc(9,3,0)
(Messages PsMessage -> Messages PsMessage -> PsMessages)
-> (Messages PsMessage, Messages PsMessage) -> PsMessages
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Messages PsMessage -> Messages PsMessage -> PsMessages
PsMessages ((Messages PsMessage, Messages PsMessage) -> PsMessages)
-> (Messages PsMessage, Messages PsMessage) -> PsMessages
forall a b. (a -> b) -> a -> b
$ PState -> (Messages PsMessage, Messages PsMessage)
Lexer.getPsMessages PState
pst
#else
bimap (fmap pprWarning) (fmap pprError) $ getMessages pst
#endif
applyPluginsParsedResultAction :: HscEnv -> ModSummary -> Parser.ApiAnns -> ParsedSource -> PsMessages -> IO (ParsedSource, PsMessages)
applyPluginsParsedResultAction :: HscEnv
-> ModSummary
-> ApiAnns
-> ParsedSource
-> PsMessages
-> IO (ParsedSource, PsMessages)
applyPluginsParsedResultAction HscEnv
env ModSummary
ms ApiAnns
hpm_annotations ParsedSource
parsed PsMessages
msgs = do
let applyPluginAction :: Plugin -> [CommandLineOption] -> ParsedResult -> Hsc ParsedResult
applyPluginAction Plugin
p [CommandLineOption]
opts = Plugin
-> [CommandLineOption]
-> ModSummary
-> ParsedResult
-> Hsc ParsedResult
parsedResultAction Plugin
p [CommandLineOption]
opts ModSummary
ms
#if MIN_VERSION_ghc(9,3,0)
(ParsedResult -> (ParsedSource, PsMessages))
-> IO ParsedResult -> IO (ParsedSource, PsMessages)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ParsedResult
result -> (HsParsedModule -> ParsedSource
hpm_module (ParsedResult -> HsParsedModule
parsedResultModule ParsedResult
result), (ParsedResult -> PsMessages
parsedResultMessages ParsedResult
result))) (IO ParsedResult -> IO (ParsedSource, PsMessages))
-> IO ParsedResult -> IO (ParsedSource, PsMessages)
forall a b. (a -> b) -> a -> b
$ HscEnv -> Hsc ParsedResult -> IO ParsedResult
forall a. HscEnv -> Hsc a -> IO a
runHsc HscEnv
env (Hsc ParsedResult -> IO ParsedResult)
-> Hsc ParsedResult -> IO ParsedResult
forall a b. (a -> b) -> a -> b
$ Plugins
-> (Plugin
-> [CommandLineOption] -> ParsedResult -> Hsc ParsedResult)
-> ParsedResult
-> Hsc ParsedResult
forall (m :: * -> *) a.
Monad m =>
Plugins -> PluginOperation m a -> a -> m a
withPlugins
#else
fmap (\parsed_module -> (hpm_module parsed_module, msgs)) $ runHsc env $ withPlugins
#endif
#if MIN_VERSION_ghc(9,3,0)
(HscEnv -> Plugins
Env.hsc_plugins HscEnv
env)
#else
env
#endif
Plugin -> [CommandLineOption] -> ParsedResult -> Hsc ParsedResult
applyPluginAction
#if MIN_VERSION_ghc(9,3,0)
(HsParsedModule -> PsMessages -> ParsedResult
ParsedResult (ParsedSource -> [CommandLineOption] -> ApiAnns -> HsParsedModule
HsParsedModule ParsedSource
parsed [] ApiAnns
hpm_annotations) PsMessages
msgs)
#else
(HsParsedModule parsed [] hpm_annotations)
#endif
initializePlugins :: HscEnv -> IO HscEnv
initializePlugins :: HscEnv -> IO HscEnv
initializePlugins HscEnv
env = do
HscEnv -> IO HscEnv
Loader.initializePlugins HscEnv
env
initPlugins :: HscEnv -> ModSummary -> IO (ModSummary, HscEnv)
initPlugins :: HscEnv -> ModSummary -> IO (ModSummary, HscEnv)
initPlugins HscEnv
session ModSummary
modSummary = do
HscEnv
session1 <- HscEnv -> IO HscEnv
initializePlugins (DynFlags -> HscEnv -> HscEnv
hscSetFlags (ModSummary -> DynFlags
ms_hspp_opts ModSummary
modSummary) HscEnv
session)
(ModSummary, HscEnv) -> IO (ModSummary, HscEnv)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModSummary
modSummary{ms_hspp_opts = hsc_dflags session1}, HscEnv
session1)
hsc_static_plugins :: HscEnv -> [StaticPlugin]
#if MIN_VERSION_ghc(9,3,0)
hsc_static_plugins :: HscEnv -> [StaticPlugin]
hsc_static_plugins = Plugins -> [StaticPlugin]
staticPlugins (Plugins -> [StaticPlugin])
-> (HscEnv -> Plugins) -> HscEnv -> [StaticPlugin]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> Plugins
Env.hsc_plugins
#else
hsc_static_plugins = Env.hsc_static_plugins
#endif