packages feed

ghc-debugger 0.3.0.0 → 0.4.0.0

raw patch · 5 files changed

+302/−66 lines, 5 filesdep ~directorydep ~hie-biosPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: directory, hie-bios

API changes (from Hackage documentation)

+ GHC.Debugger.Session: TargetDetails :: Target -> [FilePath] -> UnitId -> TargetDetails
+ GHC.Debugger.Session: TargetFile :: FilePath -> Target
+ GHC.Debugger.Session: TargetModule :: ModuleName -> Target
+ GHC.Debugger.Session: [targetLocations] :: TargetDetails -> [FilePath]
+ GHC.Debugger.Session: [targetTarget] :: TargetDetails -> Target
+ GHC.Debugger.Session: [targetUnitId] :: TargetDetails -> UnitId
+ GHC.Debugger.Session: data Target
+ GHC.Debugger.Session: data TargetDetails
+ GHC.Debugger.Session: instance GHC.Internal.Classes.Eq GHC.Debugger.Session.Target
+ GHC.Debugger.Session: instance GHC.Internal.Classes.Eq GHC.Debugger.Session.TargetDetails
+ GHC.Debugger.Session: instance GHC.Internal.Classes.Ord GHC.Debugger.Session.Target
+ GHC.Debugger.Session: instance GHC.Internal.Classes.Ord GHC.Debugger.Session.TargetDetails
+ GHC.Debugger.Session: instance GHC.Internal.Show.Show GHC.Debugger.Session.Target
+ GHC.Debugger.Session: parseHomeUnitArguments :: GhcMonad m => FilePath -> FilePath -> [String] -> [String] -> DynFlags -> FilePath -> m (NonEmpty (DynFlags, [Target]))
+ GHC.Debugger.Session: setupHomeUnitGraph :: GhcMonad m => [(DynFlags, [Target])] -> m ()
+ GHC.Debugger.Session: toGhcTarget :: TargetDetails -> Target
- GHC.Debugger.Monad: runDebugger :: Handle -> FilePath -> [String] -> [String] -> RunDebuggerSettings -> Debugger a -> IO a
+ GHC.Debugger.Monad: runDebugger :: Handle -> FilePath -> FilePath -> FilePath -> [String] -> [String] -> FilePath -> RunDebuggerSettings -> Debugger a -> IO a

Files

ghc-debug-adapter/Development/Debug/Adapter/Flags.hs view
@@ -1,15 +1,12 @@ {-# LANGUAGE CPP, RecordWildCards, LambdaCase #-} module Development.Debug.Adapter.Flags where -import Data.Maybe import Data.Function import System.FilePath import System.Directory import Control.Monad.Except import Control.Monad.IO.Class -import qualified Data.List as L- import qualified HIE.Bios as HIE import qualified HIE.Bios.Types as HIE import qualified HIE.Bios.Environment as HIE@@ -19,6 +16,12 @@       { ghcInvocation :: [String]       , libdir :: FilePath       , units :: [String]+      , rootDir :: FilePath+      -- ^ Root dir as reported by the 'Cradle'+      , componentDir :: FilePath+      -- ^ Root dir of the loaded 'ComponentOptions'.+      -- Important for multi-package cabal projects, as packages are not in the+      -- root of the cradle, but in some sub-directory.       }  -- | Make 'HieBiosFlags' from the given target file@@ -28,6 +31,7 @@   let target = root </> relTarget    explicitCradle <- HIE.findCradle target & liftIO+  -- TODO: Use proper loggers here   cradle <- maybe (HIE.loadImplicitCradle mempty target)                   (HIE.loadCradle mempty) explicitCradle & liftIO @@ -38,29 +42,38 @@   -- (HIE.getCompilerOptions depends on CWD being the proper root dir)   let compilerOpts = liftIO $ withCurrentDirectory root $ #if MIN_VERSION_hie_bios(0,14,0)-                          HIE.getCompilerOptions target HIE.LoadFile cradle+                          HIE.getCompilerOptions target (HIE.LoadWithContext [target]) cradle #else                           HIE.getCompilerOptions target [] cradle #endif-  HIE.ComponentOptions {HIE.componentOptions = flags} <- compilerOpts >>= unwrapCradleResult "Failed to get compiler options using hie-bios cradle"-+  componentOpts <- compilerOpts >>= unwrapCradleResult "Failed to get compiler options using hie-bios cradle" #if __GLASGOW_HASKELL__ >= 913   -- fwrite-if-simplified-core requires a recent bug fix regarding GHCi loading   -- ROMES:TODO: Re-enable as soon as I'm using Matthew's patch.   -- ["-fwrite-if-simplified-core"] ++ #endif +  let (units', flags') = extractUnits (HIE.componentOptions componentOpts)   return HieBiosFlags-    { ghcInvocation = [ relTarget | not $ any (`L.isSuffixOf` target) flags ] ++ -- TODO is this correct? else, the debugger won't work on single files.-                      flags ++ ghcDebuggerFlags+    { ghcInvocation = flags' ++ ghcDebuggerFlags     , libdir = libdir-    , units  = mapMaybe (\case ("-unit", u) -> Just u; _ -> Nothing) $ zip flags (drop 1 flags)+    , units  = units'+    , rootDir = HIE.cradleRootDir cradle+    , componentDir = HIE.componentRoot componentOpts     }   where     unwrapCradleResult m = \case       HIE.CradleNone     -> throwError $ "HIE.CradleNone\n" ++ m       HIE.CradleFail err -> throwError $ unlines (HIE.cradleErrorStderr err) ++ "\n" ++ m       HIE.CradleSuccess x -> return x++extractUnits :: [String] -> ([String], [String])+extractUnits = go [] []+  where+    -- TODO: we should likely use the 'processCmdLineP' instead+    go units rest ("-unit" : x : xs) = go (x : units) rest xs+    go units rest (x : xs)           = go units (x : rest) xs+    go units rest []                 = (reverse units, reverse rest)  -- | Flags specific to ghc-debugger to append to all GHC invocations. ghcDebuggerFlags :: [String]
ghc-debug-adapter/Development/Debug/Adapter/Init.hs view
@@ -108,7 +108,7 @@       finished_init <- liftIO $ newEmptyMVar        registerNewDebugSession (maybe "debug-session" T.pack __sessionId) DAS{..}-        [ debuggerThread finished_init writeDebuggerOutput projectRoot flags extraGhcArgs defaultRunConf syncRequests syncResponses+        [ debuggerThread finished_init writeDebuggerOutput projectRoot flags extraGhcArgs entryFile defaultRunConf syncRequests syncResponses         , handleDebuggerOutput readDebuggerOutput         , stdoutCaptureThread         , stderrCaptureThread@@ -166,13 +166,14 @@                -> FilePath        -- ^ Working directory for GHC session                -> HieBiosFlags    -- ^ GHC Invocation flags                -> [String]        -- ^ Extra ghc args+               -> FilePath                -> Debugger.RunDebuggerSettings -- ^ Settings for running the debugger                -> MVar D.Command  -- ^ Read commands                -> MVar D.Response -- ^ Write reponses                -> (DebugAdaptorCont () -> IO ())                -- ^ Allows unlifting DebugAdaptor actions to IO. See 'registerNewDebugSession'.                -> IO ()-debuggerThread finished_init writeDebuggerOutput workDir HieBiosFlags{..} extraGhcArgs runConf requests replies withAdaptor = do+debuggerThread finished_init writeDebuggerOutput workDir HieBiosFlags{..} extraGhcArgs mainFp runConf requests replies withAdaptor = do    let finalGhcInvocation = ghcInvocation ++ extraGhcArgs @@ -188,9 +189,9 @@    catches     (do-      Debugger.runDebugger writeDebuggerOutput libdir units finalGhcInvocation runConf $ do+      Debugger.runDebugger writeDebuggerOutput rootDir componentDir libdir units finalGhcInvocation mainFp runConf $ do         liftIO $ signalInitialized (Right ())-     +         forever $ do           req <- takeMVar requests & liftIO           resp <- (Debugger.execute req <&> Right)
ghc-debugger.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ghc-debugger-version:            0.3.0.0+version:            0.4.0.0 synopsis:     A step-through machine-interface debugger for GHC Haskell @@ -53,6 +53,7 @@                       GHC.Debugger.Runtime.Term.Cache,                        GHC.Debugger.Monad,+                      GHC.Debugger.Session,                       GHC.Debugger.Interface.Messages     -- other-modules:     -- other-extensions:@@ -65,9 +66,11 @@                       process >= 1.6.25 && < 1.7,                       unix >= 2.8.6 && < 2.9,                       filepath >= 1.5.4 && < 1.6,+                      directory >= 1.3.9.0 && < 1.4,                       exceptions >= 0.10.9 && < 0.11,                       bytestring >= 0.12.1 && < 0.13,                       aeson >= 2.2.3 && < 2.3,+                      hie-bios,      hs-source-dirs:   ghc-debugger     default-language: Haskell2010
ghc-debugger/GHC/Debugger/Monad.hs view
@@ -3,9 +3,11 @@  import Prelude hiding (mod) import Data.Function+import qualified Data.Foldable as Foldable import System.Exit import System.IO import System.FilePath (normalise)+import System.Directory (makeAbsolute) import Control.Monad import Control.Monad.IO.Class import Control.Exception (assert)@@ -13,29 +15,21 @@ import Control.Monad.Catch  import GHC-import GHC.Types.Name (mkDerivedInternalName)-import GHC.Types.Name.Occurrence (mkVarOcc) import qualified GHCi.BreakArray as BA import GHC.Driver.DynFlags as GHC-import GHC.Driver.Phases as GHC-import GHC.Driver.Pipeline as GHC-import GHC.Driver.Config.Logger as GHC-import GHC.Driver.Session.Units as GHC import GHC.Unit.Module.ModSummary as GHC import GHC.Utils.Outputable as GHC-import GHC.Utils.Monad as GHC import GHC.Utils.Logger as GHC import GHC.Types.Unique.Supply as GHC import GHC.Runtime.Loader as GHC import GHC.Runtime.Interpreter as GHCi import GHC.Runtime.Heap.Inspect import GHC.Unit.Module.Env as GHC-import GHC.Types.Name.Env import GHC.Driver.Env  import Data.IORef import Data.Maybe-import qualified Data.List.NonEmpty as NE+import qualified Data.List.NonEmpty as NonEmpty import qualified Data.List as List import qualified Data.IntMap as IM @@ -44,6 +38,7 @@ import GHC.Debugger.Interface.Messages import GHC.Debugger.Runtime.Term.Key import GHC.Debugger.Runtime.Term.Cache+import GHC.Debugger.Session import System.Posix.Signals  -- | A debugger action.@@ -103,13 +98,16 @@  -- | Run a 'Debugger' action on a session constructed from a given GHC invocation. runDebugger :: Handle     -- ^ The handle to which GHC's output is logged. The debuggee output is not affected by this parameter.+            -> FilePath   -- ^ Cradle root directory+            -> FilePath   -- ^ Component root directory             -> FilePath   -- ^ The libdir (given with -B as an arg)             -> [String]   -- ^ The list of units included in the invocation             -> [String]   -- ^ The full ghc invocation (as constructed by hie-bios flags)+            -> FilePath   -- ^ Path to the main function             -> RunDebuggerSettings -- ^ Other debugger run settings             -> Debugger a -- ^ 'Debugger' action to run on the session constructed from this invocation             -> IO a-runDebugger dbg_out libdir units ghcInvocation' conf (Debugger action) = do+runDebugger dbg_out rootDir compDir libdir units ghcInvocation' mainFp conf (Debugger action) = do   let ghcInvocation = filter (\case ('-':'B':_) -> False; _ -> True) ghcInvocation'    GHC.runGhc (Just libdir) $ do@@ -136,53 +134,23 @@       -- Override the logger to output to the given handle       GHC.pushLogHook (const $ debuggerLoggerAction dbg_out) -    logger1 <- GHC.getLogger-    let logger2 = GHC.setLogFlags logger1 (GHC.initLogFlags dflags1)--          -- The rest of the arguments are "dynamic"-          -- Leftover ones are presumably files-    (dflags4, fileish_args, _dynamicFlagWarnings) <--        GHC.parseDynamicFlags logger2 dflags1 (map (GHC.mkGeneralLocated "on ghc-debugger command arg") ghcInvocation)+    -- TODO: this is weird, we set the session dynflags now to initialise+    -- the hsc_interp.+    -- This is incredibly dubious+    _ <- GHC.setSessionDynFlags dflags1 -    let (dflags5, srcs, objs) = GHC.parseTargetFiles dflags4 (map GHC.unLoc fileish_args)+    -- Initialise plugins here because the plugin author might already expect this+    -- subsequent call to `getLogger` to be affected by a plugin.+    GHC.initializeSessionPlugins -    -- we've finished manipulating the DynFlags, update the session-    _ <- GHC.setSessionDynFlags dflags5+    flagsAndTargets <- parseHomeUnitArguments mainFp compDir units ghcInvocation dflags1 rootDir+    setupHomeUnitGraph (NonEmpty.toList flagsAndTargets)      dflags6 <- GHC.getSessionDynFlags      -- Should this be done in GHC=     liftIO $ GHC.initUniqSupply (GHC.initialUnique dflags6) (GHC.uniqueIncrement dflags6) -    -- Initialise plugins here because the plugin author might already expect this-    -- subsequent call to `getLogger` to be affected by a plugin.-    GHC.initializeSessionPlugins-    hsc_env <- GHC.getSession-    -    hs_srcs <- case NE.nonEmpty units of-      Just ne_units -> do-        GHC.initMulti ne_units (\_ _ _ _ -> {-no options extra check-} pure ())-      Nothing -> do-        case srcs of-          [] -> return []-          _  -> do-            let (hs_srcs, non_hs_srcs) = List.partition GHC.isHaskellishTarget srcs--            -- if we have no haskell sources from which to do a dependency-            -- analysis, then just do one-shot compilation and/or linking.-            -- This means that "ghc Foo.o Bar.o -o baz" links the program as-            -- we expect.-            if (null hs_srcs)-               then liftIO (GHC.oneShot hsc_env GHC.NoStop srcs) >> return []-               else do-                 o_files <- GHC.mapMaybeM (\x -> liftIO $ GHC.compileFile hsc_env GHC.NoStop x) non_hs_srcs-                 dflags7 <- GHC.getSessionDynFlags-                 let dflags' = dflags7 { GHC.ldInputs = map (GHC.FileOption "") o_files ++ GHC.ldInputs dflags7 }-                 _ <- GHC.setSessionDynFlags dflags'-                 return $ map (uncurry (,Nothing,)) hs_srcs--    targets' <- mapM (\(src, uid, phase) -> GHC.guessTarget src uid phase) hs_srcs-    GHC.setTargets targets'     ok_flag <- GHC.load GHC.LoadAllTargets     when (GHC.failed ok_flag) (liftIO $ exitWith (ExitFailure 1)) @@ -192,7 +160,7 @@     -- TODO: Think about Note [GHCi and local Preludes] and what is done in `getImplicitPreludeImports`     let preludeImp = GHC.IIDecl . GHC.simpleImportDecl $ GHC.mkModuleName "Prelude"     mss <- getAllLoadedModules-    GHC.setContext $ preludeImp : map (GHC.IIDecl . GHC.simpleImportDecl . GHC.ms_mod_name) mss+    GHC.setContext $ preludeImp : map (GHC.IIModule . GHC.ms_mod) mss      runReaderT action =<< initialDebuggerState @@ -299,9 +267,10 @@ -- | Get a 'ModSummary' of a loaded module given its 'FilePath' getModuleByPath :: FilePath -> Debugger (Either String ModSummary) getModuleByPath path = do-  -- do this everytime as the loaded modules may have changed+  -- do this every time as the loaded modules may have changed   lms <- getAllLoadedModules-  let matches ms = normalise (msHsFilePath ms) `List.isSuffixOf` path+  absPath <- liftIO $ makeAbsolute path+  let matches ms = normalise (msHsFilePath ms) == normalise absPath   return $ case filter matches lms of     [x] -> Right x     [] -> Left $ "No module matched " ++ path ++ ".\nLoaded modules:\n" ++ show (map msHsFilePath lms) ++ "\n. Perhaps you've set a breakpoint on a module that isn't loaded into the session?"
+ ghc-debugger/GHC/Debugger/Session.hs view
@@ -0,0 +1,250 @@+{-# 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 cfp compRoot units theOpts dflags rootDir = do+    ((theOpts',_errs,_warns),_units) <- GHC.processCmdLineP [] [] (map noLoc theOpts)+    case NonEmpty.nonEmpty units of+      Just us -> initMulti us+      Nothing -> do+        (df, targets) <- initOne (map unLoc 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 = rootDir </> cfp+        let special_target = mkSimpleTarget df abs_fp+        pure $ (df, special_target : targets) NonEmpty.:| []+    where+      initMulti unitArgFiles =+        forM unitArgFiles $ \f -> do+          args <- liftIO $ expandResponse [f]+          initOne args+      initOne this_opts = do+        (dflags', targets') <- addCmdOpts this_opts dflags++        let targets = HIE.makeTargetsAbsolute root targets'+            root = case workingDirectory dflags' of+              Nothing   -> compRoot+              Just wdir -> compRoot </> wdir+        let dflags'' =+              setWorkingDirectory root $+              makeDynFlagsAbsolute compRoot -- makeDynFlagsAbsolute already accounts for workingDirectory+              dflags'+        return (dflags'', targets)++setupHomeUnitGraph :: GhcMonad m => [(DynFlags, [GHC.Target])] -> m ()+setupHomeUnitGraph flagsAndTargets = do+  hsc_env <- 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 unitDflags = do+  let+    newInternalUnitEnv dflags hpt = mkHomeUnitEnv State.emptyUnitState Nothing dflags hpt Nothing++  unitEnvList <- traverse (\dflags -> do+    emptyHpt <- emptyHomePackageTable+    pure (homeUnitId_ dflags, newInternalUnitEnv dflags emptyHpt)) 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 unitDflags env = do+  let dflags0         = hsc_dflags env+  -- additionally, set checked dflags so we don't lose fixes+  initial_home_graph <- createUnitEnvFromFlags (dflags0 NonEmpty.:| unitDflags)+  let home_units = unitEnv_keys initial_home_graph+  home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do+    let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv+        dflags = homeUnitEnv_dflags homeUnitEnv+        old_hpt = homeUnitEnv_hpt homeUnitEnv++    (dbs,unit_state,home_unit,mconstants) <- State.initUnits (hsc_logger env) dflags cached_unit_dbs 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_dflags $ unitEnv_lookup (homeUnitId_ dflags0) home_unit_graph+  let unit_env = UnitEnv+        { ue_platform        = targetPlatform dflags1+        , ue_namever         = GHC.ghcNameVersion dflags1+        , ue_home_unit_graph = home_unit_graph+        , ue_current_unit    = homeUnitId_ dflags0+        , ue_eps             = ue_eps (hsc_unit_env 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 exts hsc_env cis = do+    let dfs = map fst cis++    hscEnv' <- initHomeUnitEnv dfs hsc_env+    -- TODO: this should be reported+    -- _ <- maybeToList $ GHC.checkHomeUnitsClosed (hsc_unit_env hscEnv') (hsc_all_home_unit_ids hscEnv')+    ts <- forM cis $ \(df, targets) -> do+      -- evaluate $ liftRnf rwhnf targets++      let mk t = fromTargetId (importPaths df) exts (homeUnitId_ df) (GHC.targetId t)+      ctargets <- concatMapM mk targets++      return (L.nubOrdOn targetTarget ctargets)+    pure (hscEnv', concat ts)++data TargetDetails = TargetDetails+  { targetTarget :: Target+  -- ^ Simplified version of 'TargetId', storing enough information+  --+  , 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'.+  , targetUnitId :: UnitId+  -- ^ UnitId of 'targetTarget'.+  }+  deriving (Eq, Ord)++-- | A simplified view on a 'TargetId'.+--+-- Implements 'Ord' and 'Show' which can be convenient.+data Target = TargetModule ModuleName | TargetFile FilePath+  deriving ( Eq, Ord, Show )++-- | Turn a 'TargetDetails' into a 'GHC.Target'.+toGhcTarget :: TargetDetails -> GHC.Target+toGhcTarget (TargetDetails tid _ uid) = case tid of+  TargetModule modl -> GHC.Target (GHC.TargetModule modl) True uid Nothing+  TargetFile fp -> GHC.Target (GHC.TargetFile fp Nothing) True uid 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 is exts unitId (GHC.TargetModule modName) = do+    let fps = [i </> moduleNameSlashes modName -<.> ext <> boot+              | ext <- exts+              , i <- is+              , boot <- ["", "-boot"]+              ]+    return [TargetDetails (TargetModule modName) fps unitId]+-- For a 'TargetFile' we consider all the possible module names+fromTargetId _ _ unitId (GHC.TargetFile f _) = do+    let other+          | "-boot" `L.isSuffixOf` f = dropEnd 5 f+          | otherwise = (f ++ "-boot")+    return [TargetDetails (TargetFile f) [f, other] unitId]++-- ----------------------------------------------------------------------------+-- GHC Utils that should likely be exposed by GHC+-- ----------------------------------------------------------------------------++mkSimpleTarget :: DynFlags -> FilePath -> GHC.Target+mkSimpleTarget df fp = GHC.Target (GHC.TargetFile fp Nothing) True (homeUnitId_ df) Nothing++hscSetUnitEnv :: UnitEnv -> HscEnv -> HscEnv+hscSetUnitEnv ue env = env { hsc_unit_env = ue }++setWorkingDirectory :: FilePath -> DynFlags -> DynFlags+setWorkingDirectory p d = 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 i xs+    | i <= 0 = xs+    | otherwise = f xs (drop i xs)+    where f (a:as) (_:bs) = a : f as bs+          f _ _ = []