{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
-- | Convenience functions for loading a file into a GHC API session
module HIE.Bios.Ghc.Load ( loadFileWithMessage, loadFile, setTargetFiles, setTargetFilesWithMessage, Log (..)) where


import Colog.Core (LogAction (..), WithSeverity (..), Severity (..), (<&))
import Control.Monad (forM, void)
import Control.Monad.IO.Class

import Data.List
import Data.Time.Clock
import Data.Text.Prettyprint.Doc
import Data.IORef

import GHC
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 GhcMake as G
import qualified HscMain as G
#endif

import qualified HIE.Bios.Ghc.Gap as Gap

data Log =
  LogLoaded FilePath FilePath
  | LogTypechecked [TypecheckedModule]
  | LogInitPlugins Int [ModuleName]
  | LogSetTargets [(FilePath, FilePath)]
  | LogModGraph ModuleGraph

instance Pretty Log where
  pretty :: Log -> Doc ann
pretty (LogLoaded FilePath
fp1 FilePath
fp2) = Doc ann
"Loaded" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> FilePath -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow FilePath
fp1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> FilePath -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow FilePath
fp2
  pretty (LogTypechecked [TypecheckedModule]
tcs) = Doc ann
"Typechecked modules for:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
cat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (TypecheckedModule -> Doc ann) -> [TypecheckedModule] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe FilePath -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow (Maybe FilePath -> Doc ann)
-> (TypecheckedModule -> Maybe FilePath)
-> TypecheckedModule
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypecheckedModule -> Maybe FilePath
get_fp) [TypecheckedModule]
tcs)
  pretty (LogInitPlugins Int
n [ModuleName]
ns) = Doc ann
"Loaded" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Int
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"plugins, specified" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow ([ModuleName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModuleName]
ns)
  pretty (LogSetTargets [(FilePath, FilePath)]
ts) = Doc ann
"Set targets:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [(FilePath, FilePath)] -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow [(FilePath, FilePath)]
ts
  pretty (LogModGraph ModuleGraph
mod_graph) = Doc ann
"ModGraph:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [ModLocation] -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow ((ModSummary -> ModLocation) -> [ModSummary] -> [ModLocation]
forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> ModLocation
ms_location ([ModSummary] -> [ModLocation]) -> [ModSummary] -> [ModLocation]
forall a b. (a -> b) -> a -> b
$ ModuleGraph -> [ModSummary]
Gap.mgModSummaries ModuleGraph
mod_graph)

get_fp :: TypecheckedModule -> Maybe FilePath
get_fp :: TypecheckedModule -> Maybe FilePath
get_fp = ModLocation -> Maybe FilePath
ml_hs_file (ModLocation -> Maybe FilePath)
-> (TypecheckedModule -> ModLocation)
-> TypecheckedModule
-> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> ModLocation
ms_location (ModSummary -> ModLocation)
-> (TypecheckedModule -> ModSummary)
-> TypecheckedModule
-> ModLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary (ParsedModule -> ModSummary)
-> (TypecheckedModule -> ParsedModule)
-> TypecheckedModule
-> ModSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypecheckedModule -> ParsedModule
tm_parsed_module

-- | Load a target into the GHC session.
--
-- The target is represented as a tuple. The tuple consists of the
-- original filename and another file that contains the actual
-- source code to compile.
--
-- The optional messager can be used to log diagnostics, warnings or errors
-- that occurred during loading the target.
--
-- If the loading succeeds, the typechecked module is returned
-- together with all the typechecked modules that had to be loaded
-- in order to typecheck the given target.
loadFileWithMessage :: GhcMonad m
         => LogAction IO (WithSeverity Log)
         -> Maybe G.Messager -- ^ Optional messager hook
                             -- to log messages produced by GHC.
         -> (FilePath, FilePath)  -- ^ Target file to load.
         -> m (Maybe TypecheckedModule, [TypecheckedModule])
         -- ^ Typechecked module and modules that had to
         -- be loaded for the target.
loadFileWithMessage :: LogAction IO (WithSeverity Log)
-> Maybe Messager
-> (FilePath, FilePath)
-> m (Maybe TypecheckedModule, [TypecheckedModule])
loadFileWithMessage LogAction IO (WithSeverity Log)
logger Maybe Messager
msg (FilePath, FilePath)
file = do
  -- STEP 1: Load the file into the session, using collectASTs to also retrieve
  -- typechecked and parsed modules.
  (()
_, [TypecheckedModule]
tcs) <- LogAction IO (WithSeverity Log)
-> m () -> m ((), [TypecheckedModule])
forall (m :: * -> *) a.
GhcMonad m =>
LogAction IO (WithSeverity Log)
-> m a -> m (a, [TypecheckedModule])
collectASTs LogAction IO (WithSeverity Log)
logger (m () -> m ((), [TypecheckedModule]))
-> m () -> m ((), [TypecheckedModule])
forall a b. (a -> b) -> a -> b
$ (LogAction IO (WithSeverity Log)
-> Maybe Messager -> [(FilePath, FilePath)] -> m ()
forall (m :: * -> *).
GhcMonad m =>
LogAction IO (WithSeverity Log)
-> Maybe Messager -> [(FilePath, FilePath)] -> m ()
setTargetFilesWithMessage LogAction IO (WithSeverity Log)
logger Maybe Messager
msg [(FilePath, FilePath)
file])
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LogAction IO (WithSeverity Log)
logger LogAction IO (WithSeverity Log) -> WithSeverity Log -> IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& FilePath -> FilePath -> Log
LogLoaded ((FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst (FilePath, FilePath)
file) ((FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (FilePath, FilePath)
file) Log -> Severity -> WithSeverity Log
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Debug
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LogAction IO (WithSeverity Log)
logger LogAction IO (WithSeverity Log) -> WithSeverity Log -> IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& [TypecheckedModule] -> Log
LogTypechecked [TypecheckedModule]
tcs Log -> Severity -> WithSeverity Log
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Debug
  -- Find the specific module in the list of returned typechecked modules if it exists.
  let findMod :: [TypecheckedModule] -> Maybe TypecheckedModule
findMod [] = Maybe TypecheckedModule
forall a. Maybe a
Nothing
      findMod (TypecheckedModule
x:[TypecheckedModule]
xs) = case TypecheckedModule -> Maybe FilePath
get_fp TypecheckedModule
x of
                         Just FilePath
fp -> if FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` ((FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (FilePath, FilePath)
file) then TypecheckedModule -> Maybe TypecheckedModule
forall a. a -> Maybe a
Just TypecheckedModule
x else [TypecheckedModule] -> Maybe TypecheckedModule
findMod [TypecheckedModule]
xs
                         Maybe FilePath
Nothing -> [TypecheckedModule] -> Maybe TypecheckedModule
findMod [TypecheckedModule]
xs
  (Maybe TypecheckedModule, [TypecheckedModule])
-> m (Maybe TypecheckedModule, [TypecheckedModule])
forall (m :: * -> *) a. Monad m => a -> m a
return ([TypecheckedModule] -> Maybe TypecheckedModule
findMod [TypecheckedModule]
tcs, [TypecheckedModule]
tcs)

-- | Load a target into the GHC session with the default messager
--  which outputs updates in the same format as normal GHC.
--
-- The target is represented as a tuple. The tuple consists of the
-- original filename and another file that contains the actual
-- source code to compile.
--
-- If the message should configured, use 'loadFileWithMessage'.
--
-- If the loading succeeds, the typechecked module is returned
-- together with all the typechecked modules that had to be loaded
-- in order to typecheck the given target.
loadFile :: (GhcMonad m)
         => LogAction IO (WithSeverity Log)
         -> (FilePath, FilePath) -- ^ Target file to load.
         -> m (Maybe TypecheckedModule, [TypecheckedModule])
         -- ^ Typechecked module and modules that had to
         -- be loaded for the target.
loadFile :: LogAction IO (WithSeverity Log)
-> (FilePath, FilePath)
-> m (Maybe TypecheckedModule, [TypecheckedModule])
loadFile LogAction IO (WithSeverity Log)
logger = LogAction IO (WithSeverity Log)
-> Maybe Messager
-> (FilePath, FilePath)
-> m (Maybe TypecheckedModule, [TypecheckedModule])
forall (m :: * -> *).
GhcMonad m =>
LogAction IO (WithSeverity Log)
-> Maybe Messager
-> (FilePath, FilePath)
-> m (Maybe TypecheckedModule, [TypecheckedModule])
loadFileWithMessage LogAction IO (WithSeverity Log)
logger (Messager -> Maybe Messager
forall a. a -> Maybe a
Just Messager
G.batchMsg)


-- | Set the files as targets and load them. This will reset GHC's targets so only the modules you
-- set as targets and its dependencies will be loaded or reloaded.
-- Produced diagnostics will be printed similar to the normal output of GHC.
-- To configure this, use 'setTargetFilesWithMessage'.
setTargetFiles
  :: GhcMonad m
  => LogAction IO (WithSeverity Log)
  -> [(FilePath, FilePath)]
  -> m ()
setTargetFiles :: LogAction IO (WithSeverity Log) -> [(FilePath, FilePath)] -> m ()
setTargetFiles LogAction IO (WithSeverity Log)
logger = LogAction IO (WithSeverity Log)
-> Maybe Messager -> [(FilePath, FilePath)] -> m ()
forall (m :: * -> *).
GhcMonad m =>
LogAction IO (WithSeverity Log)
-> Maybe Messager -> [(FilePath, FilePath)] -> m ()
setTargetFilesWithMessage LogAction IO (WithSeverity Log)
logger (Messager -> Maybe Messager
forall a. a -> Maybe a
Just Messager
G.batchMsg)

msTargetIs :: ModSummary -> Target -> Bool
msTargetIs :: ModSummary -> Target -> Bool
msTargetIs ModSummary
ms Target
t = case Target -> TargetId
targetId Target
t of
  TargetModule ModuleName
m -> Module -> ModuleName
moduleName (ModSummary -> Module
ms_mod ModSummary
ms) ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
m
  TargetFile FilePath
f Maybe Phase
_ -> ModLocation -> Maybe FilePath
ml_hs_file (ModSummary -> ModLocation
ms_location ModSummary
ms) Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f

-- | We bump the times for any ModSummary's that are Targets, to
-- fool the recompilation checker so that we can get the typechecked modules
updateTime :: MonadIO m => [Target] -> ModuleGraph -> m ModuleGraph
updateTime :: [Target] -> ModuleGraph -> m ModuleGraph
updateTime [Target]
ts ModuleGraph
graph = IO ModuleGraph -> m ModuleGraph
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ModuleGraph -> m ModuleGraph)
-> IO ModuleGraph -> m ModuleGraph
forall a b. (a -> b) -> a -> b
$ do
  UTCTime
cur_time <- IO UTCTime
getCurrentTime
  let go :: ModSummary -> ModSummary
go ModSummary
ms
        | (Target -> Bool) -> [Target] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ModSummary -> Target -> Bool
msTargetIs ModSummary
ms) [Target]
ts = ModSummary
ms {ms_hs_date :: UTCTime
ms_hs_date = UTCTime
cur_time}
        | Bool
otherwise = ModSummary
ms
  ModuleGraph -> IO ModuleGraph
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleGraph -> IO ModuleGraph) -> ModuleGraph -> IO ModuleGraph
forall a b. (a -> b) -> a -> b
$ (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
Gap.mapMG ModSummary -> ModSummary
go ModuleGraph
graph

-- | Set the files as targets and load them. This will reset GHC's targets so only the modules you
-- set as targets and its dependencies will be loaded or reloaded.
setTargetFilesWithMessage
  :: (GhcMonad m)
  => LogAction IO (WithSeverity Log)
  -> Maybe G.Messager
  -> [(FilePath, FilePath)]
  -> m ()
setTargetFilesWithMessage :: LogAction IO (WithSeverity Log)
-> Maybe Messager -> [(FilePath, FilePath)] -> m ()
setTargetFilesWithMessage LogAction IO (WithSeverity Log)
logger Maybe Messager
msg [(FilePath, FilePath)]
files = do
    [Target]
targets <- [(FilePath, FilePath)]
-> ((FilePath, FilePath) -> m Target) -> m [Target]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(FilePath, FilePath)]
files (FilePath, FilePath) -> m Target
forall (m :: * -> *).
GhcMonad m =>
(FilePath, FilePath) -> m Target
guessTargetMapped
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LogAction IO (WithSeverity Log)
logger LogAction IO (WithSeverity Log) -> WithSeverity Log -> IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& [(FilePath, FilePath)] -> Log
LogSetTargets [(FilePath, FilePath)]
files Log -> Severity -> WithSeverity Log
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Debug
    [Target] -> m ()
forall (m :: * -> *). GhcMonad m => [Target] -> m ()
G.setTargets [Target]
targets
    ModuleGraph
mod_graph <- [Target] -> ModuleGraph -> m ModuleGraph
forall (m :: * -> *).
MonadIO m =>
[Target] -> ModuleGraph -> m ModuleGraph
updateTime [Target]
targets (ModuleGraph -> m ModuleGraph) -> m ModuleGraph -> m ModuleGraph
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ModuleName] -> Bool -> m ModuleGraph
forall (m :: * -> *).
GhcMonad m =>
[ModuleName] -> Bool -> m ModuleGraph
depanal [] Bool
False
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LogAction IO (WithSeverity Log)
logger LogAction IO (WithSeverity Log) -> WithSeverity Log -> IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& ModuleGraph -> Log
LogModGraph ModuleGraph
mod_graph Log -> Severity -> WithSeverity Log
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Debug
    m SuccessFlag -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m SuccessFlag -> m ()) -> m SuccessFlag -> m ()
forall a b. (a -> b) -> a -> b
$ LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag
forall (m :: * -> *).
GhcMonad m =>
LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag
G.load' LoadHowMuch
LoadAllTargets Maybe Messager
msg ModuleGraph
mod_graph

-- | Add a hook to record the contents of any 'TypecheckedModule's which are produced
-- during compilation.
collectASTs
  :: (GhcMonad m)
  => LogAction IO (WithSeverity Log)
  -> m a
  -> m (a, [TypecheckedModule])
collectASTs :: LogAction IO (WithSeverity Log)
-> m a -> m (a, [TypecheckedModule])
collectASTs LogAction IO (WithSeverity Log)
logger m a
action = do
  IORef [TypecheckedModule]
ref1 <- IO (IORef [TypecheckedModule]) -> m (IORef [TypecheckedModule])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [TypecheckedModule]) -> m (IORef [TypecheckedModule]))
-> IO (IORef [TypecheckedModule]) -> m (IORef [TypecheckedModule])
forall a b. (a -> b) -> a -> b
$ [TypecheckedModule] -> IO (IORef [TypecheckedModule])
forall a. a -> IO (IORef a)
newIORef []
  -- Modify session is much faster than `setSessionDynFlags`.
  (HscEnv -> HscEnv) -> m ()
forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
Gap.modifySession ((HscEnv -> HscEnv) -> m ()) -> (HscEnv -> HscEnv) -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (ModSummary -> Hsc FrontendResult) -> HscEnv -> HscEnv
Gap.setFrontEndHooks ((ModSummary -> Hsc FrontendResult)
-> Maybe (ModSummary -> Hsc FrontendResult)
forall a. a -> Maybe a
Just (LogAction IO (WithSeverity Log)
-> IORef [TypecheckedModule] -> ModSummary -> Hsc FrontendResult
astHook LogAction IO (WithSeverity Log)
logger IORef [TypecheckedModule]
ref1))
  a
res <- m a
action
  [TypecheckedModule]
tcs <- IO [TypecheckedModule] -> m [TypecheckedModule]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TypecheckedModule] -> m [TypecheckedModule])
-> IO [TypecheckedModule] -> m [TypecheckedModule]
forall a b. (a -> b) -> a -> b
$ IORef [TypecheckedModule] -> IO [TypecheckedModule]
forall a. IORef a -> IO a
readIORef IORef [TypecheckedModule]
ref1
  -- Unset the hook so that we don't retain the reference to the IORef so it can be GCed.
  -- This stops the typechecked modules being retained in some cases.
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef [TypecheckedModule] -> [TypecheckedModule] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [TypecheckedModule]
ref1 []
  (HscEnv -> HscEnv) -> m ()
forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
Gap.modifySession ((HscEnv -> HscEnv) -> m ()) -> (HscEnv -> HscEnv) -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (ModSummary -> Hsc FrontendResult) -> HscEnv -> HscEnv
Gap.setFrontEndHooks Maybe (ModSummary -> Hsc FrontendResult)
forall a. Maybe a
Nothing

  (a, [TypecheckedModule]) -> m (a, [TypecheckedModule])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
res, [TypecheckedModule]
tcs)

-- | This hook overwrites the default frontend action of GHC.
astHook
  :: LogAction IO (WithSeverity Log)
  -> IORef [TypecheckedModule]
  -> ModSummary
  -> Gap.Hsc Gap.FrontendResult
astHook :: LogAction IO (WithSeverity Log)
-> IORef [TypecheckedModule] -> ModSummary -> Hsc FrontendResult
astHook LogAction IO (WithSeverity Log)
logger IORef [TypecheckedModule]
tc_ref ModSummary
ms = Ghc FrontendResult -> Hsc FrontendResult
forall a. Ghc a -> Hsc a
ghcInHsc (Ghc FrontendResult -> Hsc FrontendResult)
-> Ghc FrontendResult -> Hsc FrontendResult
forall a b. (a -> b) -> a -> b
$ do
  ParsedModule
p <- ModSummary -> Ghc ParsedModule
forall (m :: * -> *). GhcMonad m => ModSummary -> m ParsedModule
G.parseModule (ModSummary -> Ghc ParsedModule)
-> Ghc ModSummary -> Ghc ParsedModule
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LogAction IO (WithSeverity Log) -> ModSummary -> Ghc ModSummary
forall (m :: * -> *).
GhcMonad m =>
LogAction IO (WithSeverity Log) -> ModSummary -> m ModSummary
initializePluginsGhc LogAction IO (WithSeverity Log)
logger ModSummary
ms
  TypecheckedModule
tcm <- ParsedModule -> Ghc TypecheckedModule
forall (m :: * -> *).
GhcMonad m =>
ParsedModule -> m TypecheckedModule
G.typecheckModule ParsedModule
p
  let tcg_env :: TcGblEnv
tcg_env = (TcGblEnv, ModDetails) -> TcGblEnv
forall a b. (a, b) -> a
fst (TypecheckedModule -> (TcGblEnv, ModDetails)
tm_internals_ TypecheckedModule
tcm)
  IO () -> Ghc ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ IORef [TypecheckedModule]
-> ([TypecheckedModule] -> [TypecheckedModule]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [TypecheckedModule]
tc_ref (TypecheckedModule
tcm TypecheckedModule -> [TypecheckedModule] -> [TypecheckedModule]
forall a. a -> [a] -> [a]
:)
  FrontendResult -> Ghc FrontendResult
forall (m :: * -> *) a. Monad m => a -> m a
return (FrontendResult -> Ghc FrontendResult)
-> FrontendResult -> Ghc FrontendResult
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> FrontendResult
Gap.FrontendTypecheck TcGblEnv
tcg_env

initializePluginsGhc
  :: GhcMonad m
  => LogAction IO (WithSeverity Log)
  -> ModSummary
  -> m ModSummary
initializePluginsGhc :: LogAction IO (WithSeverity Log) -> ModSummary -> m ModSummary
initializePluginsGhc LogAction IO (WithSeverity Log)
logger ModSummary
ms = do
  HscEnv
hsc_env <- m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
  (Int
pluginsLoaded, [ModuleName]
pluginNames, ModSummary
newMs) <- IO (Int, [ModuleName], ModSummary)
-> m (Int, [ModuleName], ModSummary)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, [ModuleName], ModSummary)
 -> m (Int, [ModuleName], ModSummary))
-> IO (Int, [ModuleName], ModSummary)
-> m (Int, [ModuleName], ModSummary)
forall a b. (a -> b) -> a -> b
$ HscEnv -> ModSummary -> IO (Int, [ModuleName], ModSummary)
Gap.initializePluginsForModSummary HscEnv
hsc_env ModSummary
ms
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LogAction IO (WithSeverity Log)
logger LogAction IO (WithSeverity Log) -> WithSeverity Log -> IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& Int -> [ModuleName] -> Log
LogInitPlugins Int
pluginsLoaded [ModuleName]
pluginNames Log -> Severity -> WithSeverity Log
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Debug
  ModSummary -> m ModSummary
forall (m :: * -> *) a. Monad m => a -> m a
return ModSummary
newMs

ghcInHsc :: Ghc a -> Gap.Hsc a
ghcInHsc :: Ghc a -> Hsc a
ghcInHsc Ghc a
gm = do
  HscEnv
hsc_session <- Hsc HscEnv
Gap.getHscEnv
  IORef HscEnv
session <- IO (IORef HscEnv) -> Hsc (IORef HscEnv)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef HscEnv) -> Hsc (IORef HscEnv))
-> IO (IORef HscEnv) -> Hsc (IORef HscEnv)
forall a b. (a -> b) -> a -> b
$ HscEnv -> IO (IORef HscEnv)
forall a. a -> IO (IORef a)
newIORef HscEnv
hsc_session
  IO a -> Hsc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Hsc a) -> IO a -> Hsc a
forall a b. (a -> b) -> a -> b
$ Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
Gap.reflectGhc Ghc a
gm (IORef HscEnv -> Session
Gap.Session IORef HscEnv
session)

-- | A variant of 'guessTarget' which after guessing the target for a filepath, overwrites the
-- target file to be a temporary file.
guessTargetMapped :: (GhcMonad m) => (FilePath, FilePath) -> m Target
guessTargetMapped :: (FilePath, FilePath) -> m Target
guessTargetMapped (FilePath
orig_file_name, FilePath
mapped_file_name) = do
  Target
t <- FilePath -> Maybe Phase -> m Target
forall (m :: * -> *).
GhcMonad m =>
FilePath -> Maybe Phase -> m Target
Gap.guessTarget FilePath
orig_file_name Maybe Phase
forall a. Maybe a
Nothing
  Target -> m Target
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Target -> Target
setTargetFilename FilePath
mapped_file_name Target
t)

setTargetFilename :: FilePath -> Target -> Target
setTargetFilename :: FilePath -> Target -> Target
setTargetFilename FilePath
fn Target
t =
  Target
t { targetId :: TargetId
targetId = case Target -> TargetId
targetId Target
t of
                  TargetFile FilePath
_ Maybe Phase
p -> FilePath -> Maybe Phase -> TargetId
TargetFile FilePath
fn Maybe Phase
p
                  TargetId
tid -> TargetId
tid }