From be3db874108c47e9923b9a9c7f628a0376d547b3 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 18 Feb 2024 20:07:12 +0800
Subject: [PATCH] Clean up on error, fixes #1004

---
 lib/GHCup/GHC.hs   |  2 +-
 lib/GHCup/HLS.hs   |  2 +-
 lib/GHCup/Utils.hs | 21 ---------------------
 3 files changed, 2 insertions(+), 23 deletions(-)

diff --git a/lib/GHCup/GHC.hs b/lib/GHCup/GHC.hs
index 9432ab5..bd9f854 100644
--- a/lib/GHCup/GHC.hs
+++ b/lib/GHCup/GHC.hs
@@ -908,7 +908,7 @@ compileGHC targetGhc crossTarget vps bstrap jobs mbuildConfig patches aargs buil
       GitDist GitBranch{..} -> do
         tmpUnpack <- lift mkGhcupTmpDir
         let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
-        (tver, ov) <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError] DownloadFailed $ do
+        (tver, ov) <- cleanUpOnError tmpUnpack $ reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError] DownloadFailed $ do
           let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
           lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
           lEM $ git [ "init" ]
diff --git a/lib/GHCup/HLS.hs b/lib/GHCup/HLS.hs
index a452671..70453f3 100644
--- a/lib/GHCup/HLS.hs
+++ b/lib/GHCup/HLS.hs
@@ -437,7 +437,7 @@ compileHLS targetHLS ghcs jobs vps installDir cabalProject cabalProjectLocal upd
     GitDist GitBranch{..} -> do
       tmpUnpack <- lift mkGhcupTmpDir
       let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
-      reThrowAll @_ @'[ProcessError] DownloadFailed $ do
+      cleanUpOnError tmpUnpack $ reThrowAll @_ @'[ProcessError] DownloadFailed $ do
         let rep = fromMaybe "https://github.com/haskell/haskell-language-server.git" repo
         lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
         lEM $ git [ "init" ]
diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs
index ddc61e4..38d4eb5 100644
--- a/lib/GHCup/Utils.hs
+++ b/lib/GHCup/Utils.hs
@@ -1084,27 +1084,6 @@ cleanUpOnError bdir action = do
   flip onException (lift exAction) $ onE_ exAction action
 
 
--- | Clean up the given directory if the action fails,
--- depending on the Settings.
-cleanFinally :: ( MonadReader env m
-                  , HasDirs env
-                  , HasSettings env
-                  , MonadIO m
-                  , MonadMask m
-                  , HasLog env
-                  , MonadUnliftIO m
-                  , MonadFail m
-                  , MonadCatch m
-                  )
-               => GHCupPath        -- ^ build directory (cleaned up depending on Settings)
-               -> Excepts e m a
-               -> Excepts e m a
-cleanFinally bdir action = do
-  Settings {..} <- lift getSettings
-  let exAction = when (keepDirs == Never) $ rmBDir bdir
-  flip finally (lift exAction) $ onE_ exAction action
-
-
 -- | Remove a build directory, ignoring if it doesn't exist and gracefully
 -- printing other errors without crashing.
 rmBDir :: (MonadReader env m, HasLog env, MonadUnliftIO m, MonadIO m) => GHCupPath -> m ()