Fix 'ghcup install hls -u' on windows

Fixes #716

.github/scripts/common.sh

@@ -87,39 +87,29 @@ download_cabal_cache() {
 	cd /tmp
 	case "${RUNNER_OS}" in
 		"Linux")
-			case "${DISTRO}" in
-				"Alpine")
-					case "${ARCH}" in
-						"32") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/i386-linux-alpine-cabal-cache-1.0.5.1
-							;;
-						"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/x86_64-linux-alpine-cabal-cache-1.0.5.1
-							;;
-					esac
+			case "${ARCH}" in
+				"32") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/i386-linux-cabal-cache
 					;;
-				*)
-					case "${ARCH}" in
-						"64") url=https://github.com/haskell-works/cabal-cache/releases/download/v1.0.5.1/cabal-cache-x86_64-linux.gz
-							;;
-						"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/aarch64-linux-cabal-cache-1.0.5.1
-							;;
-						"ARM") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/armv7-linux-cabal-cache-1.0.5.1
-							;;
-					esac
+				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-linux-cabal-cache
+					;;
+				"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/aarch64-linux-cabal-cache
+					;;
+				"ARM") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/armv7-linux-cabal-cache
 					;;
 			esac
 			;;
 		"FreeBSD")
-			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/x86_64-freebsd-cabal-cache-1.0.5.1
+			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-portbld-freebsd-cabal-cache
 			;;
 		"Windows")
 			exe=".exe"
-			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/x86_64-mingw64-cabal-cache-1.0.5.1.exe
+			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-mingw64-cabal-cache
 			;;
 		"macOS")
 			case "${ARCH}" in
-				"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/aarch64-apple-darwin-cabal-cache-1.0.5.1
+				"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/aarch64-apple-darwin-cabal-cache
 					;;
-				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/x86_64-apple-darwin-cabal-cache-1.0.5.1
+				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-apple-darwin-cabal-cache
 					;;
 			esac
 			;;
@@ -134,8 +124,9 @@ download_cabal_cache() {
 				curl -o cabal-cache${exe} -L "${url}"
 				;;
 		esac
-		chmod +x cabal-cache${exe}
-		cp "cabal-cache${exe}" "${dest}${exe}"
+		sha_sum cabal-cache${exe}
+		mv "cabal-cache${exe}" "${dest}${exe}"
+		chmod +x "${dest}${exe}"
 	fi
     )
 }
@@ -167,13 +158,15 @@ install_ghcup() {
 strip_binary() {
 	(
 	set -e
-	binary=$1
-	if [ "${RUNNER_OS}" = "macOS" ] ; then
-		strip "${binary}"
-	else
-		if [ "${RUNNER_OS}" != "Windows" ] ; then
+	local binary=$1
+	case "$(uname -s)" in
+		"Darwin"|"darwin")
+			;;
+		MSYS_*|MINGW*)
+			;;
+		*)
 			strip -s "${binary}"
-		fi
-	fi
+		   ;;
+   esac
 	)
 }

.github/workflows/release.yaml

@@ -102,7 +102,7 @@ jobs:
       - uses: docker://arm64v8/ubuntu:focal
         name: Cleanup (aarch64 linux)
         with:
-          args: rm -rf .ghcup/ cabal/ dist-newstyle/ out/
+          args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
 
       - name: git config
         run: |
@@ -297,7 +297,7 @@ jobs:
       - uses: docker://arm64v8/ubuntu:focal
         name: Cleanup (aarch64 linux)
         with:
-          args: rm -rf .ghcup/ cabal/ dist-newstyle/ out/
+          args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
 
       - name: Checkout code
         uses: actions/checkout@v3
@@ -313,7 +313,7 @@ jobs:
         uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
         name: Run build (armv7 linux)
         with:
-          run: sh .github/scripts/test.sh
+          args: sh .github/scripts/test.sh
         env:
           ARTIFACT: ${{ matrix.ARTIFACT }}
           ARCH: ${{ matrix.ARCH }}
@@ -324,7 +324,7 @@ jobs:
         uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
         name: Run build (aarch64 linux)
         with:
-          run: sh .github/scripts/test.sh
+          args: sh .github/scripts/test.sh
         env:
           ARTIFACT: ${{ matrix.ARTIFACT }}
           ARCH: ${{ matrix.ARCH }}

app/ghcup/BrickMain.hs

@@ -13,6 +13,7 @@ import           GHCup.Errors
 import           GHCup.Types.Optics ( getDirs )
 import           GHCup.Types         hiding ( LeanAppState(..) )
 import           GHCup.Utils
