hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Don't clean up tmp dirs when --keep=always

Browse Source
This commit is contained in:
Julian Ospald 2023-01-01 23:50:12 +08:00
parent d1075987de
commit d5a680e3c6
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
1 changed files with 16 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
lib/GHCup/Utils/Dirs.hs
View File

@ -465,15 +465,22 @@ withGHCupTmpDir :: ( MonadReader env m
, MonadMask m , MonadMask m
, MonadIO m) , MonadIO m)
=> m GHCupPath => m GHCupPath
withGHCupTmpDir = snd <$> withRunInIO (\run -> withGHCupTmpDir = do
run Settings{keepDirs} <- getSettings
$ allocate snd <$> withRunInIO (\run ->
(run mkGhcupTmpDir) run
(\fp -> $ allocate
handleIO (\e -> run (run mkGhcupTmpDir)
$ logDebug ("Resource cleanup failed for " <> T.pack (fromGHCupPath fp) <> ", error was: " <> T.pack (displayException e))) (\fp -> if -- we don't know whether there was a failure, so can only
. removePathForcibly -- decide for 'Always'
$ fp)) | keepDirs == Always -> pure ()
| otherwise -> handleIO (\e -> run
$ logDebug ("Resource cleanup failed for "
<> T.pack (fromGHCupPath fp)
<> ", error was: "
<> T.pack (displayException e)))
. removePathForcibly
$ fp))