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

import GHC
import qualified GHC as G
import qualified GhcMake as G
import qualified HscMain as G
import HscTypes
import Control.Monad.IO.Class

import Data.IORef

import Hooks
import TcRnTypes (FrontendResult(..))
import Control.Monad (forM, void)
import GhcMonad
import HscMain
import Data.List

import Data.Time.Clock
import qualified HIE.Bios.Ghc.Gap as Gap
import qualified HIE.Bios.Internal.Log as Log

-- | 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
         => 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 :: Maybe Messager
-> (FilePath, FilePath)
-> m (Maybe TypecheckedModule, [TypecheckedModule])
loadFileWithMessage msg :: Maybe Messager
msg file :: (FilePath, FilePath)
file = do
  -- STEP 1: Load the file into the session, using collectASTs to also retrieve
  -- typechecked and parsed modules.
  (_, tcs :: [TypecheckedModule]
tcs) <- m () -> m ((), [TypecheckedModule])
forall (m :: * -> *) a.
GhcMonad m =>
m a -> m (a, [TypecheckedModule])
collectASTs (m () -> m ((), [TypecheckedModule]))
-> m () -> m ((), [TypecheckedModule])
forall a b. (a -> b) -> a -> b
$ (Maybe Messager -> [(FilePath, FilePath)] -> m ()
forall (m :: * -> *).
GhcMonad m =>
Maybe Messager -> [(FilePath, FilePath)] -> m ()
setTargetFilesWithMessage Maybe Messager
msg [(FilePath, FilePath)
file])
  FilePath -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
Log.debugm (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ "loaded " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst (FilePath, FilePath)
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " - " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (FilePath, FilePath)
file
  let 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
  FilePath -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
Log.debugm (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ "Typechecked modules for: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ([FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (TypecheckedModule -> FilePath)
-> [TypecheckedModule] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe FilePath -> FilePath
forall a. Show a => a -> FilePath
show (Maybe FilePath -> FilePath)
-> (TypecheckedModule -> Maybe FilePath)
-> TypecheckedModule
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypecheckedModule -> Maybe FilePath
get_fp) [TypecheckedModule]
tcs)
  -- 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 (x :: TypecheckedModule
x:xs :: [TypecheckedModule]
xs) = case TypecheckedModule -> Maybe FilePath
get_fp TypecheckedModule
x of
                         Just fp :: 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
                         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)
         => (FilePath, FilePath) -- ^ Target file to load.
         -> m (Maybe TypecheckedModule, [TypecheckedModule])
         -- ^ Typechecked module and modules that had to
         -- be loaded for the target.
loadFile :: (FilePath, FilePath)
-> m (Maybe TypecheckedModule, [TypecheckedModule])
loadFile = Maybe Messager
-> (FilePath, FilePath)
-> m (Maybe TypecheckedModule, [TypecheckedModule])
forall (m :: * -> *).
GhcMonad m =>
Maybe Messager
-> (FilePath, FilePath)
-> m (Maybe TypecheckedModule, [TypecheckedModule])
loadFileWithMessage (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 => [(FilePath, FilePath)] -> m ()
setTargetFiles :: [(FilePath, FilePath)] -> m ()
setTargetFiles = Maybe Messager -> [(FilePath, FilePath)] -> m ()
forall (m :: * -> *).
GhcMonad m =>
Maybe Messager -> [(FilePath, FilePath)] -> m ()
setTargetFilesWithMessage (Messager -> Maybe Messager
forall a. a -> Maybe a
Just Messager
G.batchMsg)

msTargetIs :: ModSummary -> Target -> Bool
msTargetIs :: ModSummary -> Target -> Bool
msTargetIs ms :: ModSummary
ms t :: Target
t = case Target -> TargetId
targetId Target
t of
  TargetModule m :: ModuleName
m -> Module -> ModuleName
moduleName (ModSummary -> Module
ms_mod ModSummary
ms) ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
m
  TargetFile f :: FilePath
f _ -> 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 ts :: [Target]
ts graph :: 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 ms :: 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)  => Maybe G.Messager -> [(FilePath, FilePath)] -> m ()
setTargetFilesWithMessage :: Maybe Messager -> [(FilePath, FilePath)] -> m ()
setTargetFilesWithMessage msg :: Maybe Messager
msg files :: [(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
    FilePath -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
Log.debugm (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ "setTargets: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)] -> FilePath
forall a. Show a => a -> FilePath
show [(FilePath, FilePath)]
files
    [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
    FilePath -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
Log.debugm (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ "modGraph: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [ModLocation] -> FilePath
forall a. Show a => a -> FilePath
show ((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)
    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) => m a -> m (a, [TypecheckedModule])
collectASTs :: m a -> m (a, [TypecheckedModule])
collectASTs action :: m a
action = do
  DynFlags
dflags0 <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
  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 []
  let dflags1 :: DynFlags
dflags1 = DynFlags
dflags0 { hooks :: Hooks
hooks = (DynFlags -> Hooks
hooks DynFlags
dflags0)
                          { hscFrontendHook :: Maybe (ModSummary -> Hsc FrontendResult)
hscFrontendHook = (ModSummary -> Hsc FrontendResult)
-> Maybe (ModSummary -> Hsc FrontendResult)
forall a. a -> Maybe a
Just (IORef [TypecheckedModule] -> ModSummary -> Hsc FrontendResult
astHook IORef [TypecheckedModule]
ref1) }
                        }
  -- Modify session is much faster than `setSessionDynFlags`.
  (HscEnv -> HscEnv) -> m ()
forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
modifySession ((HscEnv -> HscEnv) -> m ()) -> (HscEnv -> HscEnv) -> m ()
forall a b. (a -> b) -> a -> b
$ \h :: HscEnv
h -> HscEnv
h{ hsc_dflags :: DynFlags
hsc_dflags = DynFlags
dflags1 }
  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 ot 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 []
  DynFlags
dflags_old <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
  let dflags2 :: DynFlags
dflags2 = DynFlags
dflags1 { hooks :: Hooks
hooks = (DynFlags -> Hooks
hooks DynFlags
dflags_old)
                          { hscFrontendHook :: Maybe (ModSummary -> Hsc FrontendResult)
hscFrontendHook = Maybe (ModSummary -> Hsc FrontendResult)
forall a. Maybe a
Nothing }
                        }
  (HscEnv -> HscEnv) -> m ()
forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
modifySession ((HscEnv -> HscEnv) -> m ()) -> (HscEnv -> HscEnv) -> m ()
forall a b. (a -> b) -> a -> b
$ \h :: HscEnv
h -> HscEnv
h{ hsc_dflags :: DynFlags
hsc_dflags = DynFlags
dflags2 }

  (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 :: IORef [TypecheckedModule] -> ModSummary -> Hsc FrontendResult
astHook :: IORef [TypecheckedModule] -> ModSummary -> Hsc FrontendResult
astHook tc_ref :: IORef [TypecheckedModule]
tc_ref ms :: 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
=<< ModSummary -> Ghc ModSummary
initializePluginsGhc 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
FrontendTypecheck TcGblEnv
tcg_env

initializePluginsGhc :: ModSummary -> Ghc ModSummary
initializePluginsGhc :: ModSummary -> Ghc ModSummary
initializePluginsGhc ms :: ModSummary
ms = do
  HscEnv
hsc_env <- Ghc HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
  DynFlags
df <- IO DynFlags -> Ghc DynFlags
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DynFlags -> Ghc DynFlags) -> IO DynFlags -> Ghc DynFlags
forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags -> IO DynFlags
Gap.initializePlugins HscEnv
hsc_env (ModSummary -> DynFlags
ms_hspp_opts  ModSummary
ms)
  FilePath -> Ghc ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
Log.debugm ("init-plugins(loaded):" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (DynFlags -> Int
Gap.numLoadedPlugins DynFlags
df))
  FilePath -> Ghc ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
Log.debugm ("init-plugins(specified):" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([ModuleName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ModuleName] -> Int) -> [ModuleName] -> Int
forall a b. (a -> b) -> a -> b
$ DynFlags -> [ModuleName]
pluginModNames DynFlags
df))
  ModSummary -> Ghc ModSummary
forall (m :: * -> *) a. Monad m => a -> m a
return (ModSummary
ms { ms_hspp_opts :: DynFlags
ms_hspp_opts = DynFlags
df })


ghcInHsc :: Ghc a -> Hsc a
ghcInHsc :: Ghc a -> Hsc a
ghcInHsc gm :: Ghc a
gm = do
  HscEnv
hsc_session <- Hsc HscEnv
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
reflectGhc Ghc a
gm (IORef HscEnv -> Session
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 (orig_file_name :: FilePath
orig_file_name, mapped_file_name :: FilePath
mapped_file_name) = do
  Target
t <- FilePath -> Maybe Phase -> m Target
forall (m :: * -> *).
GhcMonad m =>
FilePath -> Maybe Phase -> m Target
G.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 fn :: FilePath
fn t :: Target
t =
  Target
t { targetId :: TargetId
targetId = case Target -> TargetId
targetId Target
t of
                  TargetFile _ p :: Maybe Phase
p -> FilePath -> Maybe Phase -> TargetId
TargetFile FilePath
fn Maybe Phase
p
                  tid :: TargetId
tid -> TargetId
tid }