+import           GHCup.OptParse.Common (logGHCPostRm)
 import           GHCup.Prelude ( decUTF8Safe )
 import           GHCup.Prelude.File
 import           GHCup.Prelude.Logger
@@ -554,6 +555,7 @@ del' _ (_, ListResult {..}) = do
     )
     >>= \case
           VRight vi -> do
+            logGHCPostRm (mkTVer lVer)
             forM_ (_viPostRemove =<< vi) $ \msg ->
               logInfo msg
             pure $ Right ()

app/ghcup/GHCup/OptParse/Common.hs

@@ -25,6 +25,7 @@ import           Control.DeepSeq
 import           Control.Concurrent
 import           Control.Concurrent.Async
 import           Control.Exception.Safe
+import           Control.Monad.Identity (Identity(..))
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
@@ -64,6 +65,7 @@ import qualified Text.Megaparsec               as MP
 import qualified System.FilePath.Posix         as FP
 import GHCup.Version
 import Control.Exception (evaluate)
+import qualified Cabal.Config            as CC
 
 
     -------------
@@ -789,3 +791,12 @@ checkForUpdates = do
   pure $ catMaybes (ghcup:otherTools)
  where
   forMM a f = fmap join $ forM a f
+
+
+logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
+logGHCPostRm ghcVer = do
+  cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store")
+    (runIdentity . CC.cfgStoreDir <$> CC.readConfig)
+  let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
+  logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir
+

app/ghcup/GHCup/OptParse/Config.hs

@@ -188,9 +188,15 @@ config configCommand settings keybindings runLogger = case configCommand of
       AddSource xs -> do
         doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
         pure ExitSuccess
-      _ -> do
+      GHCupURL -> do
         doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
         pure ExitSuccess
+      OwnSource xs -> do
+        doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (xs <> [Right uri]) })
+        pure ExitSuccess
+      OwnSpec spec -> do
+        doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource ([Left spec, Right uri]) })
+        pure ExitSuccess
 
  where
   doConfig :: MonadIO m => UserSettings -> m ()

app/ghcup/GHCup/OptParse/Install.hs

@@ -452,7 +452,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
            (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
            -- TODO: support legacy
            liftE $ runBothE' (installHLSBindist
-                                      (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
+                                      (DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "")
                                       v
                                       (maybe GHCupInternal IsolateDir isolateDir)
                                       forceInstall

app/ghcup/GHCup/OptParse/Rm.hs

@@ -175,8 +175,8 @@ rm rmCommand runAppState runLogger = case rmCommand of
       )
       >>= \case
             VRight vi -> do
-              forM_ (_viPostRemove =<< vi) $ \msg ->
-                runLogger $ logInfo msg
+              runLogger $ logGHCPostRm ghcVer
+              postRmLog vi
               pure ExitSuccess
             VLeft  e -> do
               runLogger $ logError $ T.pack $ prettyShow e
@@ -191,8 +191,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
       )
       >>= \case
             VRight vi -> do
-              forM_ (_viPostRemove =<< vi) $ \msg ->
-                runLogger $ logInfo msg
+              postRmLog vi
               pure ExitSuccess
             VLeft  e -> do
               runLogger $ logError $ T.pack $ prettyShow e
@@ -207,8 +206,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
       )
       >>= \case
             VRight vi -> do
-              forM_ (_viPostRemove =<< vi) $ \msg ->
-                runLogger $ logInfo msg
+              postRmLog vi
               pure ExitSuccess
             VLeft  e -> do
               runLogger $ logError $ T.pack $ prettyShow e
@@ -223,10 +221,12 @@ rm rmCommand runAppState runLogger = case rmCommand of
       )
       >>= \case
             VRight vi -> do
-              forM_ (_viPostRemove =<< vi) $ \msg ->
-                runLogger $ logInfo msg
+              postRmLog vi
               pure ExitSuccess
             VLeft  e -> do
               runLogger $ logError $ T.pack $ prettyShow e
               pure $ ExitFailure 15
 
+  postRmLog vi =
+    forM_ (_viPostRemove =<< vi) $ \msg ->
+      runLogger $ logInfo msg

app/ghcup/Main.hs

@@ -253,7 +253,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
                                         logWarn ("New "
                                           <> T.pack (prettyShow t)
                                           <> " version available. "
-                                          <> "To upgrade, run 'ghcup install "
+                                          <> "If you want to install this latest version, run 'ghcup install "
                                           <> T.pack (prettyShow t)
                                           <> " "
                                           <> prettyVer l

docs/install.md

@@ -48,6 +48,10 @@ The following distro packages are required: `build-essential curl libffi-dev lib
 
 The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
 
+### Linux Mageia
+
+The following distro packages are required: `curl gcc gcc-c++ gmp libffi-devel libffi7 libgmp-devel libgmp10 make libncurses-devel libncurses5 xz perl`
+
 ### Linux CentOS
 
 The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`

ghcup.cabal

@@ -247,6 +247,7 @@ executable ghcup
     , base                  >=4.12     && <5
     , bytestring            >=0.10     && <0.12
     , cabal-plan            ^>=0.7.2
+    , cabal-install-parsers >=0.4.5
     , containers            ^>=0.6
     , deepseq               ^>=1.4
     , directory             ^>=1.3.6.0

lib/GHCup/GHC.hs

@@ -676,7 +676,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
                          (view dlSubdir dlInfo)
         liftE $ applyAnyPatch patches (fromGHCupPath workdir)
 
-        pure (workdir, tmpUnpack, tver)
+        pure (workdir, tmpUnpack, Just tver)
 
       RemoteDist uri -> do
         lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
@@ -694,12 +694,13 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
                            execBlank
                            regex
             )
-          tver <- liftE $ getGHCVer (appendGHCupPath tmpUnpack (takeDirectory bootFile))
+          tver <- liftE $ catchAllE @_ @'[ProcessError, ParseError] @'[] (\_ -> pure Nothing) $ fmap Just $ getGHCVer
+            (appendGHCupPath tmpUnpack (takeDirectory bootFile))
           pure (bootFile, tver)
 
         let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
 
-        pure (workdir, tmpUnpack, mkTVer tver)
+        pure (workdir, tmpUnpack, mkTVer <$> tver)
 
       -- clone from git
       GitDist GitBranch{..} -> do
@@ -745,20 +746,23 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
           liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
 
           -- bootstrap
-          tver <- liftE $ getGHCVer tmpUnpack
+          tver <- liftE $ catchAllE @_ @'[ProcessError, ParseError] @'[] (\_ -> pure Nothing) $ fmap Just $ getGHCVer
+            tmpUnpack
           liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
           lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n  " <>
-                           "GHC version (from Makefile): " <> prettyVer tver <>
+                           "GHC version (from Makefile): " <> T.pack (show (prettyVer <$> tver)) <>
                            (if not shallow_clone then "\n  " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
                            (if isCommitHash ref then mempty else "\n  " <> "commit hash: " <> chash)
           liftIO $ threadDelay 5000000 -- give the user a sec to intervene
 
           pure tver
 
-        pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
+        pure (tmpUnpack, tmpUnpack, mkTVer <$> tver)
     -- the version that's installed may differ from the
     -- compiled version, so the user can overwrite it
-    let installVer = maybe tver (\ov' -> tver { _tvVersion = ov' }) ov
+    installVer <- if | Just ov'   <- ov   -> pure (mkTVer ov')
+                     | Just tver' <- tver -> pure tver'
+                     | otherwise          -> fail "Newer GHCs don't support discovering the version in git. Complain to GHC devs: https://gitlab.haskell.org/ghc/ghc/-/issues/22322"
 
     alreadyInstalled <- lift $ ghcInstalled installVer
     alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
@@ -781,8 +785,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
       tmpUnpack
       (do
         b <- if hadrian
-             then compileHadrianBindist tver (fromGHCupPath workdir) ghcdir
-             else compileMakeBindist tver (fromGHCupPath workdir) ghcdir
+             -- prefer 'tver', because the real version carries out compatibility checks
+             -- we don't want the user to do funny things with it
+             then compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
+             else compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
         bmk <- liftIO $ handleIO (\_ -> pure "") $ B.readFile (build_mk $ fromGHCupPath workdir)
         pure (b, bmk)
       )
@@ -826,14 +832,14 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
                , MonadThrow m
                )
             => GHCupPath
-            -> Excepts '[ProcessError] m Version
+            -> Excepts '[ProcessError, ParseError] m Version
   getGHCVer tmpUnpack = do
     lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
     lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
     CapturedProcess {..} <- lift $ makeOut
       ["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
     case _exitCode of
-      ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
+      ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
       ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
 
   defaultConf =

scripts/bootstrap/bootstrap-haskell.ps1

@@ -610,7 +610,7 @@ if ($DisableCurl) {
 if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
   Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]]  && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
 } else {
-  Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]]  && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
+  Exec "$Msys2Shell" '-mingw64' '-mintty'  '-shell' 'bash' '-c' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]]  && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
 }