Merge branch 'error-handling'

This commit is contained in:
Julian Ospald 2023-01-03 22:45:25 +08:00
commit db6f784a1f
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
1 changed files with 16 additions and 9 deletions

View File

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