unique workingDirectory for each in-memory hdv

Author: Saizan

haskell-debugger.cabal

@@ -149,6 +149,7 @@ library
 
                       haskell-debugger-view >= 0.2 && < 1.0,
                       ghc-stack-annotations >=0.1 && <0.2,
+                      temporary,
 
     if !os(windows)
         build-depends: unix >= 2.8.6 && < 2.9,

haskell-debugger/GHC/Debugger/Monad.hs

@@ -34,6 +34,8 @@ import System.Posix.Signals
 import qualified Data.List as L
 import qualified Data.List.NonEmpty as NonEmpty
 
+import System.IO.Temp
+
 import GHC
 import GHC.Data.StringBuffer
 import GHC.Driver.Config.Diagnostic
@@ -255,7 +257,7 @@ runDebuggerAction :: forall a. LogAction IO DebuggerLog
   -> Ghc () -- ^ load home units action
   -> Debugger a
   -> Ghc a
-runDebuggerAction l rootDir extraGhcArgs conf loadHomeUnit (Debugger action) = flip MC.finally cleanupInterp $ -- See Note [Shutting down the external interpreter]
+runDebuggerAction l rootDir extraGhcArgs conf loadHomeUnit (Debugger action) = withSystemTempDirectory "haskell-debugger-view-in-memory" $ \ hdvWorkDir -> flip MC.finally cleanupInterp $ -- See Note [Shutting down the external interpreter]
   do
   dflags0 <- GHC.getSessionDynFlags
   let dflags1 = dflags0
@@ -329,7 +331,7 @@ runDebuggerAction l rootDir extraGhcArgs conf loadHomeUnit (Debugger action) = f
 #ifndef DEBUG_WITH_GHC
       -- Find haskell-debugger-view in (deps of) home units, or load one from
       -- in-memory sources.
-      (hdv_uid, loadedBuiltinModNames) <- findOrLoadHaskellDebuggerView l buildWays
+      (hdv_uid, loadedBuiltinModNames) <- findOrLoadHaskellDebuggerView l hdvWorkDir buildWays
 #else
       let hdv_uid = hsDebuggerViewInMemoryUnitId
       let loadedBuiltinModNames = [] :: [ModuleName]
@@ -393,9 +395,10 @@ runDebuggerAction l rootDir extraGhcArgs conf loadHomeUnit (Debugger action) = f
 
 
 findOrLoadHaskellDebuggerView :: LogAction IO DebuggerLog
+             -> FilePath
              -> Ways
              -> Ghc (UnitId, [ModuleName])
-findOrLoadHaskellDebuggerView l buildWays = do
+findOrLoadHaskellDebuggerView l hdvWorkDir buildWays = do
   let ghcLog = liftLogIO l
   hsc_env <- getSession
   let mod_graph_base = hsc_mod_graph hsc_env
@@ -408,7 +411,7 @@ findOrLoadHaskellDebuggerView l buildWays = do
 
       -- Add the custom unit to the HUG
       let base_dep_uids = [uid | UnitNode _ uid <- mg_mss mod_graph_base]
-      addInMemoryHsDebuggerViewUnit base_dep_uids . setDynFlagWays buildWays =<< getDynFlags
+      addInMemoryHsDebuggerViewUnit hdvWorkDir base_dep_uids . setDynFlagWays buildWays =<< getDynFlags
 
       -- Load unit modules using in-memory contents.
       let

haskell-debugger/GHC/Debugger/Session/Builtin.hs

@@ -33,6 +33,7 @@ import GHC.Data.StringBuffer
 import qualified GHC.Unit.Home.Graph as HUG
 import qualified GHC.Unit.Home.PackageTable as HPT
 import qualified GHC.Unit.State as State
+import GHC.Debugger.Session (setWorkingDirectory)
 
 --------------------------------------------------------------------------------
 -- * Built-in Modules
@@ -91,10 +92,11 @@ hsDebuggerViewInMemoryUnitId = toUnitId $ stringToUnit "haskell-debugger-view-in
 --  and add it to the HUG
 addInMemoryHsDebuggerViewUnit
   :: GhcMonad m
-  => [UnitId] -- ^ The unit-ids from the transitive dependencies closure of the user-given targets
+  => FilePath -- ^ workingDirectory for the unit
+  -> [UnitId] -- ^ The unit-ids from the transitive dependencies closure of the user-given targets
   -> DynFlags -- ^ Dynflags resulting from first downsweep of user given targets
   -> m ()
-addInMemoryHsDebuggerViewUnit base_uids initialDynFlags = do
+addInMemoryHsDebuggerViewUnit hdvWorkDir base_uids initialDynFlags = do
   let imhdv_dflags = initialDynFlags
         { homeUnitId_ = hsDebuggerViewInMemoryUnitId
         , importPaths = []
@@ -108,7 +110,7 @@ addInMemoryHsDebuggerViewUnit base_uids initialDynFlags = do
           , unitId /= ghcInternalUnitId
           ]
         , thisPackageName = Just "haskell-debugger-view"
-        }
+        } & setWorkingDirectory hdvWorkDir
         & setGeneralFlag' Opt_HideAllPackages
   hsc_env <- getSession
   let cached_unit_dbs = concat . catMaybes . fmap HUG.homeUnitEnv_unit_dbs $ Foldable.toList (hsc_HUG hsc_env)