hie-bios 0.20.0 → 0.21.0

raw patch · 25 files changed

+732/−315 lines, 25 filesdep +asyncdep +filelockdep +processPVP ok

version bump matches the API change (PVP)

Dependencies added: async, filelock, process

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• hie-bios.cabal +20/−3
• src/HIE/Bios.hs +4/−0
• src/HIE/Bios/Cradle.hs +31/−12
• src/HIE/Bios/Cradle/Cabal.hs +218/−108
• src/HIE/Bios/Cradle/Resolved.hs +2/−0
• src/HIE/Bios/Environment.hs +21/−13
• src/HIE/Bios/Ghc/Api.hs +6/−4
• src/HIE/Bios/Process.hs +17/−6
• src/HIE/Bios/Types.hs +25/−3
• tests/BiosTests.hs +216/−141
• tests/Utils.hs +40/−25
• tests/projects/cabal-with-custom-setup-old/a-with-custom/Setup.hs +2/−0
• tests/projects/cabal-with-custom-setup-old/a-with-custom/a-with-custom.cabal +15/−0
• tests/projects/cabal-with-custom-setup-old/a-with-custom/src/MyLib.hs +4/−0
• tests/projects/cabal-with-custom-setup-old/b/b.cabal +30/−0
• tests/projects/cabal-with-custom-setup-old/b/src/B.hs +6/−0
• tests/projects/cabal-with-custom-setup-old/b/tests/Main.hs +3/−0
• tests/projects/cabal-with-custom-setup-old/cabal.project +5/−0
• tests/projects/cabal-with-custom-setup/a-with-custom/Setup.hs +2/−0
• tests/projects/cabal-with-custom-setup/a-with-custom/a-with-custom.cabal +15/−0
• tests/projects/cabal-with-custom-setup/a-with-custom/src/MyLib.hs +4/−0
• tests/projects/cabal-with-custom-setup/b/b.cabal +24/−0
• tests/projects/cabal-with-custom-setup/b/src/B.hs +6/−0
• tests/projects/cabal-with-custom-setup/cabal.project +5/−0

@@ -1,5 +1,16 @@ # ChangeLog hie-bios +## 2026-07-30 - 0.21.0++* Add a CI timeout on tests ([#521](https://github.com/haskell/hie-bios/pull/521)).+* Consistently pass '--keep-temp-files' ([#519](https://github.com/haskell/hie-bios/pull/519)).+* Make cacheFile thread-safe using file locks ([#520](https://github.com/haskell/hie-bios/pull/520)).+* Make functions take the used cache directory explicitly ([#520](https://github.com/haskell/hie-bios/pull/520)).+  * Add *WithConfig functions.+  * Adjust existing functions to take a cache directory.+  * Replace thread-unsafety workaround of initSession' and+    initSessionWithMessage' with the cache directory argument.+ ## 2026-06-30 - 0.20.0  * Hide LoadMode in TestM ([#516](https://github.com/haskell/hie-bios/pull/516))

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: hie-bios-version: 0.20.0+version: 0.21.0 author: Matthew Pickering <matthewtpickering@gmail.com>, Hannes Siebenhandl <fendor.haskell@gmail.com> maintainer: Hannes Siebenhandl <fendor.haskell@gmail.com> license: BSD-3-Clause@@ -10,10 +10,24 @@ description: Set up a GHC API session and obtain flags required to compile a source file category: Development build-type: Simple-extra-doc-files: ChangeLog.md-extra-source-files:+extra-doc-files:+  ChangeLog.md   README.md+extra-source-files:   tests/configs/*.yaml+  tests/projects/cabal-with-custom-setup-old/a-with-custom/a-with-custom.cabal+  tests/projects/cabal-with-custom-setup-old/a-with-custom/Setup.hs+  tests/projects/cabal-with-custom-setup-old/a-with-custom/src/MyLib.hs+  tests/projects/cabal-with-custom-setup-old/b/b.cabal+  tests/projects/cabal-with-custom-setup-old/b/src/B.hs+  tests/projects/cabal-with-custom-setup-old/b/tests/Main.hs+  tests/projects/cabal-with-custom-setup-old/cabal.project+  tests/projects/cabal-with-custom-setup/a-with-custom/a-with-custom.cabal+  tests/projects/cabal-with-custom-setup/a-with-custom/Setup.hs+  tests/projects/cabal-with-custom-setup/a-with-custom/src/MyLib.hs+  tests/projects/cabal-with-custom-setup/b/b.cabal+  tests/projects/cabal-with-custom-setup/b/src/B.hs+  tests/projects/cabal-with-custom-setup/cabal.project   tests/projects/cabal-with-ghc-and-project/cabal-with-ghc.cabal   tests/projects/cabal-with-ghc-and-project/cabal.project.extra   tests/projects/cabal-with-ghc-and-project/hie.yaml@@ -191,6 +205,7 @@     exceptions ^>=0.10,     extra >=1.6.14 && <1.9,     file-embed >=0.0.11 && <1,+    filelock >=0.1.1 && <0.2,     filepath >=1.4.1 && <1.6,     ghc >=9.2.1 && <10.2,     prettyprinter ^>=1.6 || ^>=1.7.0,@@ -242,6 +257,7 @@   type: exitcode-stdio-1.0   default-language: Haskell2010   build-depends:+    async,     base,     co-log-core,     directory,@@ -250,6 +266,7 @@     ghc,     hie-bios,     prettyprinter,+    process,     tasty,     tasty-expected-failure,     tasty-hunit,

@@ -14,7 +14,11 @@   , CradleError(..)   , findCradle   , loadCradle+  , loadCradleWithConfig   , loadImplicitCradle+  , loadImplicitCradleWithConfig+  , CradleRunConfig(..)+  , defaultCradleRunConfig   , defaultCradle   -- * Compiler Options   , ComponentOptions(..)

@@ -7,7 +7,11 @@ module HIE.Bios.Cradle (       findCradle     , loadCradle+    , loadCradleWithConfig     , loadImplicitCradle+    , loadImplicitCradleWithConfig+    , CradleRunConfig(..)+    , defaultCradleRunConfig     , yamlConfig     , defaultCradle     , isCabalCradle@@ -19,6 +23,7 @@     , isDefaultCradle     , isOtherCradle     , getCradle+    , getCradleWithConfig     , Process.readProcessWithOutputs     , Process.readProcessWithCwd     , makeCradleResult@@ -49,6 +54,7 @@ import System.IO.Temp  import HIE.Bios.Config+import HIE.Bios.Environment (resolveCacheDir) import HIE.Bios.Types hiding (ActionName(..)) import qualified HIE.Bios.Process as Process import qualified HIE.Bios.Types as Types@@ -77,32 +83,45 @@  -- | Given root\/hie.yaml load the Cradle. loadCradle :: LogAction IO (WithSeverity Log) -> FilePath -> IO (Cradle Void)-loadCradle l = loadCradleWithOpts l absurd+loadCradle l = loadCradleWithConfig l defaultCradleRunConfig +-- | 'loadCradle' with an explicit 'CradleRunConfig'.+loadCradleWithConfig :: LogAction IO (WithSeverity Log) -> CradleRunConfig -> FilePath -> IO (Cradle Void)+loadCradleWithConfig l config = loadCradleWithOpts l config absurd+ -- | Given root\/foo\/bar.hs, load an implicit cradle loadImplicitCradle :: Show a => LogAction IO (WithSeverity Log) -> FilePath -> IO (Cradle a)-loadImplicitCradle l wfile = do+loadImplicitCradle l = loadImplicitCradleWithConfig l defaultCradleRunConfig++-- | 'loadImplicitCradle' with an explicit 'CradleRunConfig'.+loadImplicitCradleWithConfig :: Show a => LogAction IO (WithSeverity Log) -> CradleRunConfig -> FilePath -> IO (Cradle a)+loadImplicitCradleWithConfig l config wfile = do   let wdir = takeDirectory wfile   cfg <- runMaybeT (implicitConfig wdir)   case cfg of-    Just bc -> getCradle l absurd bc+    Just bc -> getCradleWithConfig l config absurd bc     Nothing -> return $ defaultCradle l wdir  -- | Finding 'Cradle'. --   Find a cabal file by tracing ancestor directories. --   Find a sandbox according to a cabal sandbox config --   in a cabal directory.-loadCradleWithOpts :: (Yaml.FromJSON b, Show a) => LogAction IO (WithSeverity Log) -> (b -> CradleAction a) -> FilePath -> IO (Cradle a)-loadCradleWithOpts l buildCustomCradle wfile = do+loadCradleWithOpts :: (Yaml.FromJSON b, Show a) => LogAction IO (WithSeverity Log) -> CradleRunConfig -> (b -> CradleAction a) -> FilePath -> IO (Cradle a)+loadCradleWithOpts l config buildCustomCradle wfile = do     cradleConfig <- readCradleConfig wfile     l <& WithSeverity (LogAny $ T.pack $ "Cradle Config: " ++ show cradleConfig) Debug-    getCradle l buildCustomCradle (cradleConfig, takeDirectory wfile)+    getCradleWithConfig l config buildCustomCradle (cradleConfig, takeDirectory wfile)  getCradle :: Show a => LogAction IO (WithSeverity Log) ->  (b -> CradleAction a) -> (CradleConfig b, FilePath) -> IO (Cradle a)-getCradle l buildCustomCradle (cc, wdir) = do+getCradle l = getCradleWithConfig l defaultCradleRunConfig++-- | 'getCradle' with an explicit 'CradleRunConfig'.+getCradleWithConfig :: Show a => LogAction IO (WithSeverity Log) -> CradleRunConfig -> (b -> CradleAction a) -> (CradleConfig b, FilePath) -> IO (Cradle a)+getCradleWithConfig l config buildCustomCradle (cc, wdir) = do     rcs <- canonicalizeResolvedCradles wdir cs     liftIO $ l <& WithSeverity (LogAny . T.pack $ "Resolved Cradles " ++ show ((fmap . fmap) (const ()) rcs)) Debug-    resolvedCradlesToCradle l buildCustomCradle wdir rcs+    cacheDir <- resolveCacheDir "" (cradleCacheDir config)+    resolvedCradlesToCradle l buildCustomCradle wdir cacheDir rcs   where     cs = resolveCradleTree wdir cc @@ -114,8 +133,8 @@       (\(ComponentOptions os' dir ds) -> CradleSuccess (ComponentOptions os' dir (ds `union` deps)))  -resolvedCradlesToCradle :: Show a => LogAction IO (WithSeverity Log) -> (b -> CradleAction a) -> FilePath -> [ResolvedCradle b] -> IO (Cradle a)-resolvedCradlesToCradle logger buildCustomCradle root cs = mdo+resolvedCradlesToCradle :: Show a => LogAction IO (WithSeverity Log) -> (b -> CradleAction a) -> FilePath -> CacheDir -> [ResolvedCradle b] -> IO (Cradle a)+resolvedCradlesToCradle logger buildCustomCradle root cacheDir cs = mdo   let run_ghc_cmd args =         -- We're being lazy here and just returning the ghc path for the         -- first non-none cradle. This shouldn't matter in practice: all@@ -127,7 +146,7 @@               act               args   versions <- makeVersions logger root run_ghc_cmd-  let rcs = ResolvedCradles root cs versions+  let rcs = ResolvedCradles root cs versions cacheDir       cradleActions = [ (c, resolveCradleAction logger buildCustomCradle rcs root c) | c <- cs ]       err_msg (TargetWithContext fp fps)         = ["Multi Cradle: No prefixes matched"@@ -563,7 +582,7 @@   logCradleHasNoSupportForLoadFileWithContext l loadStyle "stack"   let ghcProc args = proc "stack" (stackYamlProcessArgs syaml <> ["exec", "ghc", "--"] <> args)   -- Same wrapper works as with cabal-  wrapper_fp <- withGhcWrapperTool l ghcProc workDir+  wrapper_fp <- withGhcWrapperTool l (cradleCacheDirResolved cs) ghcProc workDir   let     fallback = [ comp | Just comp <- [mc] ]     componentsToLoad = nubOrd <$> mconcat

@@ -40,7 +40,6 @@ import Data.Version  import HIE.Bios.Config-import HIE.Bios.Environment (getCacheDir) import HIE.Bios.Types hiding (ActionName(..)) import HIE.Bios.Wrappers import qualified HIE.Bios.Process as Process@@ -158,19 +157,11 @@       pure LoadFile     _ -> pure loadStyle -  (cabalArgs, loadingFiles, extraDeps) <- processCabalLoadMode l cradles projectFile workDir mc fp determinedLoadMode--  cabalFeatures <- determineCabalLoadFeature progVersions-  let-    -- Used for @cabal >= 3.15@ but @lib:Cabal <3.15@, in custom setups.-    mkFallbackCabalProc = cabalLoadFilesBefore315 l progVersions projectFile workDir cabalArgs-  cabalProc <- case cabalFeatures of-    CabalWithRepl -> cabalLoadFilesWithRepl l projectFile workDir cabalArgs-    CabalWithGhcShimWrapper -> cabalLoadFilesBefore315 l progVersions projectFile workDir cabalArgs+  (cabalArgs, loadingFiles, extraDeps) <- processCabalLoadMode l cradles progVersions projectFile workDir mc fp determinedLoadMode -  mResult <- runCabalToGetGhcOptions cabalProc mkFallbackCabalProc+  mResult <- runCabalToGetGhcOptions progVersions cabalArgs   case mResult of-    Left (code, errorDetails) -> do+    Left (cabalProc, code, errorDetails) -> do       -- Provide some dependencies an IDE can look for to trigger a reload.       -- Best effort. Assume the working directory is the       -- root of the component, so we are right in trivial cases at least.@@ -198,10 +189,9 @@             }         Just (componentDir, ghc_args) -> do           deps <- liftIO $ cabalCradleDependencies projectFile workDir componentDir-          usesResponseFiles <- usesResponseFilesForAllGhcOptions progVersions-          final_args <- case usesResponseFiles of-            True -> liftIO $ expandGhcOptionResponseFile ghc_args-            False -> pure ghc_args+          final_args <- case loadModeUsesResponseFiles cabalArgs of+            UsesResponseFiles -> liftIO $ expandGhcOptionResponseFile ghc_args+            NoResponseFiles -> pure ghc_args           CradleLoadResultT $ pure $ CradleSuccess             ComponentOptions               { componentOptions = final_args@@ -209,19 +199,67 @@               , componentDependencies = nubOrd (deps <> extraDeps)               }   where-    -- | Run the given cabal process to obtain ghc options.-    -- In the special case of 'cabal >= 3.15' but 'lib:Cabal <3.15' (via custom-setups),-    -- we gracefully fall back to the given action to create an alternative cabal process which-    -- we use to find the ghc options.+    -- | Try to obtain the ghc options using cabal.+    --+    -- First, we try what the user requested and what cabal supports.+    -- For example, if the user requested to load multiple components at once, and cabal+    -- is recent enough, we try to use @--with-repl --enable-multi-repl@.+    -- We detect when certain cabal features are not supported. For example, for old+    -- lib:Cabal versions, @--with-repl@ is not supported. In this case, we parse the error message+    -- and fall back to the old `CabalWithGhcShimWrapper` version.+    -- The ghc shim @--with-ghc@ might work with @--keep-temp-files@ if no custom cabal package is part+    -- of the repl session, so we try to load that, and as a last resort, fall back to single component loading.     runCabalToGetGhcOptions ::-      Process.CreateProcess ->-      CradleLoadResultT IO Process.CreateProcess ->+      ProgramVersions ->+      LoadModeTargets ->       CradleLoadResultT IO         (Either-          (Int, ProcessErrorDetails)+          (CreateProcess, Int, ProcessErrorDetails)           ([String], ProcessErrorDetails)         )-    runCabalToGetGhcOptions cabalProc mkFallbackCabalProc = do+    runCabalToGetGhcOptions progVersions cabalArgs = do+      cabalFeatures <- determineCabalLoadFeature progVersions+      let+        cacheDir = cradleCacheDirResolved cradles+        -- The preferred way of loading ghc-options. Requires cabal 3.16+        cabalWithReplProc = cabalLoadFilesWithRepl l cacheDir projectFile workDir cabalArgs+        -- Legacy way of loading ghc-options.+        -- Supports multi-repl and the deprecated single file mode.+        cabalWithGhcShimWrapper = cabalLoadFilesBefore315 l cacheDir progVersions projectFile workDir cabalArgs+        -- Legacy way of loading ghc-options.+        -- This should only be used for project with Custom setups that are older than lib:Cabal 3.16.+        cabalWithGhcShimWrapperSingleTarget = cabalLoadFilesBefore315 l cacheDir progVersions projectFile workDir (demoteToSingleLoadModeTarget cabalArgs)++      cabalProc <- case cabalFeatures of+        CabalWithRepl -> cabalWithReplProc+        CabalWithGhcShimWrapper -> cabalWithGhcShimWrapper++      loadResult <- getCabalGhcOptions cabalProc+      case loadResult of+        -- Some fallback+        Left (_, _, details)+          -- Used for @cabal >= 3.15@ but @lib:Cabal <3.15@, in custom setups.+          | isCabalLibraryInProjectTooOld (processStderr details) -> do+              liftIO $ l <& WithSeverity (LogWithReplNotSupported (processStderr details)) Debug+              shimResult <- getCabalGhcOptions =<< cabalWithGhcShimWrapper+              case shimResult of+                Left (_, _, shimDetails)+                  | checkKeepTempFilesIsNotSupported shimDetails -> do+                    liftIO $ l <& WithSeverity (LogKeepTempFilesNotSupported (processStdout shimDetails <> processStderr shimDetails)) Debug+                    getCabalGhcOptions =<< cabalWithGhcShimWrapperSingleTarget+                _ ->+                  pure shimResult++          | checkKeepTempFilesIsNotSupported details -> do+              liftIO $ l <& WithSeverity (LogKeepTempFilesNotSupported (processStdout details <> processStderr details)) Debug+              getCabalGhcOptions =<< cabalWithGhcShimWrapperSingleTarget++        Left codeAndDetails -> do+          pure $ Left codeAndDetails+        Right argsAndDetails ->+          pure $ Right argsAndDetails++    getCabalGhcOptions cabalProc = do       (ex, output, stde, [(_, maybeArgs)]) <- liftIO $ Process.readProcessWithOutputs [hie_bios_output] l workDir cabalProc       let args = fromMaybe [] maybeArgs       let errorDetails = ProcessErrorDetails@@ -232,51 +270,49 @@             , processHieBiosEnvironment = hieBiosProcessEnv cabalProc             }       case ex of-        ExitFailure{} | isCabalLibraryInProjectTooOld stde -> do-          liftIO $ l <& WithSeverity (LogCabalLibraryTooOld stde) Debug-          fallbackCabalProc <- mkFallbackCabalProc-          runCabalToGetGhcOptions fallbackCabalProc mkFallbackCabalProc         ExitFailure code -> do--          pure $ Left (code, errorDetails)+          pure $ Left (cabalProc, code, errorDetails)         ExitSuccess ->           pure $ Right (args, errorDetails) +    checkKeepTempFilesIsNotSupported details =+      -- See https://github.com/haskell/cabal/issues/12178 why we check stdout and stderr.+      -- This is a forward compatible check to make sure this won't break accidentally in the future once+      -- this ticket is fixed.+      isKeepTempFilesNotSupported (processStdout details) || isKeepTempFilesNotSupported (processStderr details)  runCabalGhcCmd :: ResolvedCradles a -> FilePath -> LogAction IO (WithSeverity Log) -> CradleProjectConfig -> [String] -> IO (CradleLoadResult String) runCabalGhcCmd cs wdir l projectFile args = runCradleResultT $ do   let vs = cradleProgramVersions cs-  callCabalPathForCompilerPath l vs wdir projectFile >>= \case+  callCabalPathForCompilerPath l (cradleCacheDirResolved cs) vs wdir projectFile >>= \case     Just p -> Process.readProcessWithCwd_ l wdir p args ""     Nothing -> do-      buildDir <- liftIO $ cabalBuildDir wdir+      buildDir <- liftIO $ cabalBuildDir (cradleCacheDirResolved cs) wdir       -- Workaround for a cabal-install bug on 3.0.0.0:       -- ./dist-newstyle/tmp/environment.-24811: createDirectory: does not exist (No such file or directory)       liftIO $ createDirectoryIfMissing True (buildDir </> "tmp")       -- Need to pass -v0 otherwise we get "resolving dependencies..."-      cabalProc <- cabalExecGhc l vs projectFile wdir args+      cabalProc <- cabalExecGhc l (cradleCacheDirResolved cs) vs projectFile wdir args       Process.readProcessWithCwd' l cabalProc "" -data LoadUnits = Inferred | FromCradle-  deriving Eq--processCabalLoadMode :: MonadIO m => LogAction IO (WithSeverity Log) -> ResolvedCradles a -> CradleProjectConfig -> [Char] -> Maybe FilePath -> TargetWithContext -> LoadMode -> m ([FilePath], [FilePath], [FilePath])-processCabalLoadMode l cradles projectFile workDir mc fpc loadStyle = do+processCabalLoadMode :: MonadIO m => LogAction IO (WithSeverity Log) -> ResolvedCradles a -> ProgramVersions -> CradleProjectConfig -> [Char] -> Maybe FilePath -> TargetWithContext -> LoadMode -> m (LoadModeTargets, [FilePath], [FilePath])+processCabalLoadMode l cradles progVersions projectFile workDir mc fpc loadStyle = do+  usesResponseFiles <- usesResponseFilesForAllGhcOptions progVersions   (cabalArgs, loadingFiles, extraDeps) <- case loadStyle of-        LoadFile -> pure ([fpModule], [fp], [])+        LoadFile -> pure (SingleTarget fpModule usesResponseFiles, [fp], [])         LoadFileWithContext  -> do           let fps = targetContext fpc           (modPairs, mergedDeps) <- moduleFilesFromSameProject fps-          let allModPairs = nubOrd $ (fpModule, fp) : modPairs-              allModules  = nubOrd $ fmap fst allModPairs-              allFiles    = nubOrd $ fmap snd allModPairs-          pure (["--enable-multi-repl"] ++ allModules, allFiles, mergedDeps)-        LoadUnitsInferred    -> loadUnits Inferred-        LoadUnitsFromCradle  -> loadUnits FromCradle+          let+            extraModules =      fmap fst modPairs+            allFiles     = fp : fmap snd modPairs+          pure (MultipleTargets fpModule extraModules NoExtraComponents usesResponseFiles, allFiles, mergedDeps)+        LoadUnitsInferred    -> loadUnits usesResponseFiles Inferred+        LoadUnitsFromCradle  -> loadUnits usesResponseFiles FromCradle    liftIO $ l <& LogComputedCradleLoadMode "cabal" fpc loadStyle `WithSeverity` Info   liftIO $ l <& LogCabalLoad fp mc (prefix <$> resolvedCradles cradles) loadingFiles `WithSeverity` Debug-  pure (cabalArgs, loadingFiles, extraDeps)+  pure (cabalArgs, nubOrd loadingFiles, extraDeps)   where     fpModule = fromMaybe (fixTargetPath fp) mc     fp = targetFilePath fpc@@ -320,7 +356,7 @@       let mergedDeps = nubOrd $ dynDeps ++ concat [ depsYaml | (_, _, depsYaml) <- selected ]       pure ([comp | (comp,_,_) <- selected], mergedDeps) -    loadUnits whichUnits0 = do+    loadUnits usesResponseFiles whichUnits0 = do       let         componentsToLoad = do           guard (whichUnits0 == FromCradle)@@ -343,32 +379,35 @@        let fps = targetContext fpc       (modPairs, mergedDeps0) <- moduleFilesFromSameProject fps-      let allModPairs = nubOrd $ (fpModule, fp) : modPairs-          allModules  = nubOrd $ fmap fst allModPairs-          allFiles    = nubOrd $ fmap snd allModPairs+      let+        extraModules = nubOrd $      fmap fst modPairs+        allFiles     = nubOrd $ fp : fmap snd modPairs       let mergedDeps = mergedDeps0 ++ compDeps-      let compArgs = case whichUnits of-            (Inferred,_) -> enableFlags ++ ["all"]-              where-                enableFlags = case projectFile of-                  NoExplicitConfig-                    -> ["--enable-tests","--enable-benchmarks"]-                  _ -> []-            (FromCradle,units) -> units-      pure (["--enable-multi-repl"] ++ compArgs ++ allModules, allFiles, mergedDeps)+      let+        extraComponents = case fst whichUnits of+            Inferred -> case projectFile of+              NoExplicitConfig -> LoadTestsAndBenchmarks+              ExplicitConfig{} -> NoExtraComponents+            FromCradle -> NoExtraComponents -cabalLoadFilesWithRepl :: LogAction IO (WithSeverity Log) -> CradleProjectConfig -> FilePath -> [String] -> CradleLoadResultT IO CreateProcess-cabalLoadFilesWithRepl l projectFile workDir args = do-  buildDir <- liftIO $ cabalBuildDir workDir+        withExtraTargets targetFiles = case whichUnits of+          (Inferred, _) -> "all" : targetFiles+          (FromCradle, units) -> units ++ targetFiles++      pure (MultipleTargets fpModule (withExtraTargets extraModules) extraComponents usesResponseFiles, fp:allFiles, mergedDeps)++cabalLoadFilesWithRepl :: LogAction IO (WithSeverity Log) -> CacheDir -> CradleProjectConfig -> FilePath -> LoadModeTargets -> CradleLoadResultT IO CreateProcess+cabalLoadFilesWithRepl l cacheDir projectFile workDir args = do+  buildDir <- liftIO $ cabalBuildDir cacheDir workDir   newEnvironment <- liftIO Process.getCleanEnvironment-  wrapper_fp <- liftIO $ withReplWrapperTool l (proc "ghc") workDir+  wrapper_fp <- liftIO $ withReplWrapperTool l cacheDir (proc "ghc") workDir   let     cabalCommand = "v2-repl"     cabalArgs =       -- Don't clobber the user's 'dist-newstyle': pass --builddir (#501)         [ "--builddir=" <> buildDir-        , cabalCommand, "--keep-temp-files", "--with-repl", wrapper_fp-        ] <> projectFileProcessArgs projectFile <> args+        , cabalCommand, "--with-repl", wrapper_fp+        ] <> projectFileProcessArgs projectFile <> renderLoadModeTargets CabalWithRepl args   pure $     (proc "cabal" cabalArgs)       { env = Just newEnvironment@@ -447,15 +486,10 @@ -- them. -- ---------------------------------------------------------------------------- -cabalLoadFilesBefore315 :: LogAction IO (WithSeverity Log) -> ProgramVersions -> CradleProjectConfig -> [Char] -> [String] -> CradleLoadResultT IO CreateProcess-cabalLoadFilesBefore315 l progVersions projectFile workDir args' = do+cabalLoadFilesBefore315 :: LogAction IO (WithSeverity Log) -> CacheDir -> ProgramVersions -> CradleProjectConfig -> [Char] -> LoadModeTargets -> CradleLoadResultT IO CreateProcess+cabalLoadFilesBefore315 l cacheDir progVersions projectFile workDir args = do   let cabalCommand = "v2-repl"-  cabal_version <- liftIO $ runCachedIO $ cabalVersion progVersions--  let args = case cabal_version of-        Just v | v < makeVersion [3,15] -> "--keep-temp-files" : args'-        _ -> args'-  cabalProcess l progVersions projectFile workDir cabalCommand args `modCradleError` \err -> do+  cabalProcess l cacheDir progVersions projectFile workDir cabalCommand (renderLoadModeTargets CabalWithGhcShimWrapper args) `modCradleError` \err -> do     deps <- cabalCradleDependencies projectFile workDir workDir     pure $ err {cradleErrorDependencies = cradleErrorDependencies err ++ deps} @@ -468,15 +502,15 @@ -- to the custom ghc wrapper via 'hie_bios_ghc' environment variable which -- the custom ghc wrapper may use as a fallback if it can not respond to certain -- queries, such as ghc version or location of the libdir.-cabalProcess :: LogAction IO (WithSeverity Log) -> ProgramVersions -> CradleProjectConfig -> FilePath -> String -> [String] -> CradleLoadResultT IO CreateProcess-cabalProcess l vs cabalProject workDir command args = do-  ghcDirs@(ghcBin, libdir) <- callCabalPathForCompilerPath l vs workDir cabalProject >>= \case+cabalProcess :: LogAction IO (WithSeverity Log) -> CacheDir -> ProgramVersions -> CradleProjectConfig -> FilePath -> String -> [String] -> CradleLoadResultT IO CreateProcess+cabalProcess l cacheDir vs cabalProject workDir command args = do+  ghcDirs@(ghcBin, libdir) <- callCabalPathForCompilerPath l cacheDir vs workDir cabalProject >>= \case     Just p -> do       libdir <- Process.readProcessWithCwd_ l workDir p ["--print-libdir"] ""       pure (p, trimEnd libdir)     Nothing -> cabalGhcDirs l cabalProject workDir -  ghcPkgPath <- liftIO $ withGhcPkgTool ghcBin libdir+  ghcPkgPath <- liftIO $ withGhcPkgTool cacheDir ghcBin libdir   newEnvironment <- liftIO $ setupEnvironment ghcDirs   cabalProc <- liftIO $ setupCabalCommand ghcPkgPath   pure $ (cabalProc@@ -495,8 +529,8 @@      setupCabalCommand :: FilePath -> IO CreateProcess     setupCabalCommand ghcPkgPath = do-      wrapper_fp <- withGhcWrapperTool l (proc "ghc") workDir-      buildDir <- cabalBuildDir workDir+      wrapper_fp <- withGhcWrapperTool l cacheDir (proc "ghc") workDir+      buildDir <- cabalBuildDir cacheDir workDir       let extraCabalArgs =             [ "--builddir=" <> buildDir             , command@@ -555,8 +589,8 @@ -- -- Here, we restore the wrapper-shims, if necessary, thus the returned filepath -- can be passed to 'cabal' without further modifications.-withGhcPkgTool :: FilePath -> FilePath -> IO FilePath-withGhcPkgTool ghcPathAbs libdir = do+withGhcPkgTool :: CacheDir -> FilePath -> FilePath -> IO FilePath+withGhcPkgTool cacheDir ghcPathAbs libdir = do   let ghcName = takeFileName ghcPathAbs       -- TODO: check for existence       ghcPkgPath = guessGhcPkgFromGhc ghcName@@ -592,7 +626,7 @@                       ]             ]           srcHash = show (fingerprintString contents)-      cacheFile "ghc-pkg" srcHash $ \wrapperFp -> writeFile wrapperFp contents+      cacheFileIn cacheDir "ghc-pkg" srcHash $ \wrapperFp -> writeFile wrapperFp contents      -- Escape the filepath and trim excess newlines added by 'escapeArgs'     escapeFilePath fp = trimEnd $ escapeArgs [fp]@@ -607,9 +641,9 @@ -- | Generate a fake GHC that can be passed to cabal or stack -- when run with --interactive, it will print out its -- command-line arguments and exit-withGhcWrapperTool :: LogAction IO (WithSeverity Log) -> GhcProc -> FilePath -> IO FilePath-withGhcWrapperTool l mkGhcCall wdir = do-  withWrapperTool l mkGhcCall wdir "wrapper" cabalWrapperHs cabalWrapper+withGhcWrapperTool :: LogAction IO (WithSeverity Log) -> CacheDir -> GhcProc -> FilePath -> IO FilePath+withGhcWrapperTool l cacheDir mkGhcCall wdir = do+  withWrapperTool l cacheDir mkGhcCall wdir "wrapper" cabalWrapperHs cabalWrapper  -- | Generate a script/binary that can be passed to cabal's '--with-repl'. -- On windows, this compiles a Haskell file, while on other systems, we persist@@ -617,16 +651,16 @@ -- -- 'GhcProc' is unused on other platforms. ---withReplWrapperTool :: LogAction IO (WithSeverity Log) -> GhcProc -> FilePath -> IO FilePath-withReplWrapperTool l mkGhcCall wdir =-  withWrapperTool l mkGhcCall wdir "repl-wrapper" cabalWithReplWrapperHs cabalWithReplWrapper+withReplWrapperTool :: LogAction IO (WithSeverity Log) -> CacheDir -> GhcProc -> FilePath -> IO FilePath+withReplWrapperTool l cacheDir mkGhcCall wdir =+  withWrapperTool l cacheDir mkGhcCall wdir "repl-wrapper" cabalWithReplWrapperHs cabalWithReplWrapper -withWrapperTool :: LogAction IO (WithSeverity Log) -> GhcProc -> String -> FilePath -> String -> String -> IO FilePath-withWrapperTool l mkGhcCall wdir baseName windowsWrapper unixWrapper = do+withWrapperTool :: LogAction IO (WithSeverity Log) -> CacheDir -> GhcProc -> String -> FilePath -> String -> String -> IO FilePath+withWrapperTool l cacheDir mkGhcCall wdir baseName windowsWrapper unixWrapper = do   let wrapperContents = if isWindows then windowsWrapper else unixWrapper       withExtension fp = if isWindows then fp <.> "exe" else fp       srcHash = show (fingerprintString wrapperContents)-  cacheFile (withExtension baseName) srcHash $ \wrapper_fp ->+  cacheFileIn cacheDir (withExtension baseName) srcHash $ \wrapper_fp ->     if isWindows     then       withSystemTempDirectory "hie-bios" $ \ tmpDir -> do@@ -657,13 +691,13 @@ -- cabal locations -- ---------------------------------------------------------------------------- --- | Given the root directory, get the build dir we are using for cabal--- In the `hie-bios` cache directory-cabalBuildDir :: FilePath -> IO FilePath-cabalBuildDir workDir = do+-- | Given the cache root and the work directory, get the build dir we are+-- using for cabal.+cabalBuildDir :: CacheDir -> FilePath -> IO FilePath+cabalBuildDir (CacheDir cacheDir) workDir = do   abs_work_dir <- makeAbsolute workDir   let dirHash = show (fingerprintString abs_work_dir)-  getCacheDir ("dist-" <> filter (not . isSpace) (takeBaseName abs_work_dir)<>"-"<>dirHash)+  pure $ cacheDir </> ("dist-" <> filter (not . isSpace) (takeBaseName abs_work_dir)<>"-"<>dirHash)  -- |Find .cabal files in the given directory. --@@ -678,16 +712,16 @@ -- cabal process wrappers and helpers -- ---------------------------------------------------------------------------- -cabalExecGhc :: LogAction IO (WithSeverity Log) -> ProgramVersions -> CradleProjectConfig -> FilePath -> [String] -> CradleLoadResultT IO CreateProcess-cabalExecGhc l vs projectFile wdir args = do-  cabalProcess l vs projectFile wdir "v2-exec" $ ["ghc", "-v0", "--"] ++ args+cabalExecGhc :: LogAction IO (WithSeverity Log) -> CacheDir -> ProgramVersions -> CradleProjectConfig -> FilePath -> [String] -> CradleLoadResultT IO CreateProcess+cabalExecGhc l cacheDir vs projectFile wdir args = do+  cabalProcess l cacheDir vs projectFile wdir "v2-exec" $ ["ghc", "-v0", "--"] ++ args -callCabalPathForCompilerPath :: LogAction IO (WithSeverity Log) -> ProgramVersions -> FilePath -> CradleProjectConfig -> CradleLoadResultT IO (Maybe FilePath)-callCabalPathForCompilerPath l vs workDir projectFile = do+callCabalPathForCompilerPath :: LogAction IO (WithSeverity Log) -> CacheDir -> ProgramVersions -> FilePath -> CradleProjectConfig -> CradleLoadResultT IO (Maybe FilePath)+callCabalPathForCompilerPath l cacheDir vs workDir projectFile = do   isCabalPathSupported vs >>= \case     False -> pure Nothing     True -> do-      buildDir <- liftIO $ cabalBuildDir workDir+      buildDir <- liftIO $ cabalBuildDir cacheDir workDir       let         args = [ "--builddir=" <> buildDir, "path", "--output-format=json" ]             <> projectFileProcessArgs projectFile@@ -705,10 +739,46 @@ -- Version and cabal capability checks -- ---------------------------------------------------------------------------- +data LoadUnits = Inferred | FromCradle+  deriving Eq++data WithTestsAndBenchmarks+  = NoExtraComponents+  | LoadTestsAndBenchmarks++data LoadModeTargets+  = SingleTarget+      String+      -- ^ Main Target FilePath or component+      UsesResponseFiles+      -- ^ Is this going to use top-level response files?+  | MultipleTargets+      String+      -- ^ Main Target FilePath or component+      [String]+      -- ^ Extra targets to load alongside the main component+      WithTestsAndBenchmarks+      -- ^ Should we enable tests and benchmarks as well?+      UsesResponseFiles+      -- ^ Is this going to use top-level response files?++loadModeUsesResponseFiles :: LoadModeTargets -> UsesResponseFiles+loadModeUsesResponseFiles = \ case+  SingleTarget _ usesResponseFiles -> usesResponseFiles+  MultipleTargets _ _ _ usesResponseFiles -> usesResponseFiles++demoteToSingleLoadModeTarget :: LoadModeTargets -> LoadModeTargets+demoteToSingleLoadModeTarget (MultipleTargets mainTarget _ _ _) = SingleTarget mainTarget NoResponseFiles+demoteToSingleLoadModeTarget (SingleTarget mainTarget _) = SingleTarget mainTarget NoResponseFiles+ data CabalLoadFeature   = CabalWithRepl   | CabalWithGhcShimWrapper +data UsesResponseFiles+  = UsesResponseFiles+  | NoResponseFiles+ determineCabalLoadFeature :: MonadIO m => ProgramVersions -> m CabalLoadFeature determineCabalLoadFeature vs = do   cabal_version <- liftIO $ runCachedIO $ cabalVersion vs@@ -738,17 +808,21 @@ -- Then, later on in `cabal-3.17`, we use response files again. -- -- 'usesResponseFilesForAllGhcOptions' encodes all of this history.-usesResponseFilesForAllGhcOptions :: MonadIO m => ProgramVersions -> m Bool+usesResponseFilesForAllGhcOptions :: MonadIO m => ProgramVersions -> m UsesResponseFiles usesResponseFilesForAllGhcOptions vs = do   cabal_version <- liftIO $ runCachedIO $ cabalVersion vs   -- determine which load style is supported by this cabal cradle.   case cabal_version of     Just ver-      | ver >= makeVersion [3, 15] && ver <= makeVersion [3, 16, 0, 0] -> pure True-      | ver >= makeVersion [3, 17] -> pure True-      | otherwise -> pure False-    _ -> pure False+      | ver >= makeVersion [3, 15] && ver <= makeVersion [3, 16, 0, 0] -> pure UsesResponseFiles+      | ver >= makeVersion [3, 17] -> pure UsesResponseFiles+      | otherwise -> pure NoResponseFiles+    _ -> pure NoResponseFiles +renderResponseFileArgs :: UsesResponseFiles -> [[Char]]+renderResponseFileArgs = \ case+  UsesResponseFiles -> ["--keep-temp-files"]+  NoResponseFiles -> []  -- | When @cabal repl --with-repl@ is called in a project with a custom setup which forces -- an older @lib:Cabal@ version, then the error message looks roughly like:@@ -766,8 +840,23 @@ -- by using a @lib:Cabal@ version that doesn't support the @--with-repl@ flag. isCabalLibraryInProjectTooOld :: [String] -> Bool isCabalLibraryInProjectTooOld stderr =-  "constraint from --with-repl requires >=3.15" `isInfixOf` unlines stderr+  any ("constraint from --with-repl requires >=3.15" `isInfixOf`) stderr +-- | Some @cabal@ versions don't support @--keep-temp-files@+--+-- @+--  Configuring a-with-custom-0.1.0.0...+--  unrecognized 'repl' option `--keep-temp-files'+-- @+--+-- Can also occur with 'configure'.+--+-- We do a quick and dirty string comparison to check whether the error message looks like it has been caused+-- by using a @--keep-temp-files@ version that doesn't support the @--keep-temp-files@ flag.+isKeepTempFilesNotSupported :: [String] -> Bool+isKeepTempFilesNotSupported stderr =+  any (\ line -> all (`isInfixOf` line) ["unrecognized", "option `--keep-temp-files'"]) stderr+ isCabalPathSupported :: MonadIO m => ProgramVersions -> m Bool isCabalPathSupported vs = do   v <- liftIO $ runCachedIO $ cabalVersion vs@@ -781,3 +870,24 @@   case (cabal_version, ghc_version) of     (Just cabal, Just ghc) -> pure $ ghc >= makeVersion [9, 4] && cabal >= makeVersion [3, 11]     _ -> pure False++renderWithTestsAndBenchmarks :: WithTestsAndBenchmarks -> [String]+renderWithTestsAndBenchmarks = \ case+  NoExtraComponents -> []+  LoadTestsAndBenchmarks -> ["--enable-tests", "--enable-benchmarks"]++renderLoadModeTargets :: CabalLoadFeature -> LoadModeTargets -> [String]+renderLoadModeTargets CabalWithGhcShimWrapper = \ case+  SingleTarget fp usesResponseFiles ->+    -- If cabal version is recent enough, we even need to pass '--keep-temp-files'+    -- when loading a single target+    fp : renderResponseFileArgs usesResponseFiles+  MultipleTargets mainTarget targets withTestsAndBenchmarks _usesResponseFiles ->+    "--enable-multi-repl" : "--keep-temp-files" : renderWithTestsAndBenchmarks withTestsAndBenchmarks ++ nubOrd (mainTarget:targets)+renderLoadModeTargets CabalWithRepl = \ case+  SingleTarget fp _usesResponseFiles ->+    -- We need to pass `--keep-temp-files` here as well as `with-repl` will invoke the script with a response file.+    ["--keep-temp-files", fp]+  MultipleTargets mainTarget targets withTestsAndBenchmarks _usesResponseFiles ->+    "--enable-multi-repl" : "--keep-temp-files" : renderWithTestsAndBenchmarks withTestsAndBenchmarks ++ nubOrd (mainTarget:targets)+

@@ -7,6 +7,7 @@  import HIE.Bios.Cradle.ProgramVersions import HIE.Bios.Config+import HIE.Bios.Types  -- | The final cradle config that specifies the cradle for -- each prefix we know how to handle@@ -14,6 +15,7 @@  { cradleRoot :: FilePath  , resolvedCradles :: [ResolvedCradle a] -- ^ In order of decreasing specificity  , cradleProgramVersions :: ProgramVersions+ , cradleCacheDirResolved :: CacheDir  }  -- | 'ConcreteCradle' augmented with information on which file the

@@ -1,6 +1,6 @@ {-# LANGUAGE RecordWildCards, CPP #-} {-# LANGUAGE TupleSections #-}-module HIE.Bios.Environment (initSession, initSession', getRuntimeGhcLibDir, getRuntimeGhcVersion, makeDynFlagsAbsolute, makeTargetsAbsolute, getCacheDir, addCmdOpts, extractUnits) where+module HIE.Bios.Environment (initSession, initSession', getRuntimeGhcLibDir, getRuntimeGhcVersion, makeDynFlagsAbsolute, makeTargetsAbsolute, getCacheDir, resolveCacheDir, addCmdOpts, extractUnits) where  import GHC (GhcMonad) import qualified GHC as G@@ -37,21 +37,20 @@ initSession :: (GhcMonad m)     => ComponentOptions     -> m [G.Target]-initSession = initSession' False+initSession = initSession' Nothing +-- | 'initSession' with caches placed under the given root instead of resolved+-- from the environment. initSession' :: (GhcMonad m)-    => Bool+    => Maybe CacheDir     -> ComponentOptions     -> m [G.Target]-initSession' workAroundThreadUnsafety ComponentOptions {..} = do+initSession' mCacheRoot ComponentOptions {..} = do     -- Create a unique folder per set of different GHC options, assuming that each different set of     -- GHC options will create incompatible interface files.-    let-      -- There seems to be a race condition when writing interface files-      hash_args = (if workAroundThreadUnsafety then (componentRoot :) else id) componentOptions-      opts_hash = B.unpack $ encode $ H.finalize $ H.updates H.init $ map B.pack hash_args+    let opts_hash = B.unpack $ encode $ H.finalize $ H.updates H.init $ map B.pack componentOptions -    cache_dir <- liftIO $ makeAbsolute =<< getCacheDir opts_hash+    cache_dir <- liftIO $ resolveCacheDir opts_hash mCacheRoot      -- Plan:     -- - Extract `-unit @resp_file` options if present@@ -167,13 +166,22 @@ -- | Prepends the cache directory used by the library to the supplied file path. -- It tries to use the path under the environment variable `$HIE_BIOS_CACHE_DIR` -- and falls back to the standard `$XDG_CACHE_HOME/hie-bios` if the former is not set-getCacheDir :: FilePath -> IO FilePath+getCacheDir :: FilePath -> IO CacheDir getCacheDir fp = do   mbEnvCacheDirectory <- lookupEnv "HIE_BIOS_CACHE_DIR"   cacheBaseDir <- maybe (getXdgDirectory XdgCache cacheDir) return                          mbEnvCacheDirectory-  return (cacheBaseDir </> fp)+  return (CacheDir (cacheBaseDir </> fp)) +-- | Resolve a cache directory root, appending @suffix@ and making it absolute.+-- An explicit path is used as given. 'Nothing' falls back to 'getCacheDir'.+resolveCacheDir :: FilePath -> Maybe CacheDir -> IO CacheDir+resolveCacheDir suffix mCacheRoot = do+  resolved <- case mCacheRoot of+    Nothing -> fmap unCacheDir (getCacheDir suffix)+    Just cacheRoot -> pure ((</> suffix) (unCacheDir cacheRoot))+  fmap CacheDir (makeAbsolute resolved)+ ----------------------------------------------------------------  -- we don't want to generate object code so we compile to bytecode@@ -191,9 +199,9 @@ setVerbosity :: Int -> G.DynFlags -> G.DynFlags setVerbosity n df = df { G.verbosity = n } -writeInterfaceFiles :: Maybe FilePath -> G.DynFlags -> G.DynFlags+writeInterfaceFiles :: Maybe CacheDir -> G.DynFlags -> G.DynFlags writeInterfaceFiles Nothing df = df-writeInterfaceFiles (Just hi_dir) df = setHiDir hi_dir (Gap.gopt_set df G.Opt_WriteInterface)+writeInterfaceFiles (Just (CacheDir hi_dir)) df = setHiDir hi_dir (Gap.gopt_set df G.Opt_WriteInterface)  setHiDir :: FilePath -> G.DynFlags -> G.DynFlags setHiDir f d = d { G.hiDir      = Just f}

@@ -49,15 +49,17 @@             => Maybe G.Messager             -> ComponentOptions             -> (m G.SuccessFlag, ComponentOptions)-initSessionWithMessage = initSessionWithMessage' False+initSessionWithMessage = initSessionWithMessage' Nothing +-- | 'initSessionWithMessage' with the interface-file cache placed under the+-- given root, see 'initSession''. initSessionWithMessage' :: (GhcMonad m)-            => Bool+            => Maybe CacheDir             -> Maybe G.Messager             -> ComponentOptions             -> (m G.SuccessFlag, ComponentOptions)-initSessionWithMessage' workAroundThreadUnsafety msg compOpts = (do-    targets <- initSession' workAroundThreadUnsafety compOpts+initSessionWithMessage' mCacheRoot msg compOpts = (do+    targets <- initSession' mCacheRoot compOpts     G.setTargets targets     -- Get the module graph using the function `getModuleGraph`     mod_graph <- G.depanal [] True

@@ -11,6 +11,7 @@   , getCleanEnvironment   -- * File Caching   , cacheFile+  , cacheFileIn   -- * Find file utilities   , findFileUpwards   , findFileUpwardsPredicate@@ -36,6 +37,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Text as T import System.Environment+import System.FileLock import System.FilePath import System.IO (hClose, hGetContents, hSetBuffering, BufferMode(LineBuffering), withFile, IOMode(..)) import System.IO.Error (isPermissionError)@@ -156,14 +158,24 @@ cacheFile :: FilePath -> String -> (FilePath -> IO ()) -> IO FilePath cacheFile fpName srcHash populate = do   cacheDir <- getCacheDir ""+  cacheFileIn cacheDir fpName srcHash populate++-- | 'cacheFile' with the cache directory given explicitly instead of resolved+-- from the environment.+cacheFileIn :: CacheDir -> FilePath -> String -> (FilePath -> IO ()) -> IO FilePath+cacheFileIn (CacheDir cacheDir) fpName srcHash populate = do   createDirectoryIfMissing True cacheDir   let newFpName = cacheDir </> (dropExtensions fpName <> "-" <> srcHash) <.> takeExtensions fpName-  unlessM (doesFileExist newFpName) $ do-    populate newFpName-    setMode newFpName+  -- Concurrent loads race to create the same cache entry, so serialize them on+  -- a lock. Populate into a temp file and rename to keep it atomic as well.+  withFileLock (newFpName <.> "lock") Exclusive $ \_ ->+    unlessM (doesFileExist newFpName) $+      withTempFile cacheDir (takeFileName newFpName) $ \tmpFile tmpHandle -> do+        hClose tmpHandle+        populate tmpFile+        setFileMode tmpFile accessModes+        renamePath tmpFile newFpName   pure newFpName-  where-    setMode wrapper_fp = setFileMode wrapper_fp accessModes  ------------------------------------------------------------------------------ -- Utilities@@ -219,4 +231,3 @@ removeFileIfExists f = do   yes <- doesFileExist f   when yes (removeFile f)-

@@ -3,6 +3,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module HIE.Bios.Types where  import           System.Exit@@ -14,6 +16,7 @@ import qualified Control.Monad.Fail as Fail #endif import           Data.Maybe (fromMaybe)+import           Data.String import qualified Data.Text as T import           Prettyprinter import           System.Process.Extra (CreateProcess (env, cmdspec), CmdSpec (..), showCommandForUser)@@ -106,7 +109,8 @@   | LogComputedCradleLoadMode !T.Text !TargetWithContext !LoadMode   | LogLoadModeUnsupported !T.Text LoadMode !(Maybe T.Text)   | LogCabalLoad !FilePath !(Maybe String) ![FilePath] ![FilePath]-  | LogCabalLibraryTooOld [String]+  | LogWithReplNotSupported [String]+  | LogKeepTempFilesNotSupported [String]   | LogCabalPath !T.Text   deriving (Show) @@ -160,9 +164,12 @@           <> line <> indent 4 "from project: " <+> pretty projectFile           <> line <> indent 4 "with prefixes:" <+> pretty prefixes           <> line <> indent 4 "with actual loading files:" <+> pretty crs-  pretty (LogCabalLibraryTooOld err) =-    "'lib:Cabal' is too old to use '--with-repl' flag. Requires 'lib:Cabal' >= 3.15. Original error:" <> line+  pretty (LogWithReplNotSupported err) =+    "'lib:Cabal' is too old to use '--with-repl' flag. Requires 'lib:Cabal' >= 3.15. Likely caused by `build-type: Custom`. Original error:" <> line       <> vcat (fmap pretty err)+  pretty (LogKeepTempFilesNotSupported err) =+    "'lib:Cabal' is too old to use '--keep-temp-files' flag. Likely caused by `build-type: Custom`. Original error:" <> line+    <> vcat (fmap pretty err)   pretty (LogCabalPath err) =     "Could not parse json output of 'cabal path': "       <> line <> indent 4 (pretty err)@@ -203,6 +210,21 @@   | LoadUnitsInferred   | LoadUnitsFromCradle   deriving (Eq,Ord,Enum,Bounded,Show)++newtype CacheDir = CacheDir { unCacheDir :: FilePath }+ deriving (Show, Eq)+ deriving newtype (IsString)++-- | Configuration for constructing and running a 'Cradle'.+data CradleRunConfig = CradleRunConfig+  { cradleCacheDir :: Maybe CacheDir+  -- ^ Root directory for cache artefacts produced while running the cradle.+  -- 'Nothing' falls back to @$HIE_BIOS_CACHE_DIR@, or the XDG cache+  -- directory if that is unset. See 'resolveCacheDir'.+  } deriving (Show, Eq)++defaultCradleRunConfig :: CradleRunConfig+defaultCradleRunConfig = CradleRunConfig { cradleCacheDir = Nothing }  data CradleAction a = CradleAction {                         actionName    :: ActionName a

@@ -4,35 +4,45 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE NumericUnderscores #-} module Main (main) where  import Utils -import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.ExpectedFailure-import qualified Test.Tasty.Ingredients as Tasty-import qualified Test.Tasty.Options     as Tasty-import qualified Test.Tasty.Runners     as Tasty-import HIE.Bios-import HIE.Bios.Cradle-import HIE.Bios.Cradle.Cabal (cabalBuildDir)-import HIE.Bios.Types (LoadMode(..))-import Control.Monad (forM_, forM, unless)+import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (replicateConcurrently)+import Control.Exception (SomeException, evaluate, try)+import Control.Monad (forM, forM_, unless, when) import Control.Monad.Extra (unlessM) import Control.Monad.IO.Class import Data.Foldable (for_)-import Data.List ( sort, isPrefixOf, isInfixOf, tails )+import Data.List (isInfixOf, isPrefixOf, sort, tails, last)+import Data.Maybe (isJust) import Data.Typeable-import System.Exit (ExitCode(ExitSuccess, ExitFailure))+import Data.Version+import HIE.Bios+import HIE.Bios.Cradle+import HIE.Bios.Cradle.Cabal (cabalBuildDir)+import HIE.Bios.Cradle.Utils (expandGhcOptionResponseFile)+import HIE.Bios.Environment (extractUnits, resolveCacheDir)+import qualified HIE.Bios.Ghc.Gap as Gap+import HIE.Bios.Process (cacheFileIn)+import HIE.Bios.Types (CacheDir (..), LoadMode (..), TargetWithContext (..)) import System.Directory-import System.FilePath ((</>), makeRelative)-import System.Info.Extra (isWindows)+import System.Exit (ExitCode (ExitFailure, ExitSuccess))+import System.FilePath (makeRelative, (</>)) import System.IO (BufferMode (LineBuffering), hSetBuffering, stderr, stdout)-import qualified HIE.Bios.Ghc.Gap as Gap-import HIE.Bios.Cradle.Utils (expandGhcOptionResponseFile)-import HIE.Bios.Environment (extractUnits)-+import System.IO.Temp+import System.Info.Extra (isWindows)+import System.Process+import Test.Tasty+import Test.Tasty.ExpectedFailure+import Test.Tasty.HUnit+import qualified Test.Tasty.Ingredients as Tasty+import qualified Test.Tasty.Options as Tasty+import qualified Test.Tasty.Runners as Tasty+import Text.ParserCombinators.ReadP (readP_to_S)+import Debug.Trace (traceShowId)  argDynamic :: [String] argDynamic = ["-dynamic" | Gap.hostIsDynamic]@@ -69,6 +79,10 @@   cabalDep <- checkToolIsAvailable "cabal"   extraGhcDep <- checkToolIsAvailable extraGhc +  -- Pre-create the shared extraGhc cabal store. The parallel tests otherwise+  -- race to initialise it and can fail with "package.db already exists".+  when (toolExists cabalDep && toolExists extraGhcDep) warmupExtraGhcStore+   defaultMainWithIngredients (ignoreToolTests:verboseLogging:defaultIngredients) $     -- Run tests sequentially on Windows, to avoid issues with locking of the     -- package database, e.g. errors of the form:@@ -77,14 +91,23 @@     testGroup "Bios-tests"       [ testGroup "Find cradle" findCradleTests       , testGroup "Symlink" symbolicLinkTests+      , testGroup "Cache files" cacheFileTests       , testGroup "Loading tests"         [ testGroup "bios" biosTestCases         , testGroup "direct" directTestCases-        , testGroupWithDependency cabalDep (cabalTestCases extraGhcDep)+        , testGroupWithDependency cabalDep (cabalTestCases cabalDep extraGhcDep)         , ignoreOnUnsupportedGhc $ testGroupWithDependency stackDep stackTestCases         ]       ] +-- | Load a cabal-with-ghc cradle once to create the extraGhc store. The result+-- is ignored; only the store-creation side effect matters. See 'main'.+warmupExtraGhcStore :: IO ()+warmupExtraGhcStore =+  runTestEnv "./cabal-with-ghc"+    (initCradle "src/MyLib.hs" *> loadComponentOptions (TargetWithContext "src/MyLib.hs" []))+    defConfig+ symbolicLinkTests :: [TestTree] symbolicLinkTests =   [ biosTestCase "Can load base module" $ runTestEnv "./symlink-test" $ do@@ -92,7 +115,7 @@       assertCradle isMultiCradle       step "Attempt to load symlinked module A"       do-        loadComponentOptions "./a/A.hs" []+        loadComponentOptions $ TargetWithContext "./a/A.hs" []         assertComponentOptions $ \opts ->           componentOptions opts `shouldMatchList` ["a"] <> argDynamic @@ -106,7 +129,7 @@         liftIO $ createDirectoryLink (rooted "a") (rooted "./b")         liftIO $ unlessM (doesFileExist $ rooted "b/A.hs") $           assertFailure "Test invariant broken, this file must exist."-        loadComponentOptions "./b/A.hs" []+        loadComponentOptions $ TargetWithContext "./b/A.hs" []         assertComponentOptions $ \opts ->           componentOptions opts `shouldMatchList` ["b"] <> argDynamic @@ -120,16 +143,39 @@         liftIO $ createDirectoryLink (rooted "./a") (rooted "./c")         liftIO $ unlessM (doesFileExist $ rooted "c/A.hs") $           assertFailure "Test invariant broken, this file must exist."-        loadComponentOptions "./c/A.hs" []+        loadComponentOptions $ TargetWithContext "./c/A.hs" []         assertLoadNone   ] +-- | Concurrent 'cacheFileIn' calls can race on the same cache entry.+cacheFileTests :: [TestTree]+cacheFileTests =+  [ testCase "cacheFile is atomic under concurrent calls" $ do+      withSystemTempDirectory "hie-bios-cache-file-test" $ \testCacheDir -> do+        let payloadPrefix = "#!/bin/sh\n"+            payloadSuffix = concat (replicate 500 "echo 'cacheFile is atomic under concurrent calls'\n")+            payload = payloadPrefix <> payloadSuffix+            -- Pause mid-write so a non-atomic populate would expose a partial+            -- file, and so all threads pile up on the entry concurrently.+            populate fp = do+              writeFile fp payloadPrefix+              threadDelay 50_000 -- 50ms+              appendFile fp payloadSuffix+        results <- replicateConcurrently 16 $ try @SomeException $ do+          fp <- cacheFileIn (CacheDir testCacheDir) "ghc-pkg" "0123456789abcdef" populate+          contents <- readFile fp+          contents <$ evaluate (length contents)+        forM_ results $ \case+          Left err -> assertFailure $ "cacheFile threw: " <> show err+          Right contents -> assertEqual "cached file contents" payload contents+  ]+ biosTestCases :: [TestTree] biosTestCases =   [ biosTestCase "failing-bios" $ runTestEnv "./failing-bios" $ do       initCradle "B.hs"       assertCradle isBiosCradle-      loadComponentOptions "B.hs" []+      loadComponentOptions $ TargetWithContext "B.hs" []       assertCradleError $ \CradleError {..} -> do         cradleErrorExitCode @?= ExitFailure 1         cradleErrorDependencies `shouldMatchList` ["hie.yaml"]@@ -148,7 +194,7 @@             then "Couldn't execute \"myGhc\"" `isPrefixOf` errorCtx @? "Error message should contain error information"             else "Couldn't execute myGhc"     `isPrefixOf` errorCtx @? "Error message should contain error information"   , biosTestCase "simple-bios-shell" $ runTestEnv "./simple-bios-shell" $ do-      testDirectoryM isBiosCradle "B.hs"+      testDirectoryM isBiosCradle $ single "B.hs"   , biosTestCase "simple-bios-shell-deps" $ runTestEnv "./simple-bios-shell" $ do       biosCradleDeps "B.hs" ["hie.yaml"]   ] <> concat [linuxTestCases | False] -- TODO(fendor), enable again@@ -157,23 +203,23 @@     biosCradleDeps fp deps = do       initCradle fp       assertCradle isBiosCradle-      loadComponentOptions fp []+      loadComponentOptions $ TargetWithContext fp []       assertComponentOptions $ \opts -> do         deps @?= componentDependencies opts      linuxTestCases =       [ biosTestCase "simple-bios" $ runTestEnv "./simple-bios" $-          testDirectoryM isBiosCradle "B.hs"+          testDirectoryM isBiosCradle $ single "B.hs"       , biosTestCase "simple-bios-ghc" $ runTestEnv "./simple-bios-ghc" $-          testDirectoryM isBiosCradle  "B.hs"+          testDirectoryM isBiosCradle $ single  "B.hs"       , biosTestCase "simple-bios-deps" $ runTestEnv "./simple-bios" $ do           biosCradleDeps "B.hs" ["hie-bios.sh", "hie.yaml"]       , biosTestCase "simple-bios-deps-new" $ runTestEnv "./deps-bios-new" $ do           biosCradleDeps "B.hs" ["hie-bios.sh", "hie.yaml"]       ] -cabalTestCases :: ToolDependency -> [TestTree]-cabalTestCases extraGhcDep =+cabalTestCases :: ToolDependency -> ToolDependency -> [TestTree]+cabalTestCases cabalDep extraGhcDep =   [     biosTestCaseAll "failing-cabal" $ runTestEnv "./failing-cabal" $ do       attemptCabalSingleTargetLoad "MyLib.hs"@@ -183,7 +229,7 @@   , biosTestCaseMulti "failing-cabal-multi-repl-with-shrink-error-files" $ runTestEnv "./failing-multi-repl-cabal-project" $ do       attemptCabalLoad "multi-repl-cabal-fail/app/Main.hs" ["multi-repl-cabal-fail/src/Lib.hs", "multi-repl-cabal-fail/src/Fail.hs", "NotInPath.hs"]       root <- askRoot-      multiSupported <- isCabalMultipleCompSupported'+      multiSupported <- isCabalMultipleCompSupportedM       if multiSupported         then           assertCradleError (\CradleError {..} -> do@@ -194,14 +240,16 @@         else assertLoadSuccess >>= \ComponentOptions {} -> do           return ()   , biosTestCaseAll "simple-cabal" $ runTestEnv "./simple-cabal" $ do-      testDirectoryM isCabalCradle "B.hs"+      testDirectoryM isCabalCradle $ single "B.hs"   , biosTestCaseMulti "build-dir" $ runTestEnv "./simple-cabal" $ do       initCradle "B.hs"       assertCradle isCabalCradle       root <- askRoot-      buildDir <- liftIO $ cabalBuildDir root+      buildDir <- liftIO $ do+        cacheDir <- resolveCacheDir "" Nothing+        cabalBuildDir cacheDir root       -- use --multi-repl, as that was the codepath with the bug-      loadFileGhc "B.hs" []+      loadFileGhc $ TargetWithContext "B.hs" []       liftIO $ do         -- Check we aren't trampling over dist-newstyle         distNewstyleExists <- doesDirectoryExist (root </> "dist-newstyle")@@ -209,6 +257,16 @@         -- Check we are using the correct build directory         buildDirExists <- doesDirectoryExist buildDir         assertBool "build dir does not exist" buildDirExists+  , biosTestCase "custom cache dir" $ runTestEnv "./simple-cabal" $+      withSystemTempDirectory "hie-bios-custom-cache-dir" $ \cacheRoot -> do+        initCradleWithConfig defaultCradleRunConfig { cradleCacheDir = Just (CacheDir cacheRoot) } "B.hs"+        assertCradle isCabalCradle+        loadComponentOptions $ TargetWithContext "B.hs" []+        _ <- assertLoadSuccess+        liftIO $ do+          entries <- listDirectory cacheRoot+          assertBool ("cache entries under the configured dir: " <> show entries)+            (any (\e -> "wrapper" `isInfixOf` e || "dist-" `isPrefixOf` e) entries)   , biosTestCaseAll "nested-cabal" $ runTestEnv "./nested-cabal" $ do       attemptCabalSingleTargetLoad "sub-comp/Lib.hs"       mode <- askLoadMode@@ -249,10 +307,10 @@       -- Initialize cradle first, since capability checks use the current cradle.       initCradle "sub-comp/Lib.hs"       assertCradle isCabalCradle-      multiSupported <- isCabalMultipleCompSupported'+      multiSupported <- isCabalMultipleCompSupportedM       if multiSupported         then do-          loadComponentOptions "sub-comp/Lib.hs" ["MyLib.hs"]+          loadComponentOptions $ TargetWithContext "sub-comp/Lib.hs" ["MyLib.hs"]           assertComponentOptions $ \opts -> do             -- Expect both the main component's cabal file and the enclosing cabal for the extra file,             -- plus project files.@@ -264,17 +322,17 @@               ]         else do           -- On older cabal/ghc combos, multi-repl isn't supported; just ensure load succeeds.-          loadComponentOptions "sub-comp/Lib.hs" []+          loadComponentOptions $ TargetWithContext "sub-comp/Lib.hs" []           _ <- assertLoadSuccess           pure ()   , biosTestCaseMulti "nested-cabal multi-mode includes enclosing deps when extra file is subcomp" $ runTestEnv "./nested-cabal" $ do       -- Initialize cradle at the top level, then treat the sub-component file as an extra file.       initCradle "MyLib.hs"       assertCradle isCabalCradle-      multiSupported <- isCabalMultipleCompSupported'+      multiSupported <- isCabalMultipleCompSupportedM       if multiSupported         then do-          loadComponentOptions "MyLib.hs" ["sub-comp/Lib.hs"]+          loadComponentOptions $ TargetWithContext "MyLib.hs" ["sub-comp/Lib.hs"]           assertComponentOptions $ \opts -> do             componentDependencies opts `shouldMatchList`               [ "nested-cabal.cabal"@@ -283,26 +341,26 @@               , "cabal.project.local"               ]         else do-          loadComponentOptions "MyLib.hs" []+          loadComponentOptions $ TargetWithContext "MyLib.hs" []           _ <- assertLoadSuccess           pure ()   , biosTestCaseAll "multi-cabal" $ runTestEnv "./multi-cabal" $ do       {- tests if both components can be loaded -}-      testDirectoryM isCabalCradle "app/Main.hs"-      testDirectoryM isCabalCradle "src/Lib.hs"+      testDirectoryM isCabalCradle $ single "app/Main.hs"+      testDirectoryM isCabalCradle $ single "src/Lib.hs"   , {- issue https://github.com/mpickering/hie-bios/issues/200 -}     biosTestCaseAll "monorepo-cabal" $ runTestEnv "./monorepo-cabal" $ do-      testDirectoryM isCabalCradle "A/Main.hs"-      testDirectoryM isCabalCradle "B/MyLib.hs"+      testDirectoryM isCabalCradle $ single "A/Main.hs"+      testDirectoryM isCabalCradle $ single "B/MyLib.hs"   , testGroup "Implicit cradle tests" $       [ biosTestCaseAll "implicit-cabal" $ runTestEnv "./implicit-cabal" $ do-          testImplicitDirectoryM isCabalCradle "Main.hs"+          testImplicitDirectoryM isCabalCradle $ single "Main.hs"       , biosTestCaseAll "implicit-cabal-no-project" $ runTestEnv "./implicit-cabal-no-project" $ do-          testImplicitDirectoryM isCabalCradle "Main.hs"+          testImplicitDirectoryM isCabalCradle $ single "Main.hs"       , biosTestCaseAll "implicit-cabal-deep-project" $ runTestEnv "./implicit-cabal-deep-project" $ do-          testImplicitDirectoryM isCabalCradle "foo/Main.hs"+          testImplicitDirectoryM isCabalCradle $ single "foo/Main.hs"       , biosTestCase "implicit-cabal-deep-project-with-context" $ runTestModeEnv "./implicit-cabal-deep-project" LoadFileWithContext $ do-          testImplicitDirectoryWithContextM isCabalCradle "foo/Main.hs" ["Main.hs"]+          testImplicitDirectoryM isCabalCradle $ ctx "foo/Main.hs" ["Main.hs"]       ]   , testGroupWithDependency extraGhcDep     [ biosTestCaseAll "Appropriate ghc and libdir" $ runTestEnv "./cabal-with-ghc" $ do@@ -313,88 +371,83 @@         loadRuntimeGhcVersion         assertGhcVersionIs extraGhcVersion         step "Find Component Options"-        loadComponentOptions "src/MyLib.hs" []+        loadComponentOptions $ TargetWithContext "src/MyLib.hs" []         _ <- assertLoadSuccess         pure ()     ]-  , testGroup "Cabal cabalProject"-    [ biosTestCaseAll "cabal-with-project, options propagated" $ runTestEnv "cabal-with-project" $ do+  , biosTestCaseAll "cabal-with-project, options propagated" $ runTestEnv "cabal-with-project" $ do         _opts <- cabalLoadOptions "src/MyLib.hs"         assertOptionsContain  "-O2" Nothing-    , biosTestCaseAll "cabal-with-project, load" $ runTestEnv "cabal-with-project" $ do-        testDirectoryM isCabalCradle "src/MyLib.hs"-    , biosTestCaseAll "multi-cabal-with-project, options propagated" $ runTestEnv "multi-cabal-with-project" $ do-        _optsAppA <- cabalLoadOptions "appA/src/Lib.hs"-        assertOptionsContain "-O2" (Just "appA")-    , biosTestCaseAll "multi-cabal-with-project, options not propagated" $ runTestEnv "multi-cabal-with-project" $ do-        _optsAppB <- cabalLoadOptions "appB/src/Lib.hs"-        assertOptionsDoNotContain "-O2" (Just "appB")-    , biosTestCaseAll "multi-cabal-with-project, load" $ runTestEnv "multi-cabal-with-project" $ do-        testDirectoryM isCabalCradle "appB/src/Lib.hs"-        testDirectoryM isCabalCradle "appB/src/Lib.hs"-    , testGroupWithDependency extraGhcDep-      [ biosTestCaseAll "Honours extra ghc setting" $ runTestEnv "cabal-with-ghc-and-project" $ do-          initCradle "src/MyLib.hs"-          assertCradle isCabalCradle-          loadRuntimeGhcLibDir-          assertLibDirVersionIs extraGhcVersion-          loadRuntimeGhcVersion-          assertGhcVersionIs extraGhcVersion-          step "Find Component Options"-          loadComponentOptions "src/MyLib.hs" []-          _ <- assertLoadSuccess-          pure ()-      ]-    , biosTestCaseAll "force older Cabal version in custom setup" $ runTestEnv "cabal-with-custom-setup" $ do+  , biosTestCaseAll "cabal-with-project, load" $ runTestEnv "cabal-with-project" $ do+      testDirectoryM isCabalCradle $ single "src/MyLib.hs"+  , biosTestCaseAll "multi-cabal-with-project, options propagated" $ runTestEnv "multi-cabal-with-project" $ do+      _optsAppA <- cabalLoadOptions "appA/src/Lib.hs"+      assertOptionsContain "-O2" (Just "appA")+  , biosTestCaseAll "multi-cabal-with-project, options not propagated" $ runTestEnv "multi-cabal-with-project" $ do+      _optsAppB <- cabalLoadOptions "appB/src/Lib.hs"+      assertOptionsDoNotContain "-O2" (Just "appB")+  , biosTestCaseAll "multi-cabal-with-project, load" $ runTestEnv "multi-cabal-with-project" $ do+      testDirectoryM isCabalCradle $ single "appB/src/Lib.hs"+      testDirectoryM isCabalCradle $ single "appB/src/Lib.hs"+  , testGroupWithDependency extraGhcDep+    [ biosTestCaseAll "Honours extra ghc setting" $ runTestEnv "cabal-with-ghc-and-project" $ do+        initCradle "src/MyLib.hs"+        assertCradle isCabalCradle+        loadRuntimeGhcLibDir+        assertLibDirVersionIs extraGhcVersion+        loadRuntimeGhcVersion+        assertGhcVersionIs extraGhcVersion+        step "Find Component Options"+        loadComponentOptions $ TargetWithContext "src/MyLib.hs" []+        _ <- assertLoadSuccess+        pure ()+    ]+  , biosTestCase "multi-cabal-with-load" $ runTestModeEnv "multi-cabal-with-load" LoadUnitsFromCradle $ do+      opts <- componentOptions <$> cabalLoadOptions  "appA/src/Lib.hs"+      liftIO $ do+        unless (any ("appA" `isInfixOf`) opts) $+          assertFailure $ "Missing appA: " ++ unwords opts+        unless (all (not . ("appB" `isInfixOf`)) opts) $+          assertFailure $ "Included appB: " ++ unwords opts+  , biosTestCase "multi-cabal-with-load-inferred" $ runTestModeEnv "multi-cabal-with-load" LoadUnitsInferred $ do+      -- LoadUnitsInferred should be unaffected by componentsToLoad+      opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"+      liftIO $ do+        unless (any ("appA" `isInfixOf`) opts) $+          assertFailure $ "Missing appA: " ++ unwords opts+        unless (any ("appB" `isInfixOf`) opts) $+          assertFailure $ "Missing appB: " ++ unwords opts+  , biosTestCase "cabal-with-load" $ runTestModeEnv "cabal-with-load" LoadUnitsFromCradle $ do+      opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"+      liftIO $ do+        unless (any ("appA" `isInfixOf`) opts) $+          assertFailure $ "Missing appA: " ++ unwords opts+        unless (all (not . ("appB" `isInfixOf`)) opts) $+          assertFailure $ "Included appB: " ++ unwords opts+  , biosTestCase "multi-cabal-with-load-superset" $ runTestModeEnv "multi-cabal-with-load-superset" LoadUnitsFromCradle $ do+      opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"+      liftIO $ do+        unless (any ("appA" `isInfixOf`) opts) $+          assertFailure $ "Missing appA: " ++ unwords opts+        unless (any ("appB" `isInfixOf`) opts) $+          assertFailure $ "Missing appB: " ++ unwords opts+  , testGroup "custom Cabal"+    [ biosTestCaseAll "with-repl fallback" $ runTestEnv "cabal-with-custom-setup-old" $ do         -- Specifically tests whether cabal 3.16 works as expected with         -- an older lib:Cabal version that doesn't support '--with-repl'.         -- This test doesn't hurt for other cases as well, so we enable it for         -- all configurations.-        testDirectoryM isCabalCradle "src/MyLib.hs"-    , biosTestCaseMulti "force older Cabal version in custom setup with multi mode" $ runTestEnv "cabal-with-custom-setup" $ do+        testDirectoryM isCabalCradle $ single "a-with-custom/src/MyLib.hs"+    , expectBrokenOnCabal318 cabalDep $ biosTestCaseAll "loads other packages with multi-repl" $ runTestEnv "cabal-with-custom-setup-old" $ do         -- Specifically tests whether cabal 3.16 works as expected with         -- an older lib:Cabal version that doesn't support '--with-repl'.         -- This test doesn't hurt for other cases as well, so we enable it for         -- all configurations.-        let target = "src/MyLib.hs"-        initCradle target-        assertCradle isCabalCradle-        loadRuntimeGhcLibDir-        assertLibDirVersion-        loadRuntimeGhcVersion-        assertGhcVersion-        -- suffices to force loading cabal's `--enable-multi-repl` codepath-        loadFileGhc target []-    , biosTestCase "multi-cabal-with-load" $ runTestModeEnv "multi-cabal-with-load" LoadUnitsFromCradle $ do-        opts <- componentOptions <$> cabalLoadOptions  "appA/src/Lib.hs"-        liftIO $ do-          unless (any ("appA" `isInfixOf`) opts) $-            assertFailure $ "Missing appA: " ++ unwords opts-          unless (all (not . ("appB" `isInfixOf`)) opts) $-            assertFailure $ "Included appB: " ++ unwords opts-    , biosTestCase "multi-cabal-with-load-inferred" $ runTestModeEnv "multi-cabal-with-load" LoadUnitsInferred $ do-        -- LoadUnitsInferred should be unaffected by componentsToLoad-        opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"-        liftIO $ do-          unless (any ("appA" `isInfixOf`) opts) $-            assertFailure $ "Missing appA: " ++ unwords opts-          unless (any ("appB" `isInfixOf`) opts) $-            assertFailure $ "Missing appB: " ++ unwords opts-    , biosTestCase "cabal-with-load" $ runTestModeEnv "cabal-with-load" LoadUnitsFromCradle $ do-        opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"-        liftIO $ do-          unless (any ("appA" `isInfixOf`) opts) $-            assertFailure $ "Missing appA: " ++ unwords opts-          unless (all (not . ("appB" `isInfixOf`)) opts) $-            assertFailure $ "Included appB: " ++ unwords opts-    , biosTestCase "multi-cabal-with-load-superset" $ runTestModeEnv "multi-cabal-with-load-superset" LoadUnitsFromCradle $ do-        opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"-        liftIO $ do-          unless (any ("appA" `isInfixOf`) opts) $-            assertFailure $ "Missing appA: " ++ unwords opts-          unless (any ("appB" `isInfixOf`) opts) $-            assertFailure $ "Missing appB: " ++ unwords opts+        testDirectoryM isCabalCradle $ ctx "b/src/B.hs" ["b/tests/Main.hs"]+    , biosTestCaseAll "custom package and simple package" $ runTestEnv "cabal-with-custom-setup" $ do+        testDirectoryM isCabalCradle $ single "b/src/B.hs"     ]+   ]   where     attemptCabalSingleTargetLoad fp = attemptCabalLoad fp []@@ -403,13 +456,13 @@     attemptCabalLoad fp fps = do       initCradle fp       assertCradle isCabalCradle-      loadComponentOptions fp fps+      loadComponentOptions $ TargetWithContext fp fps      cabalLoadOptions :: FilePath -> TestM ComponentOptions     cabalLoadOptions fp = do       initCradle fp       assertCradle isCabalCradle-      loadComponentOptions fp []+      loadComponentOptions $ TargetWithContext fp []       assertLoadSuccess  assertOptionsContain :: [Char] -> Maybe String -> TestM ()@@ -452,12 +505,12 @@             cradleErrorExitCode @?= ExitFailure 1             cradleErrorDependencies `shouldMatchList` ["failing-stack.cabal", "stack.yaml", "package.yaml"]   , biosTestCase "simple-stack" $ runTestEnv "./simple-stack" $ do-      testDirectoryM isStackCradle "B.hs"+      testDirectoryM isStackCradle $ single "B.hs"   , biosTestCase "multi-stack" $ runTestEnv "./multi-stack" $ do {- tests if both components can be loaded -}-      testDirectoryM isStackCradle "app/Main.hs"-      testDirectoryM isStackCradle "src/Lib.hs"+      testDirectoryM isStackCradle $ single "app/Main.hs"+      testDirectoryM isStackCradle $ single "src/Lib.hs"   , biosTestCaseMulti "multi-stack-multi-modes" $ runTestEnv "./multi-stack" $ do-      testDirectoryM isStackCradle "app/Main.hs"+      testDirectoryM isStackCradle $ single "app/Main.hs"   , biosTestCase "nested-stack" $ runTestEnv "./nested-stack" $ do       stackAttemptLoad "sub-comp/Lib.hs"       assertComponentOptions $ \opts ->@@ -468,14 +521,14 @@         componentDependencies opts `shouldMatchList` ["nested-stack.cabal", "package.yaml", "stack.yaml"]   , biosTestCase "stack-with-yaml" $ runTestEnv "./stack-with-yaml" $ do       {- tests if both components can be loaded -}-      testDirectoryM isStackCradle "app/Main.hs"-      testDirectoryM isStackCradle "src/Lib.hs"+      testDirectoryM isStackCradle $ single "app/Main.hs"+      testDirectoryM isStackCradle $ single "src/Lib.hs"   , biosTestCase "multi-stack-with-yaml" $ runTestEnv "./multi-stack-with-yaml" $ do       {- tests if both components can be loaded -}-      testDirectoryM isStackCradle "appA/src/Lib.hs"-      testDirectoryM isStackCradle "appB/src/Lib.hs"+      testDirectoryM isStackCradle $ single "appA/src/Lib.hs"+      testDirectoryM isStackCradle $ single "appB/src/Lib.hs"   , biosTestCase "multi-stack-with-load" $ runTestModeEnv "multi-stack-with-load" LoadUnitsFromCradle $ do-      testDirectoryM isStackCradle "appA/src/LibA.hs"+      testDirectoryM isStackCradle $ single "appA/src/LibA.hs"       assertComponentOptions $ \ opts0 -> do         let opts = componentOptions opts0         unless (any ("appA" `isInfixOf`) opts) $@@ -483,7 +536,7 @@         unless (all (not . ("appB" `isInfixOf`)) opts) $           assertFailure $ "Included appB: " ++ unwords opts   , biosTestCase "multi-stack-with-load-inferred" $ runTestModeEnv "multi-stack-with-load" LoadUnitsInferred $ do-      testDirectoryM  isStackCradle "appA/src/LibA.hs"+      testDirectoryM  isStackCradle $ single "appA/src/LibA.hs"       assertComponentOptions $ \ opts0 -> do         let opts = componentOptions opts0         unless (any ("appA" `isInfixOf`) opts) $@@ -494,14 +547,14 @@     -- Test for special characters in the path for parsing of the ghci-scripts.     -- Issue https://github.com/mpickering/hie-bios/issues/162     biosTestCase "space stack" $ runTestEnv "./space stack" $ do-      testDirectoryM isStackCradle "A.hs"-      testDirectoryM isStackCradle "B.hs"+      testDirectoryM isStackCradle $ single "A.hs"+      testDirectoryM isStackCradle $ single "B.hs"   , testGroup "Implicit cradle tests"       [ biosTestCase "implicit-stack" $ runTestModeEnv "./implicit-stack" LoadFile $ do-          testImplicitDirectoryM isStackCradle "Main.hs"+          testImplicitDirectoryM isStackCradle $ single "Main.hs"       , biosTestCase "implicit-stack-multi" $ runTestModeEnv "./implicit-stack-multi" LoadFile $ do-          testImplicitDirectoryM isStackCradle "Main.hs"-          testImplicitDirectoryM  isStackCradle "other-package/Main.hs"+          testImplicitDirectoryM isStackCradle $ single "Main.hs"+          testImplicitDirectoryM  isStackCradle $ single "other-package/Main.hs"       ]   ]   where@@ -509,16 +562,16 @@     stackAttemptLoad fp = do       initCradle fp       assertCradle isStackCradle-      loadComponentOptions fp []+      loadComponentOptions $ TargetWithContext fp []  directTestCases :: [TestTree] directTestCases =   [ biosTestCase "simple-direct" $ runTestEnv  "./simple-direct" $ do-      testDirectoryM isDirectCradle "B.hs"+      testDirectoryM isDirectCradle $ single "B.hs"   , biosTestCase "multi-direct" $ runTestEnv "./multi-direct" $ do       {- tests if both components can be loaded -}-      testDirectoryM isMultiCradle "A.hs"-      testDirectoryM isMultiCradle "B.hs"+      testDirectoryM isMultiCradle $ single "A.hs"+      testDirectoryM isMultiCradle $ single "B.hs"   ]  findCradleTests :: [TestTree]@@ -623,15 +676,25 @@  data ToolDependency = ToolDependency   { toolName :: String-  , toolExists :: Bool+  , toolVersion :: Maybe Version   } +toolExists :: ToolDependency -> Bool+toolExists td = isJust $ toolVersion td+ checkToolIsAvailable :: String -> IO ToolDependency checkToolIsAvailable f = do-  exists <- maybe False (const True) <$> findExecutable f+  mexe <- findExecutable f+  version <- case mexe of+    Nothing -> pure Nothing+    Just exe -> do+      versionStr <- readProcess exe ["--numeric-version"] ""+      pure $ case readP_to_S parseVersion versionStr of+        xs@(_:_) -> Just $ fst $ last xs+        [] -> Nothing   pure ToolDependency     { toolName = f-    , toolExists = exists+    , toolVersion = version     }  testGroupWithDependency :: ToolDependency -> [TestTree] -> TestTree@@ -696,4 +759,16 @@ #if (defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,14,0,0))   ignoreTestBecause "Not supported on GHC 9.14" #endif-    tt+  tt++expectBrokenOnCabal318 :: ToolDependency -> TestTree -> TestTree+expectBrokenOnCabal318 td tt =+  if traceShowId (traceShowId (toolVersion td) >= Just (makeVersion [3,17,0,0]))+    then expectFailBecause+            ("cabal 3.18 passes all options using response files. \+            If old lib:Cabal versions are used, we can't pass '--keep-temp-files' because the configure step rejects it. \+            Thus, the response files are deleted before we can parse them. Falling back to the ghc shim wrapper doesn't work either \+            since all arguments are passed via response files and we can't see the first argument to be '--interactive' and the wrapper fails.\+            "+            ) tt+    else tt

@@ -41,14 +41,18 @@   step,   normFile,   relFile,+  mainTarget,   findCradleLoc,   initCradle,+  initCradleWithConfig,   initImplicitCradle,   loadComponentOptions,   loadRuntimeGhcLibDir,   loadRuntimeGhcVersion,   loadFileGhc,-  isCabalMultipleCompSupported',+  isCabalMultipleCompSupportedM,+  single,+  ctx,    -- * Assertion helpers   assertCradle,@@ -67,7 +71,6 @@   -- * High-level test helpers   testDirectoryM,   testImplicitDirectoryM,-  testImplicitDirectoryWithContextM,   findCradleForModuleM, ) where @@ -270,6 +273,12 @@ -- Test setup helpers -- --------------------------------------------------------------------------- +single :: FilePath -> TargetWithContext+single fp = TargetWithContext fp []++ctx :: FilePath -> [FilePath] -> TargetWithContext+ctx fp fps = TargetWithContext fp fps+ step :: String -> TestM () step msg = do   s <- askStep@@ -278,6 +287,9 @@ normFile :: FilePath -> TestM FilePath normFile fp = (</> fp) <$> gets testRootDir +mainTarget :: TargetWithContext -> TestM FilePath+mainTarget target = (</> targetFilePath target) <$> gets testRootDir+ relFile :: FilePath -> TestM FilePath relFile fp = (`makeRelative` fp) <$> gets testRootDir @@ -287,7 +299,10 @@   liftIO $ findCradle a_fp  initCradle :: FilePath -> TestM ()-initCradle fp = do+initCradle = initCradleWithConfig defaultCradleRunConfig++initCradleWithConfig :: CradleRunConfig -> FilePath -> TestM ()+initCradleWithConfig config fp = do   a_fp <- normFile fp   step $ "Finding Cradle for: " <> fp   mcfg <- findCradleLoc a_fp@@ -295,8 +310,8 @@   step $ "Loading Cradle: " <> show relMcfg   logger <- askLogger   crd <- case mcfg of-    Just cfg -> liftIO $ loadCradle logger cfg-    Nothing -> liftIO $ loadImplicitCradle logger a_fp+    Just cfg -> liftIO $ loadCradleWithConfig logger config cfg+    Nothing -> liftIO $ loadImplicitCradleWithConfig logger config a_fp   step $ "Cradle: " ++ show crd   setCradle crd @@ -308,8 +323,8 @@   crd <- liftIO $ loadImplicitCradle logger a_fp   setCradle crd -loadComponentOptions :: FilePath -> [FilePath] -> TestM ()-loadComponentOptions fp extraFps = do+loadComponentOptions :: TargetWithContext -> TestM ()+loadComponentOptions (TargetWithContext fp extraFps) = do   a_fp <- normFile fp   a_fps <- traverse normFile extraFps   crd <- askCradle@@ -334,24 +349,27 @@   ghcVersionRes <- liftIO $ getRuntimeGhcVersion crd   setGhcVersionResult ghcVersionRes -isCabalMultipleCompSupported' :: TestM Bool-isCabalMultipleCompSupported' = do+isCabalMultipleCompSupportedM :: TestM Bool+isCabalMultipleCompSupportedM = do   cr <- askCradle   root <- askRoot   versions <- liftIO $ makeVersions (cradleLogger cr) root ((runGhcCmd . cradleOptsProg) cr)   liftIO $ isCabalMultipleCompSupported versions -loadFileGhc :: FilePath -> [FilePath] -> TestM ()-loadFileGhc fp extraFps = do+loadFileGhc :: TargetWithContext -> TestM ()+loadFileGhc target = do   libdir <- askOrLoadLibDir-  a_fp <- normFile fp+  a_fp <- mainTarget target   stepF <- askStep   step "Cradle load"-  loadComponentOptions fp extraFps+  loadComponentOptions target   opts <- assertLoadSuccess+  root <- askRoot+  -- Tests run in parallel, so isolate the interface-file cache per test root.+  let ifaceCacheRoot = CacheDir (root </> "ghc-iface-cache")   liftIO $     G.runGhc (Just libdir) $ do-      let (ini, _) = initSessionWithMessage' True (Just G.batchMsg) opts+      let (ini, _) = initSessionWithMessage' (Just ifaceCacheRoot) (Just G.batchMsg) opts       sf <- ini       case sf of         -- Test resetting the targets@@ -435,28 +453,25 @@ -- High-level, re-usable assertions -- --------------------------------------------------------------------------- -testDirectoryM :: (Cradle Void -> Bool) -> FilePath -> TestM ()-testDirectoryM cradlePred file = do-  initCradle file+testDirectoryM :: (Cradle Void -> Bool) -> TargetWithContext -> TestM ()+testDirectoryM cradlePred target = do+  initCradle $ targetFilePath target   assertCradle cradlePred   loadRuntimeGhcLibDir   assertLibDirVersion   loadRuntimeGhcVersion   assertGhcVersion-  loadFileGhc file []--testImplicitDirectoryM :: (Cradle Void -> Bool) -> FilePath -> TestM ()-testImplicitDirectoryM cradlePred file = testImplicitDirectoryWithContextM cradlePred file []+  loadFileGhc target -testImplicitDirectoryWithContextM :: (Cradle Void -> Bool) -> FilePath -> [FilePath] -> TestM ()-testImplicitDirectoryWithContextM cradlePred file ctxt = do-  initImplicitCradle file+testImplicitDirectoryM :: (Cradle Void -> Bool) -> TargetWithContext -> TestM ()+testImplicitDirectoryM cradlePred target = do+  initImplicitCradle $ targetFilePath target   assertCradle cradlePred   loadRuntimeGhcLibDir   assertLibDirVersion   loadRuntimeGhcVersion   assertGhcVersion-  loadFileGhc file ctxt+  loadFileGhc target  findCradleForModuleM :: FilePath -> Maybe FilePath -> TestM () findCradleForModuleM fp expected' = do

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,15 @@+cabal-version:      3.0+name:               a-with-custom+version:            0.1.0.0+build-type:         Custom++custom-setup+    setup-depends:+        Cabal <3.16,+        base++library+    exposed-modules:  MyLib+    build-depends:    base+    hs-source-dirs:   src+    default-language: Haskell2010

@@ -0,0 +1,4 @@+module MyLib (someFunc) where++someFunc :: IO ()+someFunc = putStrLn "someFunc"

@@ -0,0 +1,30 @@+cabal-version:      3.0+name:               b+version:            0.1.0.0+-- synopsis:+-- description:+license:            NONE+author:             fendor+maintainer:         fendor@posteo.de+-- copyright:+build-type:         Simple+extra-doc-files:    CHANGELOG.md+-- extra-source-files:++common warnings+    ghc-options: -Wall++library+    import:           warnings+    exposed-modules:  B+    -- other-modules:+    -- other-extensions:+    build-depends:    base, a-with-custom+    hs-source-dirs:   src+    default-language: Haskell2010++test-suite b-tests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: tests+  build-depends: base

@@ -0,0 +1,6 @@+module B (someFunc) where++import MyLib ()++someFunc :: IO ()+someFunc = putStrLn "someFunc"

@@ -0,0 +1,3 @@+module Main where++main = putStrLn "Not implemented"

@@ -0,0 +1,5 @@+packages:+    a-with-custom/+    b/++allow-newer: base, containers

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,15 @@+cabal-version:      3.0+name:               a-with-custom+version:            0.1.0.0+build-type:         Custom++custom-setup+    setup-depends:+        Cabal,+        base++library+    exposed-modules:  MyLib+    build-depends:    base+    hs-source-dirs:   src+    default-language: Haskell2010

@@ -0,0 +1,4 @@+module MyLib (someFunc) where++someFunc :: IO ()+someFunc = putStrLn "someFunc"

@@ -0,0 +1,24 @@+cabal-version:      3.0+name:               b+version:            0.1.0.0+-- synopsis:+-- description:+license:            NONE+author:             fendor+maintainer:         fendor@posteo.de+-- copyright:+build-type:         Simple+extra-doc-files:    CHANGELOG.md+-- extra-source-files:++common warnings+    ghc-options: -Wall++library+    import:           warnings+    exposed-modules:  B+    -- other-modules:+    -- other-extensions:+    build-depends:    base, a-with-custom+    hs-source-dirs:   src+    default-language: Haskell2010

@@ -0,0 +1,6 @@+module B (someFunc) where++import MyLib ()++someFunc :: IO ()+someFunc = putStrLn "someFunc"

@@ -0,0 +1,5 @@+packages:+    a-with-custom/+    b/++allow-newer: base, containers