Improve add-release-channel, fixes #708

.github/scripts/common.sh

@@ -10,16 +10,6 @@ ecabal() {
 	cabal "$@"
 }
 
-sync_from_retry() {
-	if [ "${RUNNER_OS}" != "Windows" ] ; then
-		cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
-	else
-		cabal_store_path="${CABAL_DIR}/store"
-	fi
-
-    sync_from || { sleep 9 ; rm -rf "${cabal_store_path:?}"/* ; sync_from || { sleep 20 ; rm -rf "${cabal_store_path:?}"/* ; sync_from ; } }
-}
-
 sync_from() {
 	if [ "${RUNNER_OS}" != "Windows" ] ; then
 		cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
@@ -34,10 +24,6 @@ sync_from() {
 		--archive-uri "s3://ghcup-hs/${RUNNER_OS}-${ARCH}-${DISTRO}"
 }
 
-sync_to_retry() {
-    sync_to || { sleep 9 ; sync_to || { sleep 20 ; sync_to ; } }
-}
-
 sync_to() {
 	if [ "${RUNNER_OS}" != "Windows" ] ; then
 		cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
@@ -143,11 +129,11 @@ download_cabal_cache() {
 build_with_cache() {
 	ecabal configure "$@"
 	ecabal build --dependencies-only "$@" --dry-run
-	sync_from_retry
-	ecabal build --dependencies-only "$@" || sync_to_retry
-	sync_to_retry
+	sync_from
+	ecabal build --dependencies-only "$@" || sync_to
+	sync_to
 	ecabal build "$@"
-	sync_to_retry
+	sync_to
 }
 
 install_ghcup() {

.github/scripts/hls.sh

@@ -57,9 +57,9 @@ eghcup debug-info
 	cd "haskell-language-server-${HLS_TARGET_VERSION}/"
 	ecabal configure -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)"
 	ecabal build --dependencies-only -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)" --dry-run
-	sync_from_retry
+	sync_from
 	ecabal build --dependencies-only -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)" || sync_to
-	sync_to_retry
+	sync_to
 )
 
 eghcup -v compile hls -j "$(nproc)" -g "${HLS_TARGET_VERSION}" --ghc "${GHC_VERSION}"

.github/workflows/cache.yaml

@@ -1,37 +0,0 @@
-name: Cache eviction
-
-on:
-  workflow_dispatch:
-    inputs:
-      key:
-        description: Which cache to evict
-        required: true
-        default: '/'
-        type: choice
-        options:
-        - FreeBSD-64-na
-        - Linux-32-Alpine
-        - Linux-64-Alpine
-        - Linux-64-Ubuntu
-        - Linux-ARM-Ubuntu
-        - Linux-ARM64-Ubuntu
-        - Windows-64-na
-        - macOS-64-na
-        - macOS-ARM64-na
-        - /
-jobs:
-  evict:
-    runs-on: ubuntu-latest
-
-    steps:
-    - name: Remove from S3
-      uses: vitorsgomes/s3-rm-action@master
-      with:
-        args: --recursive
-      env:
-        AWS_S3_ENDPOINT: ${{ secrets.S3_HOST }}
-        AWS_S3_BUCKET: ghcup-hs
-        AWS_REGION: us-west-2
-        AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
-        AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
-        PATH_TO_DELETE: ${{ github.event.inputs.key }}

app/ghcup/BrickMain.hs

@@ -13,7 +13,6 @@ 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
@@ -555,7 +554,6 @@ 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,7 +25,6 @@ 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
@@ -65,7 +64,6 @@ 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
 
 
     -------------
@@ -791,12 +789,3 @@ 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/Rm.hs

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

ghcup.cabal

@@ -247,7 +247,6 @@ 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