stack build: Add --keep-tmp-files flag. Fixes #3857

ChangeLog.md

@@ -37,6 +37,11 @@ Other enhancements:
 * Nix integration is now disabled on windows even if explicitly enabled,
   since it isn't supported. See
   [#3600](https://github.com/commercialhaskell/stack/issues/3600)
+* `stack build` now supports a new flag `--keep-tmp-files` to retain intermediate
+  files and directories for the purpose of debugging.
+  It is best used with ghc's equivalent flag,
+  i.e. `stack build --keep-tmp-files --ghc-options=-keep-tmp-files`.
+  See [#3857](https://github.com/commercialhaskell/stack/issues/3857)
 
 Bug fixes:
 * 1.6.1 introduced a change that made some precompiled cache files use

doc/yaml_configuration.md

@@ -747,6 +747,7 @@ build:
   copy-bins: false
   prefetch: false
   keep-going: false
+  keep-tmp-files: false
 
   # NOTE: global usage of haddock can cause build failures when documentation is
   # incorrectly formatted.  This could also affect scripts which use stack.

src/Stack/Build/Execute.hs

@@ -324,7 +324,7 @@ withExecuteEnv :: forall env a. HasEnvConfig env
                -> (ExecuteEnv -> RIO env a)
                -> RIO env a
 withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages inner =
-    withSystemTempDir stackProgName $ \tmpdir -> do
+    createTempDirFunction stackProgName $ \tmpdir -> do
         configLock <- liftIO $ newMVar ()
         installLock <- liftIO $ newMVar ()
         idMap <- liftIO $ newTVarIO Map.empty
@@ -387,6 +387,10 @@ withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPacka
   where
     toDumpPackagesByGhcPkgId = Map.fromList . map (\dp -> (dpGhcPkgId dp, dp))
 
+    createTempDirFunction
+        | Just True <- boptsKeepTmpFiles bopts = withKeepSystemTempDir
+        | otherwise = withSystemTempDir
+
     dumpLogs :: TChan (Path Abs Dir, Path Abs File) -> Int -> RIO env ()
     dumpLogs chan totalWanted = do
         allLogs <- fmap reverse $ liftIO $ atomically drainChan

src/Stack/Config/Build.hs

@@ -50,6 +50,7 @@ buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts
           (boptsPreFetch defaultBuildOpts)
           buildMonoidPreFetch
     , boptsKeepGoing = getFirst buildMonoidKeepGoing
+    , boptsKeepTmpFiles = getFirst buildMonoidKeepTmpFiles
     , boptsForceDirty = fromFirst
           (boptsForceDirty defaultBuildOpts)
           buildMonoidForceDirty

src/Stack/Options/BuildMonoidParser.hs

@@ -19,7 +19,7 @@ buildOptsMonoidParser hide0 =
     exeStripping <*> haddock <*> haddockOptsParser hideBool <*>
     openHaddocks <*> haddockDeps <*> haddockInternal <*>
     haddockHyperlinkSource <*> copyBins <*> copyCompilerTool <*>
-    preFetch <*> keepGoing <*> forceDirty <*>
+    preFetch <*> keepGoing <*> keepTmpFiles <*> forceDirty <*>
     tests <*> testOptsParser hideBool <*> benches <*>
     benchOptsParser hideBool <*> reconfigure <*> cabalVerbose <*> splitObjs <*> skipComponents
   where
@@ -120,6 +120,11 @@ buildOptsMonoidParser hide0 =
             "keep-going"
             "continue running after a step fails (default: false for build, true for test/bench)"
             hide
+    keepTmpFiles =
+        firstBoolFlags
+            "keep-tmp-files"
+            "keep intermediate files and build directories (default: false)"
+            hide
     preFetch =
         firstBoolFlags
             "prefetch"

src/Stack/Prelude.hs

@@ -6,6 +6,7 @@ module Stack.Prelude
   , withSinkFile
   , withSinkFileCautious
   , withSystemTempDir
+  , withKeepSystemTempDir
   , sinkProcessStderrStdout
   , sinkProcessStdout
   , logProcessStderrStdout
@@ -64,6 +65,13 @@ withSinkFileCautious fp inner =
 withSystemTempDir :: MonadUnliftIO m => String -> (Path Abs Dir -> m a) -> m a
 withSystemTempDir str inner = withRunInIO $ \run -> Path.IO.withSystemTempDir str $ run . inner
 
+-- | Like `withSystemTempDir`, but the temporary directory is not deleted.
+withKeepSystemTempDir :: MonadUnliftIO m => String -> (Path Abs Dir -> m a) -> m a
+withKeepSystemTempDir str inner = withRunInIO $ \run -> do
+  path <- Path.IO.getTempDir
+  dir <- Path.IO.createTempDir path str
+  run $ inner dir
+
 -- | Consume the stdout and stderr of a process feeding strict 'ByteString's to the consumers.
 --
 -- Throws a 'ReadProcessException' if unsuccessful in launching, or 'ProcessExitedUnsuccessfully' if the process itself fails.

src/Stack/Types/Config/Build.hs

@@ -64,6 +64,8 @@ data BuildOpts =
             -- ^ Watch files for changes and automatically rebuild
             ,boptsKeepGoing :: !(Maybe Bool)
             -- ^ Keep building/running after failure
+            ,boptsKeepTmpFiles :: !(Maybe Bool)
+            -- ^ Keep intermediate files and build directories
             ,boptsForceDirty :: !Bool
             -- ^ Force treating all local packages as having dirty files
 
@@ -105,6 +107,7 @@ defaultBuildOpts = BuildOpts
     , boptsInstallCompilerTool = False
     , boptsPreFetch = False
     , boptsKeepGoing = Nothing
+    , boptsKeepTmpFiles = Nothing
     , boptsForceDirty = False
     , boptsTests = False
     , boptsTestOpts = defaultTestOpts
@@ -172,6 +175,7 @@ data BuildOptsMonoid = BuildOptsMonoid
     , buildMonoidInstallCompilerTool :: !(First Bool)
     , buildMonoidPreFetch :: !(First Bool)
     , buildMonoidKeepGoing :: !(First Bool)
+    , buildMonoidKeepTmpFiles :: !(First Bool)
     , buildMonoidForceDirty :: !(First Bool)
     , buildMonoidTests :: !(First Bool)
     , buildMonoidTestOpts :: !TestOptsMonoid
@@ -202,6 +206,7 @@ instance FromJSON (WithJSONWarnings BuildOptsMonoid) where
               buildMonoidInstallCompilerTool <- First <$> o ..:? buildMonoidInstallCompilerToolArgName
               buildMonoidPreFetch <- First <$> o ..:? buildMonoidPreFetchArgName
               buildMonoidKeepGoing <- First <$> o ..:? buildMonoidKeepGoingArgName
+              buildMonoidKeepTmpFiles <- First <$> o ..:? buildMonoidKeepTmpFilesArgName
               buildMonoidForceDirty <- First <$> o ..:? buildMonoidForceDirtyArgName
               buildMonoidTests <- First <$> o ..:? buildMonoidTestsArgName
               buildMonoidTestOpts <- jsonSubWarnings (o ..:? buildMonoidTestOptsArgName ..!= mempty)
@@ -255,6 +260,9 @@ buildMonoidPreFetchArgName = "prefetch"
 buildMonoidKeepGoingArgName :: Text
 buildMonoidKeepGoingArgName = "keep-going"
 
+buildMonoidKeepTmpFilesArgName :: Text
+buildMonoidKeepTmpFilesArgName = "keep-tmp-files"
+
 buildMonoidForceDirtyArgName :: Text
 buildMonoidForceDirtyArgName = "force-dirty"
 

src/test/Stack/ConfigSpec.hs

@@ -35,6 +35,7 @@ buildOptsConfig =
   "  prefetch: true\n" ++
   "  force-dirty: true\n" ++
   "  keep-going: true\n" ++
+  "  keep-tmp-files: true\n" ++
   "  test: true\n" ++
   "  test-arguments:\n" ++
   "    rerun-tests: true\n" ++
@@ -117,6 +118,7 @@ spec = beforeAll setup $ do
       boptsInstallExes `shouldBe` True
       boptsPreFetch `shouldBe` True
       boptsKeepGoing `shouldBe` Just True
+      boptsKeepTmpFiles `shouldBe` Just True
       boptsForceDirty `shouldBe` True
       boptsTests `shouldBe` True
       boptsTestOpts `shouldBe` TestOpts {toRerunTests = True