content: {-# 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
  