Fix CI

On my system, for example, Desktop is backed up with OneDrive

.gitlab-ci.yml

@@ -7,7 +7,7 @@ variables:
   GIT_SSL_NO_VERIFY: "1"
 
   # Commit of ghc/ci-images repository from which to pull Docker images
-  DOCKER_REV: 1ac7f435c9312f10422a82d304194778378e2a1a
+  DOCKER_REV: 8d0224e6b2a08157649651e69302380b2bd24e11
 
 ############################################################
 # CI Step
@@ -149,17 +149,19 @@ variables:
   script: |
     set -Eeuo pipefail
     function runInNixShell() {
-      time nix-shell .gitlab/shell.nix \
+      time nix-shell $CI_PROJECT_DIR/.gitlab/shell.nix \
         -I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \
         --argstr system "aarch64-darwin" \
         --pure \
-        --keep GHC_VERSION --keep CABAL_INSTALL_VERSION --keep BUILD_FLAVOUR \
-        --keep BIN_DIST_PREP_TAR_COMP --keep CPUS --keep PROJECT_DIR \
-        --keep CI_PROJECT_DIR --keep MAKE_ARGS --keep HADRIAN_ARGS --keep CABAL_CACHE \
-        --keep LANG --keep CONFIGURE_ARGS --keep TEST_ENV --keep BIN_DIST_NAME \
-        --keep MACOSX_DEPLOYMENT_TARGET --keep ac_cv_func_clock_gettime --keep HACKAGE_INDEX_STATE \
-        --keep CABAL_DIR --keep ARCH --keep OS --keep CABAL_VERSION --keep GHC_VERSION \ 
-        --keep JSON_VERSION --ARTIFACT \
+        --keep CI_PROJECT_DIR \
+        --keep MACOSX_DEPLOYMENT_TARGET \
+        --keep JSON_VERSION \
+        --keep ARTIFACT \
+        --keep OS \
+        --keep ARCH \
+        --keep CABAL_DIR \
+        --keep GHC_VERSION \
+        --keep CABAL_VERSION \
         --run "$1" 2>&1
     }
     runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1
@@ -405,13 +407,9 @@ release:darwin:aarch64:
         -I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \
         --argstr system "aarch64-darwin" \
         --pure \
-        --keep GHC_VERSION --keep CABAL_INSTALL_VERSION --keep BUILD_FLAVOUR \
-        --keep BIN_DIST_PREP_TAR_COMP --keep CPUS --keep PROJECT_DIR \
         --keep CI_PROJECT_DIR --keep MAKE_ARGS --keep HADRIAN_ARGS --keep CABAL_CACHE \
-        --keep LANG --keep CONFIGURE_ARGS --keep TEST_ENV --keep BIN_DIST_NAME \
-        --keep MACOSX_DEPLOYMENT_TARGET --keep ac_cv_func_clock_gettime --keep HACKAGE_INDEX_STATE \
-        --keep CABAL_DIR --keep ARCH --keep OS --keep CABAL_VERSION --keep GHC_VERSION \ 
-        --keep JSON_VERSION --ARTIFACT \
+        --keep MACOSX_DEPLOYMENT_TARGET \
+        --keep JSON_VERSION --keep ARTIFACT \
         --run "$1" 2>&1
     }
     runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1

.gitlab/before_script/darwin/install_deps.sh

@@ -19,4 +19,14 @@ fi
 ./ghcup-bin set ${GHC_VERSION}
 ./ghcup-bin install-cabal ${CABAL_VERSION}
 
+if [ $ARCH = 'ARM64' ] ; then
+	cabal update
+	mkdir vendored
+	cd vendored
+	cabal unpack network-3.1.2.1
+	cd network*
+	autoreconf -fi
+	cd ../..
+fi
+
 exit 0

.gitlab/script/ghcup_version.sh

@@ -104,35 +104,39 @@ if [ "${OS}" != "WINDOWS" ] ; then
 fi
 
 
-# test installing new ghc doesn't mess with currently set GHC
-# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
-if [ "${OS}" = "LINUX" ] ; then
-	eghcup --downloader=wget install 8.10.3
-else # test wget a bit
-	eghcup install 8.10.3
-fi
-[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
-eghcup set 8.10.3
-eghcup set 8.10.3
-[ "$(ghc --numeric-version)" = "8.10.3" ]
-eghcup set ${GHC_VERSION}
-[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
-eghcup rm 8.10.3
-[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
+if [ "${OS}" = "DARWIN" ] && [ "${ARCH}" = "ARM64" ] ; then
+	echo
+else
+	# test installing new ghc doesn't mess with currently set GHC
+	# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
+	if [ "${OS}" = "LINUX" ] ; then
+		eghcup --downloader=wget install 8.10.3
+	else # test wget a bit
+		eghcup install 8.10.3
+	fi
+	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
+	eghcup set 8.10.3
+	eghcup set 8.10.3
+	[ "$(ghc --numeric-version)" = "8.10.3" ]
+	eghcup set ${GHC_VERSION}
+	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
+	eghcup rm 8.10.3
+	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
 
-if [ "${OS}" = "DARWIN" ] ; then
-	eghcup install hls
-	haskell-language-server-wrapper --version
-
-	eghcup install stack
-	stack --version
-elif [ "${OS}" = "LINUX" ] ; then
-	if [ "${ARCH}" = "64" ] ; then
+	if [ "${OS}" = "DARWIN" ] ; then
 		eghcup install hls
 		haskell-language-server-wrapper --version
 
 		eghcup install stack
 		stack --version
+	elif [ "${OS}" = "LINUX" ] ; then
+		if [ "${ARCH}" = "64" ] ; then
+			eghcup install hls
+			haskell-language-server-wrapper --version
+
+			eghcup install stack
+			stack --version
+		fi
 	fi
 fi
 
@@ -150,3 +154,11 @@ fi
 eghcup upgrade
 eghcup upgrade -f
 
+
+# nuke
+eghcup nuke
+if [ "${OS}" = "WINDOWS" ] ; then
+	[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/ghcup" ]
+else
+	[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
+fi

.gitlab/shell.nix

@@ -44,9 +44,6 @@
   # unconditionally add the MacOSX.sdk and TargetConditional.h
   export NIX_CFLAGS_COMPILE+=" -isystem /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/include"
 
-  # Use an architecture specific home, so cabal for different architectures don't confuse each other.
-  export HOME="$HOME/$(uname -m)-home"
-  mkdir -p $HOME
   '';
 
   nativeBuildInputs = (with pkgs; [
@@ -81,6 +78,7 @@
 
     which
     wget
+	curl
     file
 
     xz

CHANGELOG.md

@@ -1,5 +1,9 @@
 # Revision history for ghcup
 
+## 0.1.16 -- ????-??-??
+
+* Add 'nuke' subcommand wrt [#135](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/135), implemented by Arjun Kathuria
+
 ## 0.1.15.2 -- 2021-06-13
 
 * Remove legacy handling of cabal binary and be more graceful about binaries not installed by ghcup (e.g. stack)

README.md

@@ -1,5 +1,5 @@
 `ghcup` makes it easy to install specific versions of `ghc` on GNU/Linux,
-macOS (aka Darwin) and FreeBSD and can also bootstrap a fresh Haskell developer environment from scratch.
+macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh Haskell developer environment from scratch.
 It follows the unix UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well).
 
 Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
@@ -85,7 +85,7 @@ handles your haskell packages and can demand that [a specific version](https://c
 A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
 explaining all possible configurations can be found in this repo: [config.yaml](./config.yaml).
 
-Partial configuration is fine. Command line options always overwrite the config file settings.
+Partial configuration is fine. Command line options always override the config file settings.
 
 ### Manpages
 

app/ghcup/Main.hs

@@ -1113,7 +1113,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
           let loggerConfig = LoggerConfig
                 { lcPrintDebug = verbose settings
                 , colorOutter  = B.hPut stderr
-                , rawOutter    = B.appendFile logfile
+                , rawOutter    =
+                    case optCommand of
+                      Nuke -> \_ -> pure ()
+                      _ -> B.appendFile logfile
                 }
           let runLogger = myLoggerT loggerConfig
           let siletRunLogger = myLoggerT loggerConfig { colorOutter = \_ -> pure () }
@@ -1703,31 +1706,27 @@ Make sure to clean up #{tmpdir} afterwards.|])
 
             Nuke ->
               runRm (do
-                   lift $ runLogger $ $logWarn "WARNING: This will remove GHCup and all installed components from your system."
-                   lift $ runLogger $ $logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time."
+                   lift $ $logWarn "WARNING: This will remove GHCup and all installed components from your system."
+                   lift $ $logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time."
                    liftIO $ threadDelay 10000000  -- wait 10s
 
-                   lift $ runLogger $ $logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
-                   lift $ runLogger $ $logInfo "Nuking in 3...2...1"
+                   lift $ $logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
+                   lift $ $logInfo "Nuking in 3...2...1"
               
-
-                   lInstalled <- lift $ runLogger . flip runReaderT appstate $ listVersions Nothing (Just ListInstalled)
+                   lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
 
                    forM_ lInstalled (liftE . rmTool)
 
-                   leftOverFiles <- lift $ runLogger $ runReaderT rmGhcupDirs appstate
-                   pure leftOverFiles
+                   lift rmGhcupDirs
 
                    ) >>= \case
-                            VRight leftOverFiles -> do
-
-                              case length leftOverFiles of
-                                0 -> do
+                            VRight leftOverFiles
+                              | null leftOverFiles -> do
                                   runLogger $ $logInfo "Nuclear Annihilation complete!"
                                   pure ExitSuccess
-                                _ -> do
-                                  runLogger $ $logWarn "These Directories/Files have survived Nuclear Annihilation, you may remove them manually."
-                                  forM_ leftOverFiles (runLogger . $logDebug . T.pack)
+                              | otherwise -> do
+                                  runLogger $ $logWarn "These Files have survived Nuclear Annihilation, you may remove them manually."
+                                  forM_ leftOverFiles putStrLn
                                   pure ExitSuccess
 
                             VLeft e -> do

bootstrap-haskell.ps1

@@ -319,8 +319,9 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
 }
 
 Print-Msg -msg 'Creating shortcuts...'
-Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath ('{0}\Desktop\Mingw haskell shell.lnk' -f $HOME)
-Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath ('{0}\Desktop\Mingw package management docs.url' -f $HOME)
+$DesktopDir = [Environment]::GetFolderPath("Desktop")
+Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath ('{0}\Mingw haskell shell.lnk' -f $DesktopDir)
+Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath ('{0}\Mingw package management docs.url' -f $DesktopDir)
 
 Print-Msg -msg ('Adding {0}\bin to Users Path...' -f $GhcupDir)
 Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'

cabal.project

@@ -1,5 +1,7 @@
 packages: ./ghcup.cabal
 
+optional-packages: ./vendored/*/*.cabal
+
 optimization: 2
 
 package ghcup

ghcup-0.0.5.yaml

@@ -1,8 +1,8 @@
 ---
 globalTools:
   ShimGen:
-    dlUri: https://downloads.haskell.org/~ghcup/shimgen/gs.exe
-    dlHash: 9ce8b7dad7ff4e5017dbd63d6f6f3d16412b889560cb6ccd3903dbcab0bf4f0d
+    dlUri: https://downloads.haskell.org/~ghcup/shimgen/shim-2.exe
+    dlHash: 7c55e201f71860c5babea886007c8fa44b861abf50d1c07e5677eb0bda387a70
 toolRequirements:
   GHC:
     unknown_version:
@@ -2107,7 +2107,7 @@ ghcupDownloads:
           Darwin:
             unknown_versioning:
               dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-macOS-1.2.0.tar.gz
-              dlHash: 43d2ef356fb8cbd8e27acf70f94c079157258916bb1220751547584513584aaa
+              dlHash: a310d8a3e9c5c4218210f750682c74a0f82ad0f59995adde0dbe775115b1e357
           Windows:
             unknown_versioning:
               dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz

lib/GHCup.hs

@@ -42,6 +42,7 @@ import           GHCup.Version
 import           Codec.Archive                  ( ArchiveResult )
 #endif
 import           Control.Applicative
+import           Control.Exception              ( evaluate )
 import           Control.Exception.Safe
 import           Control.Monad
 #if !MIN_VERSION_base(4,13,0)
@@ -1295,7 +1296,7 @@ rmGhcup = do
   let ghcupFilename = "ghcup" <> exeExt
   let ghcupFilepath = binDir </> ghcupFilename
 
-  currentRunningExecPath <- liftIO $ getExecutablePath
+  currentRunningExecPath <- liftIO getExecutablePath
 
   -- if paths do no exist, warn user, and continue to compare them, as is,
   -- which should eventually fail and result in a non-standard install warning
@@ -1305,29 +1306,25 @@ rmGhcup = do
                   (liftIO $ canonicalizePath currentRunningExecPath)
 
   p2 <- handleIO' doesNotExistErrorType
-                  (handlePathNotPresent ghcupFilename)
-                  (liftIO $ canonicalizePath ghcupFilename)
+                  (handlePathNotPresent ghcupFilepath)
+                  (liftIO $ canonicalizePath ghcupFilepath)
 
   let areEqualPaths = equalFilePath p1 p2
 
-  if areEqualPaths
-    then
-      do
+  unless areEqualPaths $ $logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
+
 #if defined(IS_WINDOWS)
-    -- since it doesn't seem possible to delete a running exec in windows
-    -- we move it to temp dir, to be deleted at next reboot
-        tempDir <- liftIO $ getTemporaryDirectory
-        let tempFilepath = tempDir </> ghcupFilename
-        hideError UnsupportedOperation $
-                  liftIO $ hideError NoSuchThing $
-                  Win32.moveFileEx ghcupFilepath (Just tempFilepath) 1
+  -- since it doesn't seem possible to delete a running exec in windows
+  -- we move it to temp dir, to be deleted at next reboot
+  tempDir <- liftIO $ getTemporaryDirectory
+  let tempFilepath = tempDir </> ghcupFilename
+  hideError UnsupportedOperation $
+            liftIO $ hideError NoSuchThing $
+            Win32.moveFileEx ghcupFilepath (Just tempFilepath) Win32.mOVEFILE_REPLACE_EXISTING
 #else
-    -- delete it.
-        hideError doesNotExistErrorType $ liftIO $ rmFile ghcupFilepath
+  -- delete it.
+  hideError doesNotExistErrorType $ liftIO $ rmFile ghcupFilepath
 #endif
-    else
-      $logWarn $
-      nonStandardInstallLocationMsg currentRunningExecPath
 
   where
     handlePathNotPresent fp _err = do
@@ -1348,86 +1345,73 @@ rmTool :: ( MonadReader AppState m
            -> Excepts '[NotInstalled ] m ()
 
 rmTool ListResult {lVer, lTool, lCross} = do
-  -- appstate <- ask
-
   case lTool of
-    GHC -> do
+    GHC ->
       let ghcTargetVersion = GHCTargetVersion lCross lVer
-      rmGHCVer ghcTargetVersion
+      in rmGHCVer ghcTargetVersion
+    HLS -> rmHLSVer lVer
+    Cabal -> rmCabalVer lVer
+    Stack -> rmStackVer lVer
+    GHCup -> lift rmGhcup
 
-    HLS -> do
-      rmHLSVer lVer
-
-    Cabal -> do
-      rmCabalVer lVer
-
-    Stack -> do
-      rmStackVer lVer
-
-    GHCup -> do
-      lift rmGhcup
 
 rmGhcupDirs :: ( MonadReader AppState m
                , MonadIO m
                , MonadLogger m
                , MonadCatch m
                , MonadMask m )
-                => m [FilePath]
+            => m [FilePath]
 rmGhcupDirs = do
-  dirs@Dirs
+  Dirs
     { baseDir
     , binDir
     , logsDir
     , cacheDir
-    , confDir } <- asks dirs
+    } <- asks dirs
 
   let envFilePath = baseDir </> "env"
 
   confFilePath <- getConfigFilePath
 
-  -- remove env File
-  rmEnvFile envFilePath
-
--- remove the configFile file
+  rmEnvFile  envFilePath
   rmConfFile confFilePath
+  rmDir cacheDir
+  rmDir logsDir
+  rmBinDir   binDir
+#if defined(IS_WINDOWS)
+  rmDir (baseDir </> "msys64")
+#endif
 
-  -- remove entire cache Dir
-  rmCacheDir cacheDir
+  liftIO $ removeEmptyDirsRecursive baseDir
 
-  -- remove entire logs Dir
-  rmLogsDir logsDir
-
-  -- remove bin directory conditionally
-  rmBinDir binDir
-
-  -- report files in baseDir that are left-over after the standard location deletions above
-  reportRemainingFiles baseDir
+  -- report files in baseDir that are left-over after
+  -- the standard location deletions above
+  hideErrorDef [doesNotExistErrorType] [] $ reportRemainingFiles baseDir
 
   where
 
+    rmEnvFile :: (MonadCatch m, MonadLogger m, MonadIO m) => FilePath -> m ()
     rmEnvFile enFilePath = do
       $logInfo "Removing Ghcup Environment File"
       hideError doesNotExistErrorType $ liftIO $ deleteFile enFilePath
 
+    rmConfFile :: (MonadCatch m, MonadLogger m, MonadIO m) => FilePath -> m ()
     rmConfFile confFilePath = do
       $logInfo "removing Ghcup Config File"
       hideError doesNotExistErrorType $ liftIO $ deleteFile confFilePath
 
-    rmCacheDir cacheDir = do
-      $logInfo "removing ghcup cache Dir"
-      contents <- liftIO $ listDirectory cacheDir
-      forM_ contents deleteFile
-      removeDirIfEmptyOrIsSymlink cacheDir
-
-    rmLogsDir logsDir = do
-      $logInfo "removing ghcup logs Dir"
-      contents <- liftIO $ listDirectory logsDir
-      forM_ contents deleteFile
-      removeDirIfEmptyOrIsSymlink logsDir
+    rmDir :: (MonadLogger m, MonadIO m, MonadCatch m) => FilePath -> m ()
+    rmDir dir = do
+      $logInfo [i|removing #{dir}|]
+      contents <- hideErrorDef [doesNotExistErrorType] []
+        $ liftIO
+        (getDirectoryContentsRecursive dir >>= evaluate)
+      forM_ contents (liftIO . deleteFile . (dir </>))
 
+    rmBinDir :: (MonadCatch m, MonadIO m) => FilePath -> m ()
     rmBinDir binDir = do
 #if !defined(IS_WINDOWS)
-      isXDGStyle <- liftIO $ useXDG
+      isXDGStyle <- liftIO useXDG
       if not isXDGStyle
         then removeDirIfEmptyOrIsSymlink binDir
         else pure ()
@@ -1435,11 +1419,12 @@ rmGhcupDirs = do
       removeDirIfEmptyOrIsSymlink binDir
 #endif
 
-    reportRemainingFiles ghcupDir = do
-      remainingFiles <- liftIO $ getDirectoryContentsRecursive ghcupDir
+    reportRemainingFiles :: MonadIO m => FilePath -> m [FilePath]
+    reportRemainingFiles dir = do
+      remainingFiles <- liftIO $ getDirectoryContentsRecursive dir
       let normalizedFilePaths = fmap normalise remainingFiles
-      let sortedByDepthRemainingFiles = reverse $ sortBy compareFn normalizedFilePaths
-      remainingFilesAbsolute <- makePathsAbsolute sortedByDepthRemainingFiles
+      let sortedByDepthRemainingFiles = sortBy (flip compareFn) normalizedFilePaths
+      let remainingFilesAbsolute = fmap (dir </>) sortedByDepthRemainingFiles
 
       pure remainingFilesAbsolute
 
@@ -1450,17 +1435,22 @@ rmGhcupDirs = do
         compareFn :: FilePath -> FilePath -> Ordering
         compareFn fp1 fp2 = compare (calcDepth fp1) (calcDepth fp2)
 
-    makePathsAbsolute :: (MonadIO m) => [FilePath] -> m [FilePath]
-    makePathsAbsolute paths = liftIO $
-                              traverse (makeAbsolute . normalise) paths
+    removeEmptyDirsRecursive :: FilePath -> IO ()
+    removeEmptyDirsRecursive fp = do
+      cs <- listDirectory fp >>= filterM doesDirectoryExist . fmap (fp </>)
+      forM_ cs removeEmptyDirsRecursive
+      hideError InappropriateType $ removeDirIfEmptyOrIsSymlink fp
+        
 
     -- we expect only files inside cache/log dir
     -- we report remaining files/dirs later,
     -- hence the force/quiet mode in these delete functions below.
 
+    deleteFile :: FilePath -> IO ()
     deleteFile filepath = do
       hideError InappropriateType $ rmFile filepath
 
+    removeDirIfEmptyOrIsSymlink :: (MonadCatch m, MonadIO m) => FilePath -> m ()
     removeDirIfEmptyOrIsSymlink filepath =
       hideError UnsatisfiedConstraints $
       handleIO' InappropriateType
@@ -1473,6 +1463,8 @@ rmGhcupDirs = do
           then liftIO $ deleteFile fp
           else liftIO $ ioError e
 
+
+
     ------------------
     --[ Debug info ]--
     ------------------
@@ -1813,14 +1805,14 @@ upgradeGHCup :: ( MonadMask m
                    ]
                   m
                   Version
-upgradeGHCup mtarget force = do
+upgradeGHCup mtarget force' = do
   AppState { dirs = Dirs {..}
            , pfreq
            , ghcupInfo = GHCupInfo { _ghcupDownloads = dls }
            , settings } <- lift ask
   lift $ $(logInfo) [i|Upgrading GHCup...|]
   let latestVer = fromJust $ fst <$> getLatest dls GHCup
-  when (not force && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
+  when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
   dli   <- lE $ getDownloadInfo GHCup latestVer pfreq dls
   tmp   <- lift withGHCupTmpDir
   let fn = "ghcup" <> exeExt

lib/GHCup/Utils/Prelude.hs

@@ -190,14 +190,14 @@ hideError :: (MonadIO m, MonadCatch m) => IOErrorType -> m () -> m ()
 hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else liftIO . ioError $ e)
 
 
-hideErrorDef :: [IOErrorType] -> a -> IO a -> IO a
+hideErrorDef :: (MonadIO m, MonadCatch m) => [IOErrorType] -> a -> m a -> m a
 hideErrorDef errs def =
-  handleIO (\e -> if ioeGetErrorType e `elem` errs then pure def else ioError e)
+  handleIO (\e -> if ioeGetErrorType e `elem` errs then pure def else liftIO $ ioError e)
 
 
-hideErrorDefM :: [IOErrorType] -> IO a -> IO a -> IO a
+hideErrorDefM :: (MonadIO m, MonadCatch m) => [IOErrorType] -> m a -> m a -> m a
 hideErrorDefM errs def =
-  handleIO (\e -> if ioeGetErrorType e `elem` errs then def else ioError e)
+  handleIO (\e -> if ioeGetErrorType e `elem` errs then def else liftIO $ ioError e)
 
 
 -- TODO: does this work?
@@ -334,12 +334,13 @@ copyDirectoryRecursive srcDir destDir = do
                    in doCopy src dest
                 | (srcBase, srcFile) <- srcFiles ]
 
-    -- | List all the files in a directory and all subdirectories.
-    --
-    -- The order places files in sub-directories after all the files in their
-    -- parent directories. The list is generated lazily so is not well defined if
-    -- the source directory structure changes before the list is used.
-    --
+
+-- | List all the files in a directory and all subdirectories.
+--
+-- The order places files in sub-directories after all the files in their
+-- parent directories. The list is generated lazily so is not well defined if
+-- the source directory structure changes before the list is used.
+--
 getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
 getDirectoryContentsRecursive topdir = recurseDirectories [""]
   where