70 lines
2.0 KiB
Haskell
70 lines
2.0 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
|
|
module GhcMod.LightGhc where
|
|
|
|
import Control.Monad
|
|
import Control.Monad.Reader (runReaderT)
|
|
import Data.IORef
|
|
|
|
import GHC
|
|
import GHC.Paths (libdir)
|
|
#if __GLASGOW_HASKELL__ < 802
|
|
import StaticFlags
|
|
#endif
|
|
import SysTools
|
|
import DynFlags
|
|
import HscMain
|
|
import HscTypes
|
|
|
|
import GhcMod.Types
|
|
import GhcMod.Monad.Types
|
|
import GhcMod.DynFlags
|
|
import qualified GhcMod.Gap as Gap
|
|
|
|
#if __GLASGOW_HASKELL__ >= 802
|
|
initStaticOpts :: Monad m => m ()
|
|
initStaticOpts = return ()
|
|
#endif
|
|
|
|
-- We have to be more careful about tearing down 'HscEnv's since GHC 8 added an
|
|
-- out of process GHCI server which has to be shutdown.
|
|
newLightEnv :: IOish m => (DynFlags -> LightGhc DynFlags) -> m HscEnv
|
|
newLightEnv mdf = do
|
|
df <- liftIO $ do
|
|
initStaticOpts
|
|
settings <- initSysTools (Just libdir)
|
|
initDynFlags $ defaultDynFlags settings
|
|
|
|
hsc_env <- liftIO $ newHscEnv df
|
|
df' <- runLightGhc hsc_env $ mdf df
|
|
return $ hsc_env {
|
|
hsc_dflags = df',
|
|
hsc_IC = (hsc_IC hsc_env) { ic_dflags = df' }
|
|
}
|
|
|
|
teardownLightEnv :: MonadIO m => HscEnv -> m ()
|
|
teardownLightEnv env = runLightGhc env $ do
|
|
Gap.withCleanupSession $ return ()
|
|
|
|
withLightHscEnv'
|
|
:: IOish m => (DynFlags -> LightGhc DynFlags) -> (HscEnv -> m a) -> m a
|
|
withLightHscEnv' mdf action = gbracket (newLightEnv mdf) teardownLightEnv action
|
|
|
|
withLightHscEnv :: IOish m => [GHCOption] -> (HscEnv -> m a) -> m a
|
|
withLightHscEnv opts = withLightHscEnv' (f <=< liftIO . newHscEnv)
|
|
where
|
|
f env = runLightGhc env $ do
|
|
-- HomeModuleGraph and probably all other clients get into all sorts of
|
|
-- trouble if the package state isn't initialized here
|
|
_ <- setSessionDynFlags =<< addCmdOpts opts =<< getSessionDynFlags
|
|
getSessionDynFlags
|
|
|
|
runLightGhc :: MonadIO m => HscEnv -> LightGhc a -> m a
|
|
runLightGhc env action = liftIO $ do
|
|
renv <- newIORef env
|
|
flip runReaderT renv $ unLightGhc action
|
|
|
|
runLightGhc' :: MonadIO m => IORef HscEnv -> LightGhc a -> m a
|
|
runLightGhc' renv action = liftIO $ do
|
|
flip runReaderT renv $ unLightGhc action
|