Cleanup during unpack failures as well

.gitlab-ci.yml

@@ -1,8 +1,8 @@
 stages:
-  - linting
+  - checks
-  - quick-tests
+  - quick-test
-  - tests
+  - test
-  - expensive-tests
+  - expensive-test
   - release
 
 variables:
@@ -232,7 +232,7 @@ variables:
 ######## stack test ########
 
 test:linux:stack:
-  stage: tests
+  stage: test
   before_script:
     - ./.gitlab/before_script/linux/install_deps_minimal.sh
   script:
@@ -244,7 +244,7 @@ test:linux:stack:
 ######## bootstrap test ########
 
 test:linux:bootstrap_script:
-  stage: quick-tests
+  stage: quick-test
   before_script:
     - ./.gitlab/before_script/linux/install_deps_minimal.sh
   script:
@@ -258,7 +258,7 @@ test:linux:bootstrap_script:
   needs: []
 
 test:windows:bootstrap_powershell_script:
-  stage: quick-tests
+  stage: quick-test
   script:
     - ./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir $CI_PROJECT_DIR -BootstrapUrl $CI_PROJECT_DIR/bootstrap-haskell -InBash
   after_script:
@@ -276,7 +276,7 @@ test:windows:bootstrap_powershell_script:
 ######## linux test ########
 
 test:linux:
-  stage: tests
+  stage: test
   extends: .test_ghcup_version:linux
   variables:
     GHC_VERSION: "8.10.7"
@@ -284,7 +284,7 @@ test:linux:
   needs: []
 
 test:linux:hls:
-  stage: expensive-tests
+  stage: expensive-test
   extends:
     - .test_ghcup_version
     - .debian
@@ -301,7 +301,7 @@ test:linux:hls:
     - ./.gitlab/script/ghcup_hls.sh
 
 test:linux:cross-armv7:
-  stage: expensive-tests
+  stage: expensive-test
   extends:
     - .test_ghcup_version
     - .debian
@@ -319,22 +319,21 @@ test:linux:cross-armv7:
     - ./.gitlab/script/ghcup_cross.sh
 
 test:linux:git:hadrian:
-  stage: expensive-tests
+  stage: expensive-test
   extends:
     - .test_ghcup_version
-    - .alpine:64bit
+    - .debian
   variables:
-    GHC_VERSION: "8.8.4"
+    GHC_VERSION: "8.10.7"
-    GHC_GIT_TAG: "ghc-8.10.7-release"
+    GHC_GIT_TAG: "ghc-9.0.1-release"
-    GHC_GIT_VERSION: "8.10.7"
+    GHC_GIT_VERSION: "9.0.1"
     CABAL_VERSION: "3.6.2.0"
     CROSS: ""
   needs: []
   when: manual
   allow_failure: true
   before_script:
-    - apk add --no-cache python3 autoconf automake
+    - ./.gitlab/before_script/linux/install_deps.sh
-    - ./.gitlab/before_script/linux/alpine/install_deps.sh
   script:
     - ./.gitlab/script/ghcup_git.sh
 
@@ -342,7 +341,7 @@ test:linux:git:hadrian:
 ######## linux 32bit test ########
 
 test:linux:32bit:
-  stage: tests
+  stage: test
   extends: .test_ghcup_version:linux32
   variables:
     GHC_VERSION: "8.10.7"
@@ -352,7 +351,7 @@ test:linux:32bit:
 ######## arm tests ########
 
 test:linux:armv7:
-  stage: tests
+  stage: test
   extends: .test_ghcup_version:armv7
   variables:
     GHC_VERSION: "8.10.7"
@@ -362,7 +361,7 @@ test:linux:armv7:
   needs: []
 
 test:linux:aarch64:
-  stage: tests
+  stage: test
   extends: .test_ghcup_version:aarch64
   variables:
     GHC_VERSION: "8.10.7"
@@ -374,7 +373,7 @@ test:linux:aarch64:
 ######## darwin test ########
 
 test:mac:
-  stage: tests
+  stage: test
   extends: .test_ghcup_version:darwin
   variables:
     GHC_VERSION: "8.10.7"
@@ -382,7 +381,7 @@ test:mac:
   needs: []
 
 test:mac:aarch64:
-  stage: tests
+  stage: test
   extends: .test_ghcup_version:darwin:aarch64
   variables:
     GHC_VERSION: "8.10.7"
@@ -394,7 +393,7 @@ test:mac:aarch64:
 ######## freebsd test ########
 
 test:freebsd12:
-  stage: tests
+  stage: test
   extends: .test_ghcup_version:freebsd12
   variables:
     GHC_VERSION: "8.10.7"
@@ -404,7 +403,7 @@ test:freebsd12:
   needs: []
 
 test:freebsd13:
-  stage: tests
+  stage: test
   extends: .test_ghcup_version:freebsd13
   variables:
     GHC_VERSION: "8.10.7"
@@ -416,7 +415,7 @@ test:freebsd13:
 ######## windows test ########
 
 test:windows:
-  stage: tests
+  stage: test
   extends: .test_ghcup_version:windows
   variables:
     GHC_VERSION: "8.10.7"
@@ -588,7 +587,7 @@ release:windows:
 ######## hlint ########
 
 hlint:
-  stage: linting
+  stage: checks
   extends:
     - .debian
   script:
@@ -603,7 +602,7 @@ hlint:
 ######## mkdocs ########
 
 mkdocs:
-  stage: linting
+  stage: checks
   extends:
     - .debian
   before_script:
@@ -620,7 +619,7 @@ shellcheck:
   image: "koalaman/shellcheck-alpine"
   tags:
     - x86_64-linux
-  stage: linting
+  stage: checks
   script:
     - shellcheck scripts/bootstrap/bootstrap-haskell
   allow_failure: true

.gitlab/script/ghcup_git.sh

@@ -41,20 +41,7 @@ cabal --version
 
 eghcup debug-info
 
-(
+eghcup compile ghc -j $(nproc) -g ${GHC_GIT_TAG} -b ${GHC_VERSION} -- --enable-unregisterised
-	cd /tmp
-	ecabal install --installdir="$CI_PROJECT_DIR/.local/bin" --overwrite-policy=always --install-method=copy --constraint="happy == 1.19.12" happy
-	ecabal install --installdir="$CI_PROJECT_DIR/.local/bin" --overwrite-policy=always --install-method=copy --constraint="alex == 3.2.6" alex
-)
-
-ls -la "$CI_PROJECT_DIR/.local/bin"
-which alex
-which happy
-"$CI_PROJECT_DIR/.local/bin/alex" --version
-"$CI_PROJECT_DIR/.local/bin/happy" --version
-
-
-eghcup compile ghc -j $(nproc) -g ${GHC_GIT_TAG} -b ${GHC_VERSION} --hadrian -- --enable-unregisterised
 eghcup set ghc ${GHC_GIT_VERSION}
 
 [ `$(eghcup whereis ghc ${GHC_GIT_VERSION}) --numeric-version` = "${GHC_GIT_VERSION}" ]

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 ()