{-# LANGUAGE DerivingStrategies #-}

-- | Initialise the GHC session for one or more home units.
--
-- This code is inspired of HLS's session initialisation.
-- It would be great to extract common functions in the future.
module GHC.Debugger.Session (
  parseHomeUnitArguments,
  setupHomeUnitGraph,
  TargetDetails(..),
  Target(..),
  toGhcTarget,
  )
  where

import Control.Monad
import Control.Monad.IO.Class

import qualified GHC
import GHC.Driver.DynFlags as GHC
import GHC.Driver.Monad
import qualified GHC.Driver.Session as GHC
import GHC.Utils.Monad as GHC
import GHC.Unit.Home.Graph
import GHC.Unit.Home.PackageTable
import GHC.Unit.Env
import GHC.Unit.Types
import qualified GHC.Unit.State                        as State
import GHC.Driver.Env
import GHC.Types.SrcLoc
import Language.Haskell.Syntax.Module.Name

import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import qualified Data.List as L
import qualified Data.Containers.ListUtils as L
import GHC.ResponseFile (expandResponse)
import HIE.Bios.Environment as HIE
import System.FilePath

-- | Throws if package flags are unsatisfiable
parseHomeUnitArguments :: GhcMonad m
    => FilePath -- ^ Main entry point function
    -> FilePath -- ^ Component root. Important for multi-package cabal projects.
    -> [String]
    -> [String] -- ghcInvocation
    -> DynFlags
    -> FilePath -- ^ root dir, see Note [Root Directory]
    -> m (NonEmpty.NonEmpty (DynFlags, [GHC.Target]))
parseHomeUnitArguments :: forall (m :: * -> *).
GhcMonad m =>
FilePath
-> FilePath
-> [FilePath]
-> [FilePath]
-> DynFlags
-> FilePath
-> m (NonEmpty (DynFlags, [Target]))
parseHomeUnitArguments FilePath
cfp FilePath
compRoot [FilePath]
units [FilePath]
theOpts DynFlags
dflags FilePath
rootDir = do
    ((theOpts',_errs,_warns),_units) <- [Flag (CmdLineP [ZonkAny 0])]
-> [ZonkAny 0]
-> [Located FilePath]
-> m (([Located FilePath], [Err], [Warn]), [ZonkAny 0])
forall s (m :: * -> *).
MonadIO m =>
[Flag (CmdLineP s)]
-> s
-> [Located FilePath]
-> m (([Located FilePath], [Err], [Warn]), s)
GHC.processCmdLineP [] [] ((FilePath -> Located FilePath) -> [FilePath] -> [Located FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Located FilePath
forall e. e -> Located e
noLoc [FilePath]
theOpts)
    case NonEmpty.nonEmpty units of
      Just NonEmpty FilePath
us -> NonEmpty FilePath -> m (NonEmpty (DynFlags, [Target]))
forall {t :: * -> *} {m :: * -> *}.
(Traversable t, GhcMonad m) =>
t FilePath -> m (t (DynFlags, [Target]))
initMulti NonEmpty FilePath
us
      Maybe (NonEmpty FilePath)
Nothing -> do
        (df, targets) <- [FilePath] -> m (DynFlags, [Target])
forall {m :: * -> *}.
GhcMonad m =>
[FilePath] -> m (DynFlags, [Target])
initOne ((Located FilePath -> FilePath) -> [Located FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Located FilePath -> FilePath
forall l e. GenLocated l e -> e
unLoc [Located FilePath]
theOpts')
        -- A special target for the file which caused this wonderful
        -- component to be created. In case the cradle doesn't list all the targets for
        -- the component, in which case things will be horribly broken anyway.
        --
        -- When we have a singleComponent that is caused to be loaded due to a
        -- file, we assume the file is part of that component. This is useful
        -- for bare GHC sessions, such as many of the ones used in the testsuite
        --
        -- We don't do this when we have multiple components, because each
        -- component better list all targets or there will be anarchy.
        -- It is difficult to know which component to add our file to in
        -- that case.
        -- Multi unit arguments are likely to come from cabal, which
        -- does list all targets.
        --
        -- If we don't end up with a target for the current file in the end, then
        -- we will report it as an error for that file
        let abs_fp = FilePath
rootDir FilePath -> FilePath -> FilePath
</> FilePath
cfp
        let special_target = DynFlags -> FilePath -> Target
mkSimpleTarget DynFlags
df FilePath
abs_fp
        pure $ (df, special_target : targets) NonEmpty.:| []
    where
      initMulti :: t FilePath -> m (t (DynFlags, [Target]))
initMulti t FilePath
unitArgFiles =
        t FilePath
-> (FilePath -> m (DynFlags, [Target]))
-> m (t (DynFlags, [Target]))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t FilePath
unitArgFiles ((FilePath -> m (DynFlags, [Target]))
 -> m (t (DynFlags, [Target])))
-> (FilePath -> m (DynFlags, [Target]))
-> m (t (DynFlags, [Target]))
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
          args <- IO [FilePath] -> m [FilePath]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO [FilePath]
expandResponse [FilePath
f]
          initOne args
      initOne :: [FilePath] -> m (DynFlags, [Target])
initOne [FilePath]
this_opts = do
        (dflags', targets') <- [FilePath] -> DynFlags -> m (DynFlags, [Target])
forall (m :: * -> *).
GhcMonad m =>
[FilePath] -> DynFlags -> m (DynFlags, [Target])
addCmdOpts [FilePath]
this_opts DynFlags
dflags

        let targets = FilePath -> [Target] -> [Target]
HIE.makeTargetsAbsolute FilePath
root [Target]
targets'
            root = case DynFlags -> Maybe FilePath
workingDirectory DynFlags
dflags' of
              Maybe FilePath
Nothing   -> FilePath
compRoot
              Just FilePath
wdir -> FilePath
compRoot FilePath -> FilePath -> FilePath
</> FilePath
wdir
        let dflags'' =
              FilePath -> DynFlags -> DynFlags
setWorkingDirectory FilePath
root (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$
              FilePath -> DynFlags -> DynFlags
makeDynFlagsAbsolute FilePath
compRoot -- makeDynFlagsAbsolute already accounts for workingDirectory
              DynFlags
dflags'
        return (dflags'', targets)

setupHomeUnitGraph :: GhcMonad m => [(DynFlags, [GHC.Target])] -> m ()
setupHomeUnitGraph :: forall (m :: * -> *). GhcMonad m => [(DynFlags, [Target])] -> m ()
setupHomeUnitGraph [(DynFlags, [Target])]
flagsAndTargets = do
  hsc_env <- m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
GHC.getSession
  (hsc_env', targetDetails) <- liftIO $ setupMultiHomeUnitGhcSession [".hs", ".lhs"] hsc_env flagsAndTargets
  GHC.setSession hsc_env'
  GHC.setTargets (fmap toGhcTarget targetDetails)

-- | Set up the 'HomeUnitGraph' with empty 'HomeUnitEnv's.
createUnitEnvFromFlags :: NonEmpty.NonEmpty DynFlags -> IO HomeUnitGraph
createUnitEnvFromFlags :: NonEmpty DynFlags -> IO HomeUnitGraph
createUnitEnvFromFlags NonEmpty DynFlags
unitDflags = do
  let
    newInternalUnitEnv :: DynFlags -> HomePackageTable -> HomeUnitEnv
newInternalUnitEnv DynFlags
dflags HomePackageTable
hpt = UnitState
-> Maybe [UnitDatabase UnitEnvGraphKey]
-> DynFlags
-> HomePackageTable
-> Maybe HomeUnit
-> HomeUnitEnv
mkHomeUnitEnv UnitState
State.emptyUnitState Maybe [UnitDatabase UnitEnvGraphKey]
forall a. Maybe a
Nothing DynFlags
dflags HomePackageTable
hpt Maybe HomeUnit
forall a. Maybe a
Nothing

  unitEnvList <- (DynFlags -> IO (UnitEnvGraphKey, HomeUnitEnv))
-> NonEmpty DynFlags
-> IO (NonEmpty (UnitEnvGraphKey, HomeUnitEnv))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (\DynFlags
dflags -> do
    emptyHpt <- IO HomePackageTable
emptyHomePackageTable
    pure (homeUnitId_ dflags, newInternalUnitEnv dflags emptyHpt)) NonEmpty DynFlags
unitDflags

  pure $ unitEnv_new (Map.fromList (NonEmpty.toList unitEnvList))

-- | Given a set of 'DynFlags', set up the 'UnitEnv' and 'HomeUnitEnv' for this
-- 'HscEnv'.
-- We assume the 'HscEnv' is "empty", e.g. wasn't already used to compile
-- anything.
initHomeUnitEnv :: [DynFlags] -> HscEnv -> IO HscEnv
initHomeUnitEnv :: [DynFlags] -> HscEnv -> IO HscEnv
initHomeUnitEnv [DynFlags]
unitDflags HscEnv
env = do
  let dflags0 :: DynFlags
dflags0         = HscEnv -> DynFlags
hsc_dflags HscEnv
env
  -- additionally, set checked dflags so we don't lose fixes
  initial_home_graph <- NonEmpty DynFlags -> IO HomeUnitGraph
createUnitEnvFromFlags (DynFlags
dflags0 DynFlags -> [DynFlags] -> NonEmpty DynFlags
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [DynFlags]
unitDflags)
  let home_units = HomeUnitGraph -> Set UnitEnvGraphKey
forall v. UnitEnvGraph v -> Set UnitEnvGraphKey
unitEnv_keys HomeUnitGraph
initial_home_graph
  home_unit_graph <- forM initial_home_graph $ \HomeUnitEnv
homeUnitEnv -> do
    let cached_unit_dbs :: Maybe [UnitDatabase UnitEnvGraphKey]
cached_unit_dbs = HomeUnitEnv -> Maybe [UnitDatabase UnitEnvGraphKey]
homeUnitEnv_unit_dbs HomeUnitEnv
homeUnitEnv
        dflags :: DynFlags
dflags = HomeUnitEnv -> DynFlags
homeUnitEnv_dflags HomeUnitEnv
homeUnitEnv
        old_hpt :: HomePackageTable
old_hpt = HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt HomeUnitEnv
homeUnitEnv

    (dbs,unit_state,home_unit,mconstants) <- Logger
-> DynFlags
-> Maybe [UnitDatabase UnitEnvGraphKey]
-> Set UnitEnvGraphKey
-> IO
     ([UnitDatabase UnitEnvGraphKey], UnitState, HomeUnit,
      Maybe PlatformConstants)
State.initUnits (HscEnv -> Logger
hsc_logger HscEnv
env) DynFlags
dflags Maybe [UnitDatabase UnitEnvGraphKey]
cached_unit_dbs Set UnitEnvGraphKey
home_units

    updated_dflags <- GHC.updatePlatformConstants dflags mconstants
    pure HomeUnitEnv
      { homeUnitEnv_units = unit_state
      , homeUnitEnv_unit_dbs = Just dbs
      , homeUnitEnv_dflags = updated_dflags
      , homeUnitEnv_hpt = old_hpt
      , homeUnitEnv_home_unit = Just home_unit
      }

  let dflags1 = HomeUnitEnv -> DynFlags
homeUnitEnv_dflags (HomeUnitEnv -> DynFlags) -> HomeUnitEnv -> DynFlags
forall a b. (a -> b) -> a -> b
$ UnitEnvGraphKey -> HomeUnitGraph -> HomeUnitEnv
forall v. UnitEnvGraphKey -> UnitEnvGraph v -> v
unitEnv_lookup (DynFlags -> UnitEnvGraphKey
homeUnitId_ DynFlags
dflags0) HomeUnitGraph
home_unit_graph
  let unit_env = UnitEnv
        { ue_platform :: Platform
ue_platform        = DynFlags -> Platform
targetPlatform DynFlags
dflags1
        , ue_namever :: GhcNameVersion
ue_namever         = DynFlags -> GhcNameVersion
GHC.ghcNameVersion DynFlags
dflags1
        , ue_home_unit_graph :: HomeUnitGraph
ue_home_unit_graph = HomeUnitGraph
home_unit_graph
        , ue_current_unit :: UnitEnvGraphKey
ue_current_unit    = DynFlags -> UnitEnvGraphKey
homeUnitId_ DynFlags
dflags0
        , ue_eps :: ExternalUnitCache
ue_eps             = UnitEnv -> ExternalUnitCache
ue_eps (HscEnv -> UnitEnv
hsc_unit_env HscEnv
env)
        }
  pure $ hscSetFlags dflags1 $ hscSetUnitEnv unit_env env


-- | Setup the given 'HscEnv' to hold a 'UnitEnv'
-- with all the given components.
-- We return the modified 'HscEnv' and all the 'TargetDetails' for
-- the given 'GHC.Target's.
setupMultiHomeUnitGhcSession
         :: [String]           -- ^ File extensions to consider. This is mostly a remnant of HLS.
         -> HscEnv             -- ^ An empty HscEnv that we can use the setup the session.
         -> [(DynFlags, [GHC.Target])]    -- ^ New components to be loaded. Expected to be non-empty.
         -> IO (HscEnv, [TargetDetails])
setupMultiHomeUnitGhcSession :: [FilePath]
-> HscEnv -> [(DynFlags, [Target])] -> IO (HscEnv, [TargetDetails])
setupMultiHomeUnitGhcSession [FilePath]
exts HscEnv
hsc_env [(DynFlags, [Target])]
cis = do
    let dfs :: [DynFlags]
dfs = ((DynFlags, [Target]) -> DynFlags)
-> [(DynFlags, [Target])] -> [DynFlags]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags, [Target]) -> DynFlags
forall a b. (a, b) -> a
fst [(DynFlags, [Target])]
cis

    hscEnv' <- [DynFlags] -> HscEnv -> IO HscEnv
initHomeUnitEnv [DynFlags]
dfs HscEnv
hsc_env
    -- TODO: this should be reported
    -- _ <- maybeToList $ GHC.checkHomeUnitsClosed (hsc_unit_env hscEnv') (hsc_all_home_unit_ids hscEnv')
    ts <- forM cis $ \(DynFlags
df, [Target]
targets) -> do
      -- evaluate $ liftRnf rwhnf targets

      let mk :: Target -> IO [TargetDetails]
mk Target
t = [FilePath]
-> [FilePath] -> UnitEnvGraphKey -> TargetId -> IO [TargetDetails]
fromTargetId (DynFlags -> [FilePath]
importPaths DynFlags
df) [FilePath]
exts (DynFlags -> UnitEnvGraphKey
homeUnitId_ DynFlags
df) (Target -> TargetId
GHC.targetId Target
t)
      ctargets <- (Target -> IO [TargetDetails]) -> [Target] -> IO [TargetDetails]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Traversable f) =>
(a -> m [b]) -> f a -> m [b]
concatMapM Target -> IO [TargetDetails]
mk [Target]
targets

      return (L.nubOrdOn targetTarget ctargets)
    pure (hscEnv', concat ts)

data TargetDetails = TargetDetails
  { TargetDetails -> Target
targetTarget :: Target
  -- ^ Simplified version of 'TargetId', storing enough information
  --
  , TargetDetails -> [FilePath]
targetLocations :: [FilePath]
  -- ^ The physical location of 'targetTarget'.
  -- Contains '-boot' file locations.
  -- At this moment in time, these are unused, but could be used to create
  -- convenient lookup table from 'FilePath' to 'TargetDetails'.
  , TargetDetails -> UnitEnvGraphKey
targetUnitId :: UnitId
  -- ^ UnitId of 'targetTarget'.
  }
  deriving (TargetDetails -> TargetDetails -> Bool
(TargetDetails -> TargetDetails -> Bool)
-> (TargetDetails -> TargetDetails -> Bool) -> Eq TargetDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TargetDetails -> TargetDetails -> Bool
== :: TargetDetails -> TargetDetails -> Bool
$c/= :: TargetDetails -> TargetDetails -> Bool
/= :: TargetDetails -> TargetDetails -> Bool
Eq, Eq TargetDetails
Eq TargetDetails =>
(TargetDetails -> TargetDetails -> Ordering)
-> (TargetDetails -> TargetDetails -> Bool)
-> (TargetDetails -> TargetDetails -> Bool)
-> (TargetDetails -> TargetDetails -> Bool)
-> (TargetDetails -> TargetDetails -> Bool)
-> (TargetDetails -> TargetDetails -> TargetDetails)
-> (TargetDetails -> TargetDetails -> TargetDetails)
-> Ord TargetDetails
TargetDetails -> TargetDetails -> Bool
TargetDetails -> TargetDetails -> Ordering
TargetDetails -> TargetDetails -> TargetDetails
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TargetDetails -> TargetDetails -> Ordering
compare :: TargetDetails -> TargetDetails -> Ordering
$c< :: TargetDetails -> TargetDetails -> Bool
< :: TargetDetails -> TargetDetails -> Bool
$c<= :: TargetDetails -> TargetDetails -> Bool
<= :: TargetDetails -> TargetDetails -> Bool
$c> :: TargetDetails -> TargetDetails -> Bool
> :: TargetDetails -> TargetDetails -> Bool
$c>= :: TargetDetails -> TargetDetails -> Bool
>= :: TargetDetails -> TargetDetails -> Bool
$cmax :: TargetDetails -> TargetDetails -> TargetDetails
max :: TargetDetails -> TargetDetails -> TargetDetails
$cmin :: TargetDetails -> TargetDetails -> TargetDetails
min :: TargetDetails -> TargetDetails -> TargetDetails
Ord)

-- | A simplified view on a 'TargetId'.
--
-- Implements 'Ord' and 'Show' which can be convenient.
data Target = TargetModule ModuleName | TargetFile FilePath
  deriving ( Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
/= :: Target -> Target -> Bool
Eq, Eq Target
Eq Target =>
(Target -> Target -> Ordering)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Target)
-> (Target -> Target -> Target)
-> Ord Target
Target -> Target -> Bool
Target -> Target -> Ordering
Target -> Target -> Target
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Target -> Target -> Ordering
compare :: Target -> Target -> Ordering
$c< :: Target -> Target -> Bool
< :: Target -> Target -> Bool
$c<= :: Target -> Target -> Bool
<= :: Target -> Target -> Bool
$c> :: Target -> Target -> Bool
> :: Target -> Target -> Bool
$c>= :: Target -> Target -> Bool
>= :: Target -> Target -> Bool
$cmax :: Target -> Target -> Target
max :: Target -> Target -> Target
$cmin :: Target -> Target -> Target
min :: Target -> Target -> Target
Ord, Int -> Target -> FilePath -> FilePath
[Target] -> FilePath -> FilePath
Target -> FilePath
(Int -> Target -> FilePath -> FilePath)
-> (Target -> FilePath)
-> ([Target] -> FilePath -> FilePath)
-> Show Target
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Target -> FilePath -> FilePath
showsPrec :: Int -> Target -> FilePath -> FilePath
$cshow :: Target -> FilePath
show :: Target -> FilePath
$cshowList :: [Target] -> FilePath -> FilePath
showList :: [Target] -> FilePath -> FilePath
Show )

-- | Turn a 'TargetDetails' into a 'GHC.Target'.
toGhcTarget :: TargetDetails -> GHC.Target
toGhcTarget :: TargetDetails -> Target
toGhcTarget (TargetDetails Target
tid [FilePath]
_ UnitEnvGraphKey
uid) = case Target
tid of
  TargetModule ModuleName
modl -> TargetId
-> Bool
-> UnitEnvGraphKey
-> Maybe (InputFileBuffer, UTCTime)
-> Target
GHC.Target (ModuleName -> TargetId
GHC.TargetModule ModuleName
modl) Bool
True UnitEnvGraphKey
uid Maybe (InputFileBuffer, UTCTime)
forall a. Maybe a
Nothing
  TargetFile FilePath
fp -> TargetId
-> Bool
-> UnitEnvGraphKey
-> Maybe (InputFileBuffer, UTCTime)
-> Target
GHC.Target (FilePath -> Maybe Phase -> TargetId
GHC.TargetFile FilePath
fp Maybe Phase
forall a. Maybe a
Nothing) Bool
True UnitEnvGraphKey
uid Maybe (InputFileBuffer, UTCTime)
forall a. Maybe a
Nothing

fromTargetId :: [FilePath]          -- ^ import paths
             -> [String]            -- ^ extensions to consider
             -> UnitId
             -> GHC.TargetId
             -> IO [TargetDetails]
-- For a target module we consider all the import paths
fromTargetId :: [FilePath]
-> [FilePath] -> UnitEnvGraphKey -> TargetId -> IO [TargetDetails]
fromTargetId [FilePath]
is [FilePath]
exts UnitEnvGraphKey
unitId (GHC.TargetModule ModuleName
modName) = do
    let fps :: [FilePath]
fps = [FilePath
i FilePath -> FilePath -> FilePath
</> ModuleName -> FilePath
moduleNameSlashes ModuleName
modName FilePath -> FilePath -> FilePath
-<.> FilePath
ext FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
boot
              | FilePath
ext <- [FilePath]
exts
              , FilePath
i <- [FilePath]
is
              , FilePath
boot <- [FilePath
"", FilePath
"-boot"]
              ]
    [TargetDetails] -> IO [TargetDetails]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Target -> [FilePath] -> UnitEnvGraphKey -> TargetDetails
TargetDetails (ModuleName -> Target
TargetModule ModuleName
modName) [FilePath]
fps UnitEnvGraphKey
unitId]
-- For a 'TargetFile' we consider all the possible module names
fromTargetId [FilePath]
_ [FilePath]
_ UnitEnvGraphKey
unitId (GHC.TargetFile FilePath
f Maybe Phase
_) = do
    let other :: FilePath
other
          | FilePath
"-boot" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` FilePath
f = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
dropEnd Int
5 FilePath
f
          | Bool
otherwise = (FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-boot")
    [TargetDetails] -> IO [TargetDetails]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Target -> [FilePath] -> UnitEnvGraphKey -> TargetDetails
TargetDetails (FilePath -> Target
TargetFile FilePath
f) [FilePath
f, FilePath
other] UnitEnvGraphKey
unitId]

-- ----------------------------------------------------------------------------
-- GHC Utils that should likely be exposed by GHC
-- ----------------------------------------------------------------------------

mkSimpleTarget :: DynFlags -> FilePath -> GHC.Target
mkSimpleTarget :: DynFlags -> FilePath -> Target
mkSimpleTarget DynFlags
df FilePath
fp = TargetId
-> Bool
-> UnitEnvGraphKey
-> Maybe (InputFileBuffer, UTCTime)
-> Target
GHC.Target (FilePath -> Maybe Phase -> TargetId
GHC.TargetFile FilePath
fp Maybe Phase
forall a. Maybe a
Nothing) Bool
True (DynFlags -> UnitEnvGraphKey
homeUnitId_ DynFlags
df) Maybe (InputFileBuffer, UTCTime)
forall a. Maybe a
Nothing

hscSetUnitEnv :: UnitEnv -> HscEnv -> HscEnv
hscSetUnitEnv :: UnitEnv -> HscEnv -> HscEnv
hscSetUnitEnv UnitEnv
ue HscEnv
env = HscEnv
env { hsc_unit_env = ue }

setWorkingDirectory :: FilePath -> DynFlags -> DynFlags
setWorkingDirectory :: FilePath -> DynFlags -> DynFlags
setWorkingDirectory FilePath
p DynFlags
d = DynFlags
d { workingDirectory =  Just p }

-- ----------------------------------------------------------------------------
-- Utils that we need, but don't want to incur an additional dependency for.
-- ----------------------------------------------------------------------------

-- | Drop a number of elements from the end of the list.
--
-- > dropEnd 3 "hello"  == "he"
-- > dropEnd 5 "bye"    == ""
-- > dropEnd (-1) "bye" == "bye"
-- > \i xs -> dropEnd i xs `isPrefixOf` xs
-- > \i xs -> length (dropEnd i xs) == max 0 (length xs - max 0 i)
-- > \i -> take 3 (dropEnd 5 [i..]) == take 3 [i..]
dropEnd :: Int -> [a] -> [a]
dropEnd :: forall a. Int -> [a] -> [a]
dropEnd Int
i [a]
xs
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [a]
xs
    | Bool
otherwise = [a] -> [a] -> [a]
forall {a} {a}. [a] -> [a] -> [a]
f [a]
xs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
i [a]
xs)
    where f :: [a] -> [a] -> [a]
f (a
a:[a]
as) (a
_:[a]
bs) = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
f [a]
as [a]
bs
          f [a]
_ [a]
_ = []