From d5a680e3c69516800be591f5d044657d373f224d Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 1 Jan 2023 23:50:12 +0800
Subject: [PATCH] Don't clean up tmp dirs when --keep=always

---
 lib/GHCup/Utils/Dirs.hs | 25 ++++++++++++++++---------
 1 file changed, 16 insertions(+), 9 deletions(-)

diff --git a/lib/GHCup/Utils/Dirs.hs b/lib/GHCup/Utils/Dirs.hs
index c2c026a..4f791cf 100644
--- a/lib/GHCup/Utils/Dirs.hs
+++ b/lib/GHCup/Utils/Dirs.hs
@@ -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))