{-# LANGUAGE ScopedTypeVariables, CPP #-}
-- | These functions are for conveniently implementing the simple CLI
module HIE.Bios.Ghc.Api (
    initializeFlagsWithCradle
  , initializeFlagsWithCradleWithMessage
  , G.SuccessFlag(..)
  , withDynFlags
  -- For test purposes
  , initSessionWithMessage
  ) where

import GHC (LoadHowMuch(..), DynFlags, GhcMonad)
import qualified GHC as G

#if __GLASGOW_HASKELL__ >= 900
import qualified GHC.Driver.Main as G
import qualified GHC.Driver.Make as G
#else
import qualified HscMain as G
import qualified GhcMake as G
#endif

import qualified HIE.Bios.Ghc.Gap as Gap
import Control.Monad (void)
import Control.Monad.IO.Class
import Colog.Core (LogAction (..), WithSeverity (..))
import HIE.Bios.Types
import HIE.Bios.Environment
import HIE.Bios.Flags

----------------------------------------------------------------

-- | Initialize a GHC session by loading a given file into a given cradle.
initializeFlagsWithCradle ::
    GhcMonad m
    => LogAction IO (WithSeverity Log)
    -> FilePath -- ^ The file we are loading the 'Cradle' because of
    -> Cradle a   -- ^ The cradle we want to load
    -> m (CradleLoadResult (m G.SuccessFlag, ComponentOptions))
initializeFlagsWithCradle :: forall (m :: * -> *) a.
GhcMonad m =>
LogAction IO (WithSeverity Log)
-> FilePath
-> Cradle a
-> m (CradleLoadResult (m SuccessFlag, ComponentOptions))
initializeFlagsWithCradle LogAction IO (WithSeverity Log)
l = forall (m :: * -> *) a.
GhcMonad m =>
LogAction IO (WithSeverity Log)
-> Maybe Messager
-> FilePath
-> Cradle a
-> m (CradleLoadResult (m SuccessFlag, ComponentOptions))
initializeFlagsWithCradleWithMessage LogAction IO (WithSeverity Log)
l (forall a. a -> Maybe a
Just Messager
Gap.batchMsg)

-- | The same as 'initializeFlagsWithCradle' but with an additional argument to control
-- how the loading progress messages are displayed to the user. In @haskell-ide-engine@
-- the module loading progress is displayed in the UI by using a progress notification.
initializeFlagsWithCradleWithMessage ::
  GhcMonad m
  => LogAction IO (WithSeverity Log)
  -> Maybe G.Messager
  -> FilePath -- ^ The file we are loading the 'Cradle' because of
  -> Cradle a  -- ^ The cradle we want to load
  -> m (CradleLoadResult (m G.SuccessFlag, ComponentOptions)) -- ^ Whether we actually loaded the cradle or not.
initializeFlagsWithCradleWithMessage :: forall (m :: * -> *) a.
GhcMonad m =>
LogAction IO (WithSeverity Log)
-> Maybe Messager
-> FilePath
-> Cradle a
-> m (CradleLoadResult (m SuccessFlag, ComponentOptions))
initializeFlagsWithCradleWithMessage LogAction IO (WithSeverity Log)
l Maybe Messager
msg FilePath
fp Cradle a
cradle =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *).
GhcMonad m =>
Maybe Messager
-> ComponentOptions -> (m SuccessFlag, ComponentOptions)
initSessionWithMessage Maybe Messager
msg) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a.
LogAction IO (WithSeverity Log)
-> FilePath -> Cradle a -> IO (CradleLoadResult ComponentOptions)
getCompilerOptions LogAction IO (WithSeverity Log)
l FilePath
fp Cradle a
cradle)

-- | Actually perform the initialisation of the session. Initialising the session corresponds to
-- parsing the command line flags, setting the targets for the session and then attempting to load
-- all the targets.
initSessionWithMessage :: (GhcMonad m)
            => Maybe G.Messager
            -> ComponentOptions
            -> (m G.SuccessFlag, ComponentOptions)
initSessionWithMessage :: forall (m :: * -> *).
GhcMonad m =>
Maybe Messager
-> ComponentOptions -> (m SuccessFlag, ComponentOptions)
initSessionWithMessage Maybe Messager
msg ComponentOptions
compOpts = (do
    [Target]
targets <- forall (m :: * -> *). GhcMonad m => ComponentOptions -> m [Target]
initSession ComponentOptions
compOpts
    forall (m :: * -> *). GhcMonad m => [Target] -> m ()
G.setTargets [Target]
targets
    -- Get the module graph using the function `getModuleGraph`
    ModuleGraph
mod_graph <- forall (m :: * -> *).
GhcMonad m =>
[ModuleName] -> Bool -> m ModuleGraph
G.depanal [] Bool
True
    forall (m :: * -> *) a.
GhcMonad m =>
a -> LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag
Gap.load' forall a. Maybe a
Nothing LoadHowMuch
LoadAllTargets Maybe Messager
msg ModuleGraph
mod_graph, ComponentOptions
compOpts)

----------------------------------------------------------------

withDynFlags ::
  (GhcMonad m)
  => (DynFlags -> DynFlags) -> m a -> m a
withDynFlags :: forall (m :: * -> *) a.
GhcMonad m =>
(DynFlags -> DynFlags) -> m a -> m a
withDynFlags DynFlags -> DynFlags
setFlag m a
body = forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
Gap.bracket m DynFlags
setup DynFlags -> m ()
teardown (\DynFlags
_ -> m a
body)
  where
    setup :: m DynFlags
setup = do
        DynFlags
dflag <- forall (m :: * -> *). GhcMonad m => m DynFlags
G.getSessionDynFlags
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
G.setSessionDynFlags (DynFlags -> DynFlags
setFlag DynFlags
dflag)
        forall (m :: * -> *) a. Monad m => a -> m a
return DynFlags
dflag
    teardown :: DynFlags -> m ()
teardown = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
G.setSessionDynFlags

----------------------------------------------------------------