Cleanup during unpack failures as well

app/ghcup/BrickMain.hs

@@ -434,6 +434,7 @@ install' _ (_, ListResult {..}) = do
               , NoUpdate
               , TarDirDoesNotExist
               , FileAlreadyExistsError
+              , ProcessError
               ]
 
   run (do

app/ghcup/Main.hs

@@ -1852,6 +1852,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , NextVerNotFound
                       , NoToolVersionSet
                       , FileAlreadyExistsError
+                      , ProcessError
                       ]
 
           let runInstTool mInstPlatform action' = do
@@ -1953,6 +1954,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , NotInstalled
                       , DirNotEmpty
                       , ArchiveResult
+                      , FileDoesNotExistError
+                      , HadrianNotFound
+                      , InvalidBuildConfig
+                      , ProcessError
+                      , CopyError
+                      , BuildFailed
                       ]
 
           let runCompileHLS =

data/metadata/ghcup-0.0.6.yaml

@@ -2239,13 +2239,11 @@ ghcupDownloads:
       viArch:
         A_64:
           Linux_UnknownLinux:
-            unknown_versioning:
+            unknown_versioning: &cabal-3410-64
-              dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.4.1.0/cabal-install-3.4.1.0-x86_64-linux-deb10.tar.xz
-              dlHash: 019351d5ddc282f2195aca6d432699a31ad0ff75b01eeddff2402f5f3ca2104e
-          Linux_Alpine:
-            unknown_versioning:
               dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.1.0/cabal-install-3.4.1.0-x86_64-linux-alpine-static.tar.xz
               dlHash: f8cae8b5e6346b56676f734de1afd9b4b5f27eab6ab87852c19a30f7850f17fe
+          Linux_Alpine:
+            unknown_versioning: *cabal-3410-64
           Darwin:
             unknown_versioning:
               dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.4.1.0/cabal-install-3.4.1.0-x86_64-darwin.tar.xz
@@ -2341,13 +2339,11 @@ ghcupDownloads:
       viArch:
         A_64:
           Linux_UnknownLinux:
-            unknown_versioning:
+            unknown_versioning: &cabal-3620-32
-              dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.2.0/cabal-install-3.6.2.0-x86_64-linux-deb10.tar.xz
-              dlHash: 4759b56e9257e02f29fa374a6b25d6cb2f9d80c7e3a55d4f678a8e570925641c
-          Linux_Alpine:
-            unknown_versioning:
               dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.2.0/cabal-install-3.6.2.0-x86_64-linux-alpine-static.tar.xz
               dlHash: 7810d31f35ca7649355647abc6406ad2a3696648ce848e49409e86bd70f6a2c6
+          Linux_Alpine:
+            unknown_versioning: *cabal-3620-32
           Darwin:
             unknown_versioning:
               dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.2.0/cabal-install-3.6.2.0-x86_64-darwin.tar.xz

lib/GHCup.hs

@@ -205,6 +205,7 @@ installGHCBindist :: ( MonadFail m
                         , TarDirDoesNotExist
                         , DirNotEmpty
                         , ArchiveResult
+                        , ProcessError
                         ]
                        m
                        ()
@@ -283,6 +284,7 @@ installPackedGHC :: ( MonadMask m
                        , TarDirDoesNotExist
                        , DirNotEmpty
                        , ArchiveResult
+                       , ProcessError
                        ] m ()
 installPackedGHC dl msubdir inst ver forceInstall = do
   PlatformRequest {..} <- lift getPlatformReq
@@ -292,7 +294,7 @@ installPackedGHC dl msubdir inst ver forceInstall = do
 
   -- unpack
   tmpUnpack <- lift mkGhcupTmpDir
-  liftE $ unpackToDir tmpUnpack dl
+  liftE $ cleanUpOnError tmpUnpack (unpackToDir tmpUnpack dl)
   liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
   -- the subdir of the archive where we do the work
@@ -402,12 +404,13 @@ installGHCBin :: ( MonadFail m
                     , TarDirDoesNotExist
                     , DirNotEmpty
                     , ArchiveResult
+                    , ProcessError
                     ]
                    m
                    ()
 installGHCBin ver isoFilepath forceInstall = do
   dlinfo <- liftE $ getDownloadInfo GHC ver
-  installGHCBindist dlinfo ver isoFilepath forceInstall
+  liftE $ installGHCBindist dlinfo ver isoFilepath forceInstall
 
 
 -- | Like 'installCabalBin', except takes the 'DownloadInfo' as
@@ -472,7 +475,7 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do
 
   -- unpack
   tmpUnpack <- lift withGHCupTmpDir
-  liftE $ unpackToDir tmpUnpack dl
+  liftE $ cleanUpOnError tmpUnpack (unpackToDir tmpUnpack dl)
   liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
   -- the subdir of the archive where we do the work
@@ -614,7 +617,7 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
 
   -- unpack
   tmpUnpack <- lift withGHCupTmpDir
-  liftE $ unpackToDir tmpUnpack dl
+  liftE $ cleanUpOnError tmpUnpack (unpackToDir tmpUnpack dl)
   liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
   -- the subdir of the archive where we do the work
@@ -784,7 +787,7 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
 
       -- unpack
       tmpUnpack <- lift mkGhcupTmpDir
-      liftE $ unpackToDir tmpUnpack dl
+      liftE $ cleanUpOnError tmpUnpack (unpackToDir tmpUnpack dl)
       liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
       workdir <- maybe (pure tmpUnpack)
@@ -1001,7 +1004,7 @@ installStackBindist dlinfo ver isoFilepath forceInstall = do
 
   -- unpack
   tmpUnpack <- lift withGHCupTmpDir
-  liftE $ unpackToDir tmpUnpack dl
+  liftE $ cleanUpOnError tmpUnpack (unpackToDir tmpUnpack dl)
   liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
   -- the subdir of the archive where we do the work
@@ -2114,6 +2117,12 @@ compileGHC :: ( MonadMask m
                  , NotInstalled
                  , DirNotEmpty
                  , ArchiveResult
+                 , FileDoesNotExistError
+                 , HadrianNotFound
+                 , InvalidBuildConfig
+                 , ProcessError
+                 , CopyError
+                 , BuildFailed
                  ]
                 m
                 GHCTargetVersion
@@ -2135,7 +2144,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
 
         -- unpack
         tmpUnpack <- lift mkGhcupTmpDir
-        liftE $ unpackToDir tmpUnpack dl
+        liftE $ cleanUpOnError tmpUnpack (unpackToDir tmpUnpack dl)
         liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
         workdir <- maybe (pure tmpUnpack)

lib/GHCup/Utils.hs

@@ -74,7 +74,6 @@ import           System.Win32.Console
 import           System.Win32.File     hiding ( copyFile )
 import           System.Win32.Types
 #endif
-import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           Text.Regex.Posix
 import           URI.ByteString
 
@@ -926,11 +925,7 @@ getChangeLog dls tool (Right tag) =
 --
 --   1. the build directory, depending on the KeepDirs setting
 --   2. the install destination, depending on whether the build failed
-runBuildAction :: ( Pretty (V e)
+runBuildAction :: ( MonadReader env m
-                  , Show (V e)
-                  , PopVariant BuildFailed e
-                  , ToVariantMaybe BuildFailed e
-                  , MonadReader env m
                   , HasDirs env
                   , HasSettings env
                   , MonadIO m
@@ -943,26 +938,43 @@ runBuildAction :: ( Pretty (V e)
                => FilePath        -- ^ build directory (cleaned up depending on Settings)
                -> Maybe FilePath  -- ^ dir to *always* clean up on exception
                -> Excepts e m a
-               -> Excepts '[BuildFailed] m a
+               -> Excepts e m a
 runBuildAction bdir instdir action = do
   Settings {..} <- lift getSettings
   let exAction = do
         forM_ instdir $ \dir ->
-          lift $ hideError doesNotExistErrorType $ recyclePathForcibly dir
+          hideError doesNotExistErrorType $ recyclePathForcibly dir
         when (keepDirs == Never)
-          $ lift $ rmBDir bdir
+          $ rmBDir bdir
   v <-
-    flip onException exAction
+    flip onException (lift exAction)
-    $ catchAllE
+    $ onE_ exAction action
-        (\es -> do
-          exAction
-          throwE (BuildFailed bdir es)
-        ) action
-
   when (keepDirs == Never || keepDirs == Errors) $ lift $ rmBDir bdir
   pure v
 
 
+-- | Clean up the given directory if the action fails,
+-- depending on the Settings.
+cleanUpOnError :: ( MonadReader env m
+                  , HasDirs env
+                  , HasSettings env
+                  , MonadIO m
+                  , MonadMask m
+                  , HasLog env
+                  , MonadUnliftIO m
+                  , MonadFail m
+                  , MonadCatch m
+                  )
+               => FilePath        -- ^ build directory (cleaned up depending on Settings)
+               -> Excepts e m a
+               -> Excepts e m a
+cleanUpOnError bdir action = do
+  Settings {..} <- lift getSettings
+  let exAction = when (keepDirs == Never) $ rmBDir bdir
+  flip onException (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) => FilePath -> m ()