Update changelog

Fixes #333

.gitlab-ci.yml

@@ -15,6 +15,9 @@ variables:
   # Bump to invalidate GitLab CI cache.
   CACHE_REV: 0
 
+  GIT_SUBMODULE_STRATEGY: recursive
+
+
 ############################################################
 # CI Step
 ############################################################
@@ -115,7 +118,7 @@ variables:
   script:
     - bash ./.gitlab/script/ghcup_version.sh
   variables:
-    JSON_VERSION: "0.0.6"
+    JSON_VERSION: "0.0.7"
   artifacts:
     expire_in: 2 week
     paths:
@@ -186,8 +189,8 @@ variables:
     - export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
     - mkdir -p $CI_PROJECT_DIR/.brew_logs
     - export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
-    - mkdir -p $CI_PROJECT_DIR/.brew_tmp
+    - mkdir -p /private/tmp/.brew_tmp
-    - export HOMEBREW_TEMP=$CI_PROJECT_DIR/.brew_tmp
+    - export HOMEBREW_TEMP=/private/tmp/.brew_tmp
 
     # update and install packages
     - brew update
@@ -217,6 +220,9 @@ variables:
     - .freebsd13
     - .root_cleanup
   before_script:
+    - sudo pkg update
+    - sudo pkg install --yes compat12x-amd64
+    - sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
     - ./.gitlab/before_script/freebsd/install_deps.sh
 
 .test_ghcup_version:windows:
@@ -245,7 +251,7 @@ variables:
   only:
     - tags
   variables:
-    JSON_VERSION: "0.0.6"
+    JSON_VERSION: "0.0.7"
 
 ######## stack test ########
 
@@ -545,8 +551,8 @@ release:darwin:aarch64:
     - export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
     - mkdir -p $CI_PROJECT_DIR/.brew_logs
     - export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
-    - mkdir -p $CI_PROJECT_DIR/.brew_tmp
+    - mkdir -p /private/tmp/.brew_tmp
-    - export HOMEBREW_TEMP=$CI_PROJECT_DIR/.brew_tmp
+    - export HOMEBREW_TEMP=/private/tmp/.brew_tmp
 
     # update and install packages
     - brew update
@@ -595,6 +601,9 @@ release:freebsd13:
     - .release_ghcup
     - .root_cleanup
   before_script:
+    - sudo pkg update
+    - sudo pkg install --yes compat12x-amd64
+    - sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
     - ./.gitlab/before_script/freebsd/install_deps.sh
   variables:
     ARTIFACT: "x86_64-portbld-freebsd-ghcup"

.gitlab/after_script.sh

@@ -12,4 +12,8 @@ if [ "${OS}" = "WINDOWS" ] ; then
 	rm -Rf /c/ghcup
 fi
 
+if [ "${OS}" = "DARWIN" ] ; then
+	rm -Rf /private/tmp/.brew_tmp
+fi
+
 exit 0

.gitlab/before_script/freebsd/install_deps.sh

@@ -8,7 +8,15 @@ set -eux
 
 mkdir -p "${TMPDIR}"
 
-curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
+if freebsd-version | grep -E '^12.*' ; then
+	freebsd_ver=12
+elif freebsd-version | grep -E '^13.*' ; then
+	freebsd_ver=13
+else
+	(>&2 echo "Unsupported FreeBSD version! Please report a bug at https://gitlab.haskell.org/haskell/ghcup-hs/-/issues")
+	exit 1
+fi
+curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-freebsd${freebsd_ver}-ghcup > ./ghcup-bin
 chmod +x ghcup-bin
 
 ./ghcup-bin -v upgrade -i -f

.gitlab/ghcup-run.files

@@ -0,0 +1,37 @@
+.
+./cabal
+./ghc
+./ghc-8.10.7
+./ghc-pkg
+./ghc-pkg-8.10.7
+./ghci
+./ghci-8.10.7
+./haddock
+./haddock-8.10.7
+./haskell-language-server-8.10.6
+./haskell-language-server-8.10.6~1.6.1.0
+./haskell-language-server-8.10.7
+./haskell-language-server-8.10.7~1.6.1.0
+./haskell-language-server-8.6.5
+./haskell-language-server-8.6.5~1.6.1.0
+./haskell-language-server-8.8.4
+./haskell-language-server-8.8.4~1.6.1.0
+./haskell-language-server-9.0.1
+./haskell-language-server-9.0.1~1.6.1.0
+./haskell-language-server-9.0.2
+./haskell-language-server-9.0.2~1.6.1.0
+./haskell-language-server-9.2.1
+./haskell-language-server-9.2.1~1.6.1.0
+./haskell-language-server-wrapper
+./haskell-language-server-wrapper-1.6.1.0
+./hp2ps
+./hp2ps-8.10.7
+./hpc
+./hpc-8.10.7
+./hsc2hs
+./hsc2hs-8.10.7
+./runghc
+./runghc-8.10.7
+./runhaskell
+./runhaskell-8.10.7
+./stack

.gitlab/ghcup-run.files.windows

@@ -0,0 +1,81 @@
+.
+./cabal.exe
+./cabal.shim
+./ghc-8.10.7.exe
+./ghc-8.10.7.shim
+./ghc-pkg-8.10.7.exe
+./ghc-pkg-8.10.7.shim
+./ghc-pkg.exe
+./ghc-pkg.shim
+./ghc.exe
+./ghc.shim
+./ghci-8.10.7.exe
+./ghci-8.10.7.shim
+./ghci.exe
+./ghci.shim
+./ghcii-8.10.7.sh-8.10.7.exe
+./ghcii-8.10.7.sh-8.10.7.shim
+./ghcii-8.10.7.sh.exe
+./ghcii-8.10.7.sh.shim
+./ghcii.sh-8.10.7.exe
+./ghcii.sh-8.10.7.shim
+./ghcii.sh.exe
+./ghcii.sh.shim
+./haddock-8.10.7.exe
+./haddock-8.10.7.shim
+./haddock.exe
+./haddock.shim
+./haskell-language-server-8.10.6.exe
+./haskell-language-server-8.10.6.shim
+./haskell-language-server-8.10.6~1.6.1.0.exe
+./haskell-language-server-8.10.6~1.6.1.0.shim
+./haskell-language-server-8.10.7.exe
+./haskell-language-server-8.10.7.shim
+./haskell-language-server-8.10.7~1.6.1.0.exe
+./haskell-language-server-8.10.7~1.6.1.0.shim
+./haskell-language-server-8.6.5.exe
+./haskell-language-server-8.6.5.shim
+./haskell-language-server-8.6.5~1.6.1.0.exe
+./haskell-language-server-8.6.5~1.6.1.0.shim
+./haskell-language-server-8.8.4.exe
+./haskell-language-server-8.8.4.shim
+./haskell-language-server-8.8.4~1.6.1.0.exe
+./haskell-language-server-8.8.4~1.6.1.0.shim
+./haskell-language-server-9.0.1.exe
+./haskell-language-server-9.0.1.shim
+./haskell-language-server-9.0.1~1.6.1.0.exe
+./haskell-language-server-9.0.1~1.6.1.0.shim
+./haskell-language-server-9.0.2.exe
+./haskell-language-server-9.0.2.shim
+./haskell-language-server-9.0.2~1.6.1.0.exe
+./haskell-language-server-9.0.2~1.6.1.0.shim
+./haskell-language-server-9.2.1.exe
+./haskell-language-server-9.2.1.shim
+./haskell-language-server-9.2.1~1.6.1.0.exe
+./haskell-language-server-9.2.1~1.6.1.0.shim
+./haskell-language-server-wrapper-1.6.1.0.exe
+./haskell-language-server-wrapper-1.6.1.0.shim
+./haskell-language-server-wrapper.exe
+./haskell-language-server-wrapper.shim
+./hp2ps-8.10.7.exe
+./hp2ps-8.10.7.shim
+./hp2ps.exe
+./hp2ps.shim
+./hpc-8.10.7.exe
+./hpc-8.10.7.shim
+./hpc.exe
+./hpc.shim
+./hsc2hs-8.10.7.exe
+./hsc2hs-8.10.7.shim
+./hsc2hs.exe
+./hsc2hs.shim
+./runghc-8.10.7.exe
+./runghc-8.10.7.shim
+./runghc.exe
+./runghc.shim
+./runhaskell-8.10.7.exe
+./runhaskell-8.10.7.shim
+./runhaskell.exe
+./runhaskell.shim
+./stack.exe
+./stack.shim

.gitlab/script/ghcup_cross.sh

@@ -5,8 +5,6 @@ set -eux
 . "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
 
 mkdir -p "$CI_PROJECT_DIR"/.local/bin
-mkdir -p data/
-git clone https://github.com/haskell/ghcup-metadata.git data/metadata
 
 CI_PROJECT_DIR=$(pwd)
 

.gitlab/script/ghcup_git.sh

@@ -5,8 +5,6 @@ set -eux
 . "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
 
 mkdir -p "$CI_PROJECT_DIR"/.local/bin
-mkdir -p data/
-git clone https://github.com/haskell/ghcup-metadata.git data/metadata
 
 CI_PROJECT_DIR=$(pwd)
 

.gitlab/script/ghcup_hls.sh

@@ -5,8 +5,6 @@ set -eux
 . "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
 
 mkdir -p "$CI_PROJECT_DIR"/.local/bin
-mkdir -p data/
-git clone https://github.com/haskell/ghcup-metadata.git data/metadata
 
 CI_PROJECT_DIR=$(pwd)
 
@@ -43,7 +41,7 @@ cabal --version
 
 eghcup debug-info
 
-eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} ${GHC_VERSION}
+eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} --ghc ${GHC_VERSION}
 
 [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ]
 

.gitlab/script/ghcup_version.sh

@@ -5,8 +5,6 @@ set -eux
 . "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
 
 mkdir -p "$CI_PROJECT_DIR"/.local/bin
-mkdir -p data/
-git clone https://github.com/haskell/ghcup-metadata.git data/metadata
 
 CI_PROJECT_DIR=$(pwd)
 
@@ -85,7 +83,6 @@ else
 	ext=''
 fi
 	cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup${ext}
-	cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup-gen')" "$CI_PROJECT_DIR"/.local/bin/ghcup-gen${ext}
 
 ### cleanup
 
@@ -94,12 +91,11 @@ rm -rf "${GHCUP_DIR}"
 ### manual cli based testing
 
 
-ghcup-gen check -f data/metadata/ghcup-${JSON_VERSION}.yaml
-
 eghcup --numeric-version
 
 eghcup install ghc ${GHC_VERSION}
 [ `$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version` = "${GHC_VERSION}" ]
+[ `eghcup run --ghc ${GHC_VERSION} -- ghc --numeric-version` = "${GHC_VERSION}" ]
 eghcup set ghc ${GHC_VERSION}
 eghcup install cabal ${CABAL_VERSION}
 [ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
@@ -107,6 +103,22 @@ eghcup unset cabal
 "$GHCUP_BIN"/cabal --version && exit || echo yes
 eghcup set cabal ${CABAL_VERSION}
 [ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
+[ `eghcup run --cabal ${CABAL_VERSION} -- cabal --numeric-version` = "${CABAL_VERSION}" ]
+
+if [ "${OS}" != "FREEBSD" ] ; then
+	if [ "${ARCH}" = "64" ] ; then
+		eghcup run --ghc 8.10.7 --cabal 3.4.1.0 --hls 1.6.1.0 --stack 2.7.3 --install --bindir "$(pwd)/.bin"
+		if [ "${OS}" == "WINDOWS" ] ; then
+			expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files.windows" | sort)
+		else
+			expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files" | sort)
+		fi
+		actual=$(cd ".bin" && find . | sort)
+		[ "${actual}" = "${expected}" ]
+		unset actual expected
+		rm -rf .bin
+	fi
+fi
 
 cabal --version
 
@@ -136,7 +148,7 @@ else
 		eghcup --offline install ghc 8.10.3
 		if [ "${ARCH}" = "64" ] ; then
 			expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort)
-			actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
+			actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort)
 			[ "${actual}" = "${expected}" ]
 			unset actual expected
 		fi
@@ -144,7 +156,7 @@ else
 		eghcup prefetch ghc 8.10.3
 		eghcup --offline install ghc 8.10.3
 		expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort)
-		actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
+		actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort)
 		[ "${actual}" = "${expected}" ]
 		unset actual expected
 	else
@@ -185,6 +197,8 @@ else
 	fi
 fi
 
+
+
 # check that lazy loading works for 'whereis'
 cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
 echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"

.gitmodules

@@ -0,0 +1,4 @@
+[submodule "data/metadata"]
+	path = data/metadata
+	url = https://github.com/haskell/ghcup-metadata.git
+	branch = master

CHANGELOG.md

@@ -1,5 +1,39 @@
 # Revision history for ghcup
 
+## 0.1.17.6 -- ????-??-??
+
+* Vastly improve shell completions wrt [#242](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/242)
+* Fix 'ghcup install cabal/hls/stack --set' wrt [#324](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/324)
+* Fix bad error message wrt [#323](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/323)
+* Use predictable /tmp names for `ghcup run`, fixes [#329](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/329)
+* Fix bug with isolated installation of not previously installed versions
+* Add `--no-set` to install commands, fixes [#330](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/330)
+* Fix serious bug in `ghcup list --raw-format -t <tool> -c installed`
+* Overhaul metadata merging and add `ghcup config add-release-channel URI` wrt [#328](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/328)
+* Fix max path issues on windows with `ghcup run`
+
+## 0.1.17.5 -- 2022-02-26
+
+* Implement `ghcup run` subcommand wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/137)
+* Support installation of dynamic HLS bindists wrt [HLS #2675](https://github.com/haskell/haskell-language-server/pull/2675) and [#237](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/237)
+* Fix XDG support when `~/.local/bin` is a symlink wrt [#311](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/311)
+* Add support for quilt-style patches wrt [#230](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/230), by James Hobson
+* Fix redundant upgrade warnings in `ghcup upgrade`
+* Fix `ghcup whereis ghc` for non-standard versions wrt [#289](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/289)
+* Don't print logs to stdout, but stderr
+* Allow unpacking legacy lzma archives wrt [#307](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/307)
+* Allow to disable self-upgrade functionality wrt [#305](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/305)
+* Fix `ghcup install ghc --set` when ghc is already installed wrt [#291](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/291)
+
+## 0.1.17.4 -- 2021-11-13
+
+* add `--metadata-caching` option, allowing to also disable yaml metadata caching wrt [#278](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/278)
+* make upgrading ghcup in TUI more pleasant wrt [#276](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/276)
+* fix parsing of atypical GHC versions (e.g. `8.10.5-patch1`)
+* fix compiling HLS dynamically linked, also see [#245](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/245)
+* redo (and break) some of the `ghcup compile <tool>` interface, improving patch options and setting custom cabal.project files
+* avoid redundant update warnings wrt [#283](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283)
+
 ## 0.1.17.3 -- 2021-10-27
 
 * clean up during unpack failures as well

app/ghcup-gen/Main.hs

@@ -1,155 +0,0 @@
-{-# LANGUAGE CPP               #-}
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeApplications  #-}
-
-
-module Main where
-
-import           GHCup.Types
-import           GHCup.Errors
-import           GHCup.Platform
-import           GHCup.Utils.Dirs
-import           GHCup.Utils.Logger
-import           GHCup.Types.JSON               ( )
-
-import           Control.Exception              ( displayException )
-import           Control.Monad.Trans.Reader     ( runReaderT )
-import           Control.Monad.IO.Class
-import           Data.Char                      ( toLower )
-import           Data.Maybe
-#if !MIN_VERSION_base(4,13,0)
-import           Data.Semigroup                 ( (<>) )
-#endif
-import           Options.Applicative     hiding ( style )
-import           Haskus.Utils.Variant.Excepts
-import           System.Console.Pretty
-import           System.Environment
-import           System.Exit
-import           System.IO                      ( stderr )
-import           Text.Regex.Posix
-import           Validate
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
-
-import qualified Data.Text.IO                  as T
-import qualified Data.Text                     as T
-import qualified Data.ByteString               as B
-import qualified Data.Yaml.Aeson               as Y
-
-
-data Options = Options
-  { optCommand :: Command
-  }
-
-data Command = ValidateYAML ValidateYAMLOpts
-             | ValidateTarballs ValidateYAMLOpts TarballFilter
-
-
-data Input
-  = FileInput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway
-  | StdInput
-
-fileInput :: Parser Input
-fileInput =
-  FileInput
-    <$> strOption
-          (long "file" <> short 'f' <> metavar "FILENAME" <> help
-            "Input file to validate"
-          )
-
-stdInput :: Parser Input
-stdInput = flag'
-  StdInput
-  (short 'i' <> long "stdin" <> help "Validate from stdin (default)")
-
-inputP :: Parser Input
-inputP = fileInput <|> stdInput
-
-data ValidateYAMLOpts = ValidateYAMLOpts
-  { vInput :: Maybe Input
-  }
-
-validateYAMLOpts :: Parser ValidateYAMLOpts
-validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
-
-tarballFilterP :: Parser TarballFilter
-tarballFilterP = option readm $
-  long "tarball-filter" <> short 'u' <> metavar "<tool>-<version>" <> value def
-    <> help "Only check certain tarballs (format: <tool>-<version>)"
-  where
-    def = TarballFilter (Right Nothing) (makeRegex ("" :: String))
-    readm = do
-      s <- str
-      case span (/= '-') s of
-        (_, []) -> fail "invalid format, missing '-' after the tool name"
-        (t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
-          pure (TarballFilter $ Right $ Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
-        (t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
-          pure (TarballFilter $ Left tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
-        _ -> fail "invalid tool"
-    low = fmap toLower
-
-
-opts :: Parser Options
-opts = Options <$> com
-
-com :: Parser Command
-com = subparser
-  (  command
-       "check"
-       (   ValidateYAML
-       <$> info (validateYAMLOpts <**> helper)
-                (progDesc "Validate the YAML")
-       )
-  <> command
-       "check-tarballs"
-       (info
-         ((ValidateTarballs <$> validateYAMLOpts <*> tarballFilterP) <**> helper)
-         (progDesc "Validate all tarballs (download and checksum)")
-       )
-  )
-
-
-
-main :: IO ()
-main = do
-  no_color <- isJust <$> lookupEnv "NO_COLOR"
-  let loggerConfig = LoggerConfig { lcPrintDebug  = True
-                                  , consoleOutter = T.hPutStr stderr
-                                  , fileOutter    = \_ -> pure ()
-                                  , fancyColors   = not no_color
-                                  }
-  dirs <- liftIO getAllDirs
-  let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings loggerConfig
-
-  pfreq <- (
-    flip runReaderT leanAppstate . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ platformRequest
-    ) >>= \case
-            VRight r -> pure r
-            VLeft e -> do
-              flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
-              liftIO $ exitWith (ExitFailure 2)
-
-  let appstate = AppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
-
-  _ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
-    >>= \Options {..} -> case optCommand of
-          ValidateYAML vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validate dl m)
-          ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validateTarballs tarballFilter dl m)
-  pure ()
-
- where
-  withValidateYamlOpts vopts f = case vopts of
-    ValidateYAMLOpts { vInput = Nothing } ->
-      B.getContents >>= valAndExit f
-    ValidateYAMLOpts { vInput = Just StdInput } ->
-      B.getContents >>= valAndExit f
-    ValidateYAMLOpts { vInput = Just (FileInput file) } ->
-      B.readFile file >>= valAndExit f
-  valAndExit f contents = do
-    (GHCupInfo _ av gt) <- case Y.decodeEither' contents of
-      Right r -> pure r
-      Left  e -> die (color Red $ displayException e)
-    f av gt
-      >>= exitWith

app/ghcup-gen/Validate.hs

@@ -1,280 +0,0 @@
-{-# LANGUAGE CPP              #-}
-{-# LANGUAGE DataKinds        #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE QuasiQuotes      #-}
-{-# LANGUAGE TemplateHaskell  #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ViewPatterns     #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Validate where
-
-import           GHCup
-import           GHCup.Download
-import           GHCup.Errors
-import           GHCup.Types
-import           GHCup.Types.Optics
-import           GHCup.Utils
-import           GHCup.Utils.Logger
-import           GHCup.Utils.Version.QQ
-
-import           Codec.Archive
-import           Control.Applicative
-import           Control.Exception.Safe
-import           Control.Monad
-import           Control.Monad.IO.Class
-import           Control.Monad.Reader.Class
-import           Control.Monad.Trans.Class      ( lift )
-import           Control.Monad.Trans.Reader     ( runReaderT )
-import           Control.Monad.Trans.Resource   ( runResourceT
-                                                , MonadUnliftIO
-                                                )
-import           Data.Containers.ListUtils      ( nubOrd )
-import           Data.IORef
-import           Data.List
-import           Data.Versions
-import           Haskus.Utils.Variant.Excepts
-import           Optics
-import           System.FilePath
-import           System.Exit
-import           Text.ParserCombinators.ReadP
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
-import           Text.Regex.Posix
-
-import qualified Data.Map.Strict               as M
-import qualified Data.Text                     as T
-import qualified Data.Version                  as V
-
-
-data ValidationError = InternalError String
-  deriving Show
-
-instance Exception ValidationError
-
-
-addError :: (MonadReader (IORef Int) m, MonadIO m, Monad m) => m ()
-addError = do
-  ref <- ask
-  liftIO $ modifyIORef ref (+ 1)
-
-
-validate :: (Monad m, MonadReader env m, HasLog env, MonadThrow m, MonadIO m, MonadUnliftIO m)
-         => GHCupDownloads
-         -> M.Map GlobalTool DownloadInfo
-         -> m ExitCode
-validate dls _ = do
-  ref <- liftIO $ newIORef 0
-
-  -- verify binary downloads --
-  flip runReaderT ref $ do
-    -- unique tags
-    forM_ (M.toList dls) $ \(t, _) -> checkUniqueTags t
-
-    -- required platforms
-    forM_ (M.toList dls) $ \(t, versions) ->
-      forM_ (M.toList versions) $ \(v, vi) ->
-        forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do
-          checkHasRequiredPlatforms t v (_viTags vi) arch (M.keys pspecs)
-
-    checkGHCVerIsValid
-    forM_ (M.toList dls) $ \(t, _) -> checkMandatoryTags t
-    _ <- checkGHCHasBaseVersion
-
-    -- exit
-    e <- liftIO $ readIORef ref
-    if e > 0
-      then pure $ ExitFailure e
-      else do
-        lift $ logInfo "All good"
-        pure ExitSuccess
- where
-  checkHasRequiredPlatforms t v tags arch pspecs = do
-    let v' = prettyVer v
-        arch' = prettyShow arch
-    when (Linux UnknownLinux `notElem` pspecs) $ do
-      lift $ logError $
-        "Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
-      addError
-    when ((Darwin `notElem` pspecs) && arch == A_64) $ do
-      lift $ logError $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
-      addError
-    when ((FreeBSD `notElem` pspecs) && arch == A_64) $ lift $ logWarn $
-      "FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
-    when (Windows `notElem` pspecs && arch == A_64) $ do
-      lift $ logError $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
-      addError
-
-    -- alpine needs to be set explicitly, because
-    -- we cannot assume that "Linux UnknownLinux" runs on Alpine
-    -- (although it could be static)
-    when (Linux Alpine `notElem` pspecs) $
-      case t of
-        GHCup | arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
-        Cabal | v > [vver|2.4.1.0|]
-              , arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
-        GHC | Latest `elem` tags || Recommended `elem` tags
-            , arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch))
-        _ -> lift $ logWarn $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)
-
-  checkUniqueTags tool = do
-    let allTags = _viTags =<< M.elems (availableToolVersions dls tool)
-    let nonUnique =
-          fmap fst
-            .   filter (\(_, b) -> not b)
-            <$> ( mapM
-                    (\case
-                      [] -> throwM $ InternalError "empty inner list"
-                      (t : ts) ->
-                        pure $ (t, ) (not (isUniqueTag t) || null ts)
-                    )
-                . group
-                . sort
-                $ allTags
-                )
-    case join nonUnique of
-      [] -> pure ()
-      xs -> do
-        lift $ logError $ "Tags not unique for " <> T.pack (prettyShow tool) <> ": " <> T.pack (prettyShow xs)
-        addError
-   where
-    isUniqueTag Latest         = True
-    isUniqueTag Recommended    = True
-    isUniqueTag Old            = False
-    isUniqueTag Prerelease     = False
-    isUniqueTag (Base       _) = False
-    isUniqueTag (UnknownTag _) = False
-
-  checkGHCVerIsValid = do
-    let ghcVers = toListOf (ix GHC % to M.keys % folded) dls
-    forM_ ghcVers $ \v ->
-      case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
-        [_] -> pure ()
-        _   -> do
-          lift $ logError $ "GHC version " <> prettyVer v <> " is not valid"
-          addError
-
-  -- a tool must have at least one of each mandatory tags
-  checkMandatoryTags tool = do
-    let allTags = _viTags =<< M.elems (availableToolVersions dls tool)
-    forM_ [Latest, Recommended] $ \t -> case t `elem` allTags of
-      False -> do
-        lift $ logError $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool)
-        addError
-      True -> pure ()
-
-  -- all GHC versions must have a base tag
-  checkGHCHasBaseVersion = do
-    let allTags = M.toList $ availableToolVersions dls GHC
-    forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
-      False -> do
-        lift $ logError $ "Base tag missing from GHC ver " <> prettyVer ver
-        addError
-      True -> pure ()
-
-  isBase (Base _) = True
-  isBase _        = False
-
-data TarballFilter = TarballFilter
-  { tfTool    :: Either GlobalTool (Maybe Tool)
-  , tfVersion :: Regex
-  }
-
-validateTarballs :: ( Monad m
-                    , MonadReader env m
-                    , HasLog env
-                    , HasDirs env
-                    , HasSettings env
-                    , MonadThrow m
-                    , MonadIO m
-                    , MonadUnliftIO m
-                    , MonadMask m
-                    , Alternative m
-                    , MonadFail m
-                    )
-                 => TarballFilter
-                 -> GHCupDownloads
-                 -> M.Map GlobalTool DownloadInfo
-                 -> m ExitCode
-validateTarballs (TarballFilter etool versionRegex) dls gt = do
-  ref <- liftIO $ newIORef 0
-
-   -- download/verify all tarballs
-  let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool
-  let gdlis = nubOrd $ gt ^.. each
-  let allDls = either (const gdlis) (const dlis) etool
-  when (null allDls) $ logError "no tarballs selected by filter" *> runReaderT addError ref
-  forM_ allDls (downloadAll ref)
-
-  -- exit
-  e <- liftIO $ readIORef ref
-  if e > 0
-    then pure $ ExitFailure e
-    else do
-      logInfo "All good"
-      pure ExitSuccess
-
- where
-  downloadAll :: ( MonadUnliftIO m
-                 , MonadIO m
-                 , MonadReader env m
-                 , HasLog env
-                 , HasDirs env
-                 , HasSettings env
-                 , MonadCatch m
-                 , MonadMask m
-                 , MonadThrow m
-                 )
-              => IORef Int
-              -> DownloadInfo
-              -> m ()
-  downloadAll ref dli = do
-    r <- runResourceT
-      . runE @'[DigestError
-               , GPGError
-               , DownloadFailed
-               , UnknownArchive
-               , ArchiveResult
-               ]
-      $ do
-        case etool of
-          Right (Just GHCup) -> do
-            tmpUnpack <- lift mkGhcupTmpDir
-            _ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False
-            pure Nothing
-          Right _ -> do
-            p <- liftE $ downloadCached dli Nothing
-            fmap (Just . head . splitDirectories . head)
-              . liftE
-              . getArchiveFiles
-              $ p
-          Left ShimGen -> do
-            tmpUnpack <- lift mkGhcupTmpDir
-            _ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False
-            pure Nothing
-    case r of
-      VRight (Just basePath) -> do
-        case _dlSubdir dli of
-          Just (RealDir prel) -> do
-            logInfo
-              $ " verifying subdir: " <> T.pack prel
-            when (basePath /= prel) $ do
-              logError $
-                "Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath
-              runReaderT addError ref
-          Just (RegexDir regexString) -> do
-            logInfo $
-              "verifying subdir (regex): " <> T.pack regexString
-            let regex = makeRegexOpts
-                  compIgnoreCase
-                  execBlank
-                  regexString
-            unless (match regex basePath) $ do
-              logError $
-                "Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
-              runReaderT addError ref
-          Nothing -> pure ()
-      VRight Nothing -> pure ()
-      VLeft  e -> do
-        logError $
-          "Could not download (or verify hash) of " <> T.pack (show dli) <> ", Error was: " <> T.pack (prettyShow e)
-        runReaderT addError ref

app/ghcup/BrickMain.hs

@@ -10,6 +10,7 @@ module BrickMain where
 import           GHCup
 import           GHCup.Download
 import           GHCup.Errors
+import           GHCup.Types.Optics ( getDirs )
 import           GHCup.Types         hiding ( LeanAppState(..) )
 import           GHCup.Utils
 import           GHCup.Utils.Logger
@@ -26,6 +27,9 @@ import           Brick.Widgets.List             ( listSelectedFocusedAttr
                                                 )
 import           Codec.Archive
 import           Control.Exception.Safe
+#if !MIN_VERSION_base(4,13,0)
+import           Control.Monad.Fail             ( MonadFail )
+#endif
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Except
 import           Control.Monad.Trans.Resource
@@ -40,6 +44,8 @@ import           Data.Vector                    ( Vector
 import           Data.Versions           hiding ( str )
 import           Haskus.Utils.Variant.Excepts
 import           Prelude                 hiding ( appendFile )
+import           System.Directory               ( canonicalizePath )
+import           System.FilePath
 import           System.Exit
 import           System.IO.Unsafe
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
@@ -48,6 +54,8 @@ import           URI.ByteString
 import qualified Data.Text                     as T
 import qualified Graphics.Vty                  as Vty
 import qualified Data.Vector                   as V
+import System.Environment (getExecutablePath)
+import qualified System.Posix.Process          as SPP
 
 
 hiddenTools :: [Tool]
@@ -432,27 +440,42 @@ install' _ (_, ListResult {..}) = do
               ]
 
   run (do
+      ce <- liftIO $ fmap (either (const Nothing) Just) $
+        try @_ @SomeException $ getExecutablePath >>= canonicalizePath
+      dirs <- lift getDirs
       case lTool of
         GHC   -> do
           let vi = getVersionInfo lVer GHC dls
-          liftE $ installGHCBin lVer Nothing False $> vi
+          liftE $ installGHCBin lVer Nothing False $> (vi, dirs, ce)
         Cabal -> do
           let vi = getVersionInfo lVer Cabal dls
-          liftE $ installCabalBin lVer Nothing False $> vi
+          liftE $ installCabalBin lVer Nothing False $> (vi, dirs, ce)
         GHCup -> do
           let vi = snd <$> getLatest dls GHCup
-          liftE $ upgradeGHCup Nothing False $> vi
+          liftE $ upgradeGHCup Nothing False $> (vi, dirs, ce)
         HLS   -> do
           let vi = getVersionInfo lVer HLS dls
-          liftE $ installHLSBin lVer Nothing False $> vi
+          liftE $ installHLSBin lVer Nothing False $> (vi, dirs, ce)
         Stack -> do
           let vi = getVersionInfo lVer Stack dls
-          liftE $ installStackBin lVer Nothing False $> vi
+          liftE $ installStackBin lVer Nothing False $> (vi, dirs, ce)
     )
     >>= \case
-          VRight vi                         -> do
+          VRight (vi, Dirs{..}, Just ce) -> do
-            forM_ (_viPostInstall =<< vi) $ \msg ->
+            forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
-              logInfo msg
+            case lTool of
+              GHCup -> do
+                up <- liftIO $ fmap (either (const Nothing) Just)
+                  $ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
+                when ((normalise <$> up) == Just (normalise ce)) $
+                  -- TODO: track cli arguments of previous invocation
+                  liftIO $ SPP.executeFile ce False ["tui"] Nothing
+                logInfo "Please restart 'ghcup' for the changes to take effect"
+              _ -> pure ()
+            pure $ Right ()
+          VRight (vi, _, _) -> do
+            forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
+            logInfo "Please restart 'ghcup' for the changes to take effect"
             pure $ Right ()
           VLeft  (V (AlreadyInstalled _ _)) -> pure $ Right ()
           VLeft (V NoUpdate) -> pure $ Right ()
@@ -470,9 +493,9 @@ set' _ (_, ListResult {..}) = do
 
   run (do
       case lTool of
-        GHC   -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
+        GHC   -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly Nothing $> ()
         Cabal -> liftE $ setCabal lVer $> ()
-        HLS   -> liftE $ setHLS lVer $> ()
+        HLS   -> liftE $ setHLS lVer SetHLSOnly Nothing $> ()
         Stack -> liftE $ setStack lVer $> ()
         GHCup -> pure ()
     )
@@ -536,17 +559,7 @@ settings' = unsafePerformIO $ do
                                   , fileOutter    = \_ -> pure ()
                                   , fancyColors   = True
                                   }
-  newIORef $ AppState (Settings { cache      = True
+  newIORef $ AppState defaultSettings
-                                , noVerify   = False
-                                , keepDirs   = Never
-                                , downloader = Curl
-                                , verbose    = False
-                                , urlSource  = GHCupURL
-                                , noNetwork  = False
-                                , gpgSetting = GPGNone
-                                , noColor    = False
-                                , ..
-                                })
                       dirs
                       defaultKeyBindings
                       (GHCupInfo mempty mempty mempty)
@@ -605,4 +618,3 @@ getAppData mgi = runExceptT $ do
   flip runReaderT settings $ do
     lV <- listVersions Nothing Nothing
     pure $ BrickData (reverse lV)
-

app/ghcup/GHCup/OptParse.hs

@@ -15,13 +15,16 @@ module GHCup.OptParse (
   , module GHCup.OptParse.Config
   , module GHCup.OptParse.Whereis
   , module GHCup.OptParse.List
+#ifndef DISABLE_UPGRADE
   , module GHCup.OptParse.Upgrade
+#endif
   , module GHCup.OptParse.ChangeLog
   , module GHCup.OptParse.Prefetch
   , module GHCup.OptParse.GC
   , module GHCup.OptParse.DInfo
   , module GHCup.OptParse.Nuke
   , module GHCup.OptParse.ToolRequirements
+  , module GHCup.OptParse.Run
   , module GHCup.OptParse
 ) where
 
@@ -31,11 +34,14 @@ import           GHCup.OptParse.Install
 import           GHCup.OptParse.Set
 import           GHCup.OptParse.UnSet
 import           GHCup.OptParse.Rm
+import           GHCup.OptParse.Run
 import           GHCup.OptParse.Compile
 import           GHCup.OptParse.Config
 import           GHCup.OptParse.Whereis
 import           GHCup.OptParse.List
+#ifndef DISABLE_UPGRADE
 import           GHCup.OptParse.Upgrade
+#endif
 import           GHCup.OptParse.ChangeLog
 import           GHCup.OptParse.Prefetch
 import           GHCup.OptParse.GC
@@ -67,6 +73,7 @@ data Options = Options
   -- global options
     optVerbose     :: Maybe Bool
   , optCache       :: Maybe Bool
+  , optMetaCache   :: Maybe Integer
   , optUrlSource   :: Maybe URI
   , optNoVerify    :: Maybe Bool
   , optKeepDirs    :: Maybe KeepDirs
@@ -88,8 +95,10 @@ data Command
   | Compile CompileCommand
   | Config ConfigCommand
   | Whereis WhereisOptions WhereisCommand
+#ifndef DISABLE_UPGRADE
   | Upgrade UpgradeOpts Bool
-  | ToolRequirements
+#endif
+  | ToolRequirements ToolReqOpts
   | ChangeLog ChangeLogOptions
   | Nuke
 #if defined(BRICK)
@@ -97,14 +106,16 @@ data Command
 #endif
   | Prefetch PrefetchCommand
   | GC GCOptions
+  | Run RunOptions
 
 
 
 opts :: Parser Options
 opts =
   Options
-    <$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)")
+    <$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
-    <*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
+    <*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
+    <*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
     <*> optional
           (option
             (eitherReader parseUri)
@@ -113,9 +124,10 @@ opts =
             <> metavar "URL"
             <> help "Alternative ghcup download info url"
             <> internal
+            <> completer fileUri
             )
           )
-    <*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
+    <*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
     <*> optional (option
           (eitherReader keepOnParser)
           (  long "keep"
@@ -123,6 +135,7 @@ opts =
           <> help
                "Keep build directories? (default: errors)"
           <> hidden
+          <> completer (listCompleter ["always", "errors", "never"])
           ))
     <*> optional (option
           (eitherReader downloaderParser)
@@ -131,20 +144,23 @@ opts =
           <> metavar "<internal|curl|wget>"
           <> help
           "Downloader to use (default: internal)"
+          <> completer (listCompleter ["internal", "curl", "wget"])
 #else
           <> metavar "<curl|wget>"
           <> help
           "Downloader to use (default: curl)"
+          <> completer (listCompleter ["curl", "wget"])
 #endif
           <> hidden
           ))
-    <*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.")
+    <*> invertableSwitch "offline" (Just 'o') False (help "Don't do any network calls, trying cached assets and failing if missing.")
     <*> optional (option
           (eitherReader gpgParser)
           (  long "gpg"
           <> metavar "<strict|lax|none>"
           <> help
           "GPG verification (default: none)"
+          <> completer (listCompleter ["strict", "lax", "none"])
           ))
     <*> com
  where
@@ -206,6 +222,7 @@ com =
            (info (List <$> listOpts <**> helper)
                  (progDesc "Show available GHCs and other tools")
            )
+#ifndef DISABLE_UPGRADE
       <> command
            "upgrade"
            (info
@@ -216,6 +233,7 @@ com =
              )
              (progDesc "Upgrade ghcup")
            )
+#endif
       <> command
            "compile"
            (   Compile
@@ -253,6 +271,16 @@ com =
              (progDesc "Garbage collection"
              <> footerDoc ( Just $ text gcFooter ))
            )
+      <> command
+              "run"
+               (Run
+               <$>
+                 info
+                   (runOpts <**> helper)
+                   (progDesc "Run a command with the given tool in PATH"
+                   <> footerDoc ( Just $ text runFooter )
+                   )
+               )
       <> commandGroup "Main commands:"
       )
     <|> subparser
@@ -261,8 +289,8 @@ com =
               ((\_ -> DInfo) <$> info helper (progDesc "Show debug info"))
           <> command
                "tool-requirements"
-               (   (\_ -> ToolRequirements)
+               (   ToolRequirements
-               <$> info helper
+               <$> info (toolReqP <**> helper)
                         (progDesc "Show the requirements for ghc/cabal")
                )
           <> command

app/ghcup/GHCup/OptParse/ChangeLog.hs

@@ -76,6 +76,7 @@ changelogP =
             )
             (short 't' <> long "tool" <> metavar "<ghc|cabal|ghcup>" <> help
               "Open changelog for given tool (default: ghc)"
+              <> completer toolCompleter
             )
           )
     <*> optional (toolVersionArgument Nothing Nothing)

app/ghcup/GHCup/OptParse/Common.hs

@@ -3,6 +3,8 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE NumericUnderscores #-}
 
 module GHCup.OptParse.Common where
 
@@ -14,36 +16,55 @@ import           GHCup.Platform
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Utils
+import           GHCup.Utils.File
 import           GHCup.Utils.Logger
 import           GHCup.Utils.MegaParsec
 import           GHCup.Utils.Prelude
 
+import           Control.DeepSeq
+import           Control.Concurrent
+import           Control.Concurrent.Async
 import           Control.Exception.Safe
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
 import           Control.Monad.Reader
+import           Data.Aeson
+#if MIN_VERSION_aeson(2,0,0)
+import qualified Data.Aeson.Key    as KM
+import qualified Data.Aeson.KeyMap as KM
+#else
+import qualified Data.HashMap.Strict as KM
+#endif
+import           Data.ByteString.Lazy           ( ByteString )
 import           Data.Bifunctor
 import           Data.Char
 import           Data.Either
 import           Data.Functor
-import           Data.List                      ( nub, sort, sortBy )
+import           Data.List                      ( nub, sort, sortBy, isPrefixOf, stripPrefix )
 import           Data.Maybe
 import           Data.Text                      ( Text )
 import           Data.Versions           hiding ( str )
 import           Data.Void
+import qualified Data.Vector      as V
+import           GHC.IO.Exception
 import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           Safe
+import           System.Directory
+import           System.Process                  ( readProcess )
 import           System.FilePath
+import           Text.HTML.TagSoup       hiding ( Tag )
 import           URI.ByteString
 
 import qualified Data.ByteString.UTF8          as UTF8
 import qualified Data.Map.Strict               as M
 import qualified Data.Text                     as T
 import qualified Text.Megaparsec               as MP
+import qualified System.FilePath.Posix         as FP
 import GHCup.Version
+import Control.Exception (evaluate)
 
 
     -------------
@@ -117,7 +138,7 @@ versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar
 -- the help is shown only for --no-recursive.
 invertableSwitch
     :: String              -- ^ long option
-    -> Char                -- ^ short option for the non-default option
+    -> Maybe Char          -- ^ short option for the non-default option
     -> Bool                -- ^ is switch enabled by default?
     -> Mod FlagFields Bool -- ^ option modifier
     -> Parser (Maybe Bool)
@@ -128,14 +149,14 @@ invertableSwitch longopt shortopt defv optmod = invertableSwitch' longopt shorto
 -- | Allows providing option modifiers for both --foo and --no-foo.
 invertableSwitch'
     :: String              -- ^ long option (eg "foo")
-    -> Char                -- ^ short option for the non-default option
+    -> Maybe Char          -- ^ short option for the non-default option
     -> Bool                -- ^ is switch enabled by default?
     -> Mod FlagFields Bool -- ^ option modifier for --foo
     -> Mod FlagFields Bool -- ^ option modifier for --no-foo
     -> Parser (Maybe Bool)
 invertableSwitch' longopt shortopt defv enmod dismod = optional
-    ( flag' True ( enmod <> long longopt <> if defv then mempty else short shortopt)
+    ( flag' True ( enmod <> long longopt <> if defv then mempty else maybe mempty short shortopt)
-    <|> flag' False (dismod <> long nolongopt <> if defv then short shortopt else mempty)
+    <|> flag' False (dismod <> long nolongopt <> if defv then maybe mempty short shortopt else mempty)
     )
   where
     nolongopt = "no-" ++ longopt
@@ -196,8 +217,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
     ]
 
 
-bindistParser :: String -> Either String URI
+uriParser :: String -> Either String URI
-bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
+uriParser = first show . parseURI strictURIParserOptions . UTF8.fromString
 
 
 absolutePathParser :: FilePath -> Either String FilePath
@@ -246,18 +267,6 @@ criteriaParser s' | t == T.pack "installed" = Right ListInstalled
   where t = T.toLower (T.pack s')
 
 
-toolVersionParser :: Parser ToolVersion
-toolVersionParser = verP' <|> toolP
- where
-  verP' = ToolVersion <$> versionParser
-  toolP =
-    ToolTag
-      <$> option
-            (eitherReader tagEither)
-            (short 't' <> long "tag" <> metavar "TAG" <> help "The target tag")
-
-
-
 
 keepOnParser :: String -> Either String KeepDirs
 keepOnParser s' | t == T.pack "always" = Right Always
@@ -289,6 +298,126 @@ gpgParser s' | t == T.pack "strict" = Right GPGStrict
     --[ Completers ]--
     ------------------
 
+
+toolCompleter :: Completer
+toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
+
+gitFileUri :: [String] -> Completer
+gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
+
+fileUri :: Completer
+fileUri = mkCompleter $ fileUri' []
+
+fileUri' :: [String] -> String -> IO [String]
+fileUri' add = \case
+  "" -> do
+    pwd <- getCurrentDirectory
+    pure $ ["https://", "http://", "file:///", "file://" <> pwd <> "/"] <> add
+  xs
+   | "file:///" `isPrefixOf` xs -> fmap ("file://" <>) <$>
+      case stripPrefix "file://" xs of
+        Nothing -> pure []
+        Just r ->  do
+          pwd <- getCurrentDirectory
+          dirs  <- compgen "directory" r ["-S", "/"]
+          files <- filter (\f -> (f <> "/") `notElem` dirs) <$> compgen "file" r []
+          pure (dirs <> files <> if r `isPrefixOf` pwd then [pwd <> "/"] else [])
+   | xs `isPrefixOf` "file:///" -> pure ["file:///"]
+   | xs `isPrefixOf` "https://" -> pure ["https://"]
+   | xs `isPrefixOf` "http://"  -> pure ["http://"]
+   | otherwise -> pure []
+ where
+  compgen :: String -> String -> [String] -> IO [String]
+  compgen action' r opts = do
+    let cmd = unwords $ ["compgen", "-A", action'] <> opts <> ["--", requote r]
+    result <- tryIO $ readProcess "bash" ["-c", cmd] ""
+    return . lines . either (const []) id $ result
+
+  -- | Strongly quote the string we pass to compgen.
+  --
+  -- We need to do this so bash doesn't expand out any ~ or other
+  -- chars we want to complete on, or emit an end of line error
+  -- when seeking the close to the quote.
+  -- 
+  -- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
+  requote :: String -> String
+  requote s =
+    let
+      -- Bash doesn't appear to allow "mixed" escaping
+      -- in bash completions. So we don't have to really
+      -- worry about people swapping between strong and
+      -- weak quotes.
+      unescaped =
+        case s of
+          -- It's already strongly quoted, so we
+          -- can use it mostly as is, but we must
+          -- ensure it's closed off at the end and
+          -- there's no single quotes in the
+          -- middle which might confuse bash.
+          ('\'': rs) -> unescapeN rs
+
+          -- We're weakly quoted.
+          ('"': rs)  -> unescapeD rs
+
+          -- We're not quoted at all.
+          -- We need to unescape some characters like
+          -- spaces and quotation marks.
+          elsewise   -> unescapeU elsewise
+    in
+      strong unescaped
+
+    where
+      strong ss = '\'' : foldr go "'" ss
+        where
+          -- If there's a single quote inside the
+          -- command: exit from the strong quote and
+          -- emit it the quote escaped, then resume.
+          go '\'' t = "'\\''" ++ t
+          go h t    = h : t
+
+      -- Unescape a strongly quoted string
+      -- We have two recursive functions, as we
+      -- can enter and exit the strong escaping.
+      unescapeN = goX
+        where
+          goX ('\'' : xs) = goN xs
+          goX (x : xs) = x : goX xs
+          goX [] = []
+
+          goN ('\\' : '\'' : xs) = '\'' : goN xs
+          goN ('\'' : xs) = goX xs
+          goN (x : xs) = x : goN xs
+          goN [] = []
+
+      -- Unescape an unquoted string
+      unescapeU = goX
+        where
+          goX [] = []
+          goX ('\\' : x : xs) = x : goX xs
+          goX (x : xs) = x : goX xs
+
+      -- Unescape a weakly quoted string
+      unescapeD = goX
+        where
+          -- Reached an escape character
+          goX ('\\' : x : xs)
+            -- If it's true escapable, strip the
+            -- slashes, as we're going to strong
+            -- escape instead.
+            | x `elem` ("$`\"\\\n" :: String) = x : goX xs
+            | otherwise = '\\' : x : goX xs
+          -- We've ended quoted section, so we
+          -- don't recurse on goX, it's done.
+          goX ('"' : xs)
+            = xs
+          -- Not done, but not a special character
+          -- just continue the fold.
+          goX (x : xs)
+            = x : goX xs
+          goX []
+            = []
+
+
 tagCompleter :: Tool -> [String] -> Completer
 tagCompleter tool add = listIOCompleter $ do
   dirs' <- liftIO getAllDirs
@@ -299,7 +428,7 @@ tagCompleter tool add = listIOCompleter $ do
         , fancyColors    = False
         }
   let appState = LeanAppState
-        (Settings True False Never Curl False GHCupURL True GPGNone False)
+        (defaultSettings { noNetwork = True })
         dirs'
         defaultKeyBindings
         loggerConfig
@@ -322,7 +451,7 @@ versionCompleter criteria tool = listIOCompleter $ do
         , fileOutter     = mempty
         , fancyColors    = False
         }
-  let settings = Settings True False Never Curl False GHCupURL True GPGNone False
+  let settings = defaultSettings { noNetwork = True }
   let leanAppState = LeanAppState
                    settings
                    dirs'
@@ -346,6 +475,150 @@ versionCompleter criteria tool = listIOCompleter $ do
       return $ T.unpack . prettyVer . lVer <$> installedVersions
 
 
+toolDlCompleter :: Tool -> Completer
+toolDlCompleter tool = mkCompleter $ \case
+  "" -> pure (initUrl tool <> ["https://", "http://", "file:///"])
+  word
+    | "file://" `isPrefixOf` word -> fileUri' [] word
+    -- downloads.haskell.org
+    | "https://downloads.haskell.org/" `isPrefixOf` word ->
+        fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> fromHRef word
+
+    -- github releases
+    | "https://github.com/haskell/haskell-language-server/releases/download/" `isPrefixOf` word
+    , let xs = splitPath word
+    , (length xs == 6 && last word == '/') || (length xs == 7 && last word /= '/') ->
+        fmap (\x -> completePrefix word x <> "/") . prefixMatch (FP.takeFileName word) <$> getGithubReleases "haskell" "haskell-language-server"
+    | "https://github.com/commercialhaskell/stack/releases/download/" == word
+    , let xs = splitPath word
+    , (length xs == 6 && last word == '/') || (length xs == 7 && last word /= '/') ->
+        fmap (\x -> completePrefix word x <> "/") . prefixMatch (FP.takeFileName word) <$> getGithubReleases "commercialhaskell" "stack"
+
+    -- github release assets
+    | "https://github.com/haskell/haskell-language-server/releases/download/" `isPrefixOf` word
+    , let xs = splitPath word
+    , (length xs == 7 && last word == '/') || length xs == 8
+    , let rel = xs !! 6
+    , length rel > 1 -> do
+        fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> getGithubAssets "haskell" "haskell-language-server" (init rel)
+    | "https://github.com/commercialhaskell/stack/releases/download/" `isPrefixOf` word
+    , let xs = splitPath word
+    , (length xs == 7 && last word == '/') || length xs == 8
+    , let rel = xs !! 6
+    , length rel > 1 -> do
+        fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> getGithubAssets "commercialhaskell" "stack" (init rel)
+
+    -- github
+    | "https://github.com/c" `isPrefixOf` word -> pure ["https://github.com/commercialhaskell/stack/releases/download/"]
+    | "https://github.com/h" `isPrefixOf` word -> pure ["https://github.com/haskell/haskell-language-server/releases/download/"]
+    | "https://g" `isPrefixOf` word
+    , tool == Stack -> pure ["https://github.com/commercialhaskell/stack/releases/download/"]
+    | "https://g" `isPrefixOf` word
+    , tool == HLS -> pure ["https://github.com/haskell/haskell-language-server/releases/download/"]
+
+    | "https://d" `isPrefixOf` word -> pure $ filter ("https://downloads.haskell.org/" `isPrefixOf`) $ initUrl tool
+
+    | "h" `isPrefixOf` word -> pure $ initUrl tool
+
+    | word `isPrefixOf` "file:///" -> pure ["file:///"]
+    | word `isPrefixOf` "https://" -> pure ["https://"]
+    | word `isPrefixOf` "http://"  -> pure ["http://"]
+
+    | otherwise -> pure []
+ where
+  initUrl :: Tool -> [String]
+  initUrl GHC   = [ "https://downloads.haskell.org/~ghc/"
+                  , "https://downloads.haskell.org/~ghcup/unofficial-bindists/ghc/"
+                  ]
+  initUrl Cabal = [ "https://downloads.haskell.org/~cabal/"
+                  , "https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/"
+                  ]
+  initUrl GHCup = [ "https://downloads.haskell.org/~ghcup/" ]
+  initUrl HLS   = [ "https://github.com/haskell/haskell-language-server/releases/download/"
+                  , "https://downloads.haskell.org/~ghcup/unofficial-bindists/haskell-language-server/"
+                  ]
+  initUrl Stack = [ "https://github.com/commercialhaskell/stack/releases/download/"
+                  , "https://downloads.haskell.org/~ghcup/unofficial-bindists/stack/"
+                  ]
+
+  completePrefix :: String -- ^ url, e.g.    'https://github.com/haskell/haskell-languag'
+                 -> String -- ^ match, e.g.  'haskell-language-server'
+                 -> String -- ^ result, e.g. 'https://github.com/haskell/haskell-language-server'
+  completePrefix url match =
+    let base = FP.takeDirectory url
+        fn   = FP.takeFileName url
+    in if fn `isPrefixOf` match then base <> "/" <> match else url
+
+  prefixMatch :: String -> [String] -> [String]
+  prefixMatch pref = filter (pref `isPrefixOf`)
+
+  fromHRef :: String -> IO [String]
+  fromHRef url = withCurl (FP.takeDirectory url) 2_000_000 $ \stdout ->
+      pure
+        . fmap (T.unpack . decUTF8Safe' . fromAttrib "href")
+        . filter isTagOpen
+        . filter (~== ("<a href>" :: String))
+        . parseTags
+        $ stdout
+
+  withCurl :: String                      -- ^ url
+           -> Int                         -- ^ delay
+           -> (ByteString -> IO [String]) -- ^ callback
+           -> IO [String]
+  withCurl url delay cb = do
+    let limit = threadDelay delay
+    race limit (executeOut "curl" ["-fL", url] Nothing) >>= \case
+      Right (CapturedProcess {_exitCode, _stdOut}) -> do
+        case _exitCode of
+          ExitSuccess ->
+            (try @_ @SomeException . cb $ _stdOut) >>= \case
+              Left _ ->  pure []
+              Right r' -> do
+                r <- try @_ @SomeException
+                  . evaluate
+                  . force
+                  $ r'
+                either (\_ -> pure []) pure r
+          ExitFailure _ -> pure []
+      Left _ -> pure []
+
+  getGithubReleases :: String
+                    -> String
+                    -> IO [String]
+  getGithubReleases owner repo = withCurl url 3_000_000 $ \stdout -> do
+    Just xs <- pure $ decode' @Array stdout
+    fmap V.toList $ forM xs $ \x -> do
+      (Object r) <- pure x
+      Just (String name) <- pure $ KM.lookup (mkval "tag_name") r
+      pure $ T.unpack name
+   where
+    url = "https://api.github.com/repos/" <> owner <> "/" <> repo <> "/releases"
+
+  getGithubAssets :: String
+                  -> String
+                  -> String
+                  -> IO [String]
+  getGithubAssets owner repo tag = withCurl url 3_000_000 $ \stdout -> do
+    Just xs <- pure $ decode' @Object stdout
+    Just (Array assets) <- pure $ KM.lookup (mkval "assets") xs
+    as <- fmap V.toList $ forM assets $ \val -> do
+      (Object asset) <- pure val
+      Just (String name) <- pure $ KM.lookup (mkval "name") asset
+      pure $ T.unpack name
+    pure as
+   where
+    url = "https://api.github.com/repos/" <> owner <> "/" <> repo <> "/releases/tags/" <> tag
+
+
+#if MIN_VERSION_aeson(2,0,0)
+  mkval = KM.fromString
+#else
+  mkval = id
+#endif
+
+
+
+
 
 
     -----------------
@@ -399,7 +672,7 @@ fromVersion' (SetToolVersion v) tool = do
     Right pvpIn ->
       lift (getLatestToolFor tool pvpIn dls) >>= \case
         Just (pvp_, vi') -> do
-          v' <- lift $ pvpToVersion pvp_
+          v' <- lift $ pvpToVersion pvp_ ""
           when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
           pure (GHCTargetVersion (_tvTarget v) v', Just vi')
         Nothing -> pure (v, vi)
@@ -472,42 +745,22 @@ checkForUpdates :: ( MonadReader env m
                    , MonadIO m
                    , MonadFail m
                    )
-                => m ()
+                => m [(Tool, Version)]
 checkForUpdates = do
   GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
   lInstalled <- listVersions Nothing (Just ListInstalled)
   let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
 
-  forM_ (getLatest dls GHCup) $ \(l, _) -> do
+  ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
-    (Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
+    (Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
-    when (l > ghc_ver)
+    if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
-      $ logWarn $
-          "New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
 
-  forM_ (getLatest dls GHC) $ \(l, _) -> do
+  otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
-    let mghc_ver = latestInstalled GHC
+    forMM (getLatest dls t) $ \(l, _) -> do
-    forM mghc_ver $ \ghc_ver ->
+      let mver = latestInstalled t
-      when (l > ghc_ver)
+      forMM mver $ \ver ->
-        $ logWarn $
+        if (l > ver) then pure $ Just (t, l) else pure Nothing
-          "New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'"
 
-  forM_ (getLatest dls Cabal) $ \(l, _) -> do
+  pure $ catMaybes (ghcup:otherTools)
-    let mcabal_ver = latestInstalled Cabal
+ where
-    forM mcabal_ver $ \cabal_ver ->
+  forMM a f = fmap join $ forM a f
-      when (l > cabal_ver)
-        $ logWarn $
-          "New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
-
-  forM_ (getLatest dls HLS) $ \(l, _) -> do
-    let mhls_ver = latestInstalled HLS
-    forM mhls_ver $ \hls_ver ->
-      when (l > hls_ver)
-        $ logWarn $
-          "New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
-
-  forM_ (getLatest dls Stack) $ \(l, _) -> do
-    let mstack_ver = latestInstalled Stack
-    forM mstack_ver $ \stack_ver ->
-      when (l > stack_ver)
-        $ logWarn $
-          "New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"

app/ghcup/GHCup/OptParse/Compile.hs

@@ -40,6 +40,7 @@ import           Prelude                 hiding ( appendFile )
 import           System.Exit
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
+import           URI.ByteString          hiding ( uriParser )
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
 import System.FilePath (isPathSeparator)
@@ -68,7 +69,7 @@ data GHCCompileOptions = GHCCompileOptions
   , bootstrapGhc :: Either Version FilePath
   , jobs         :: Maybe Int
   , buildConfig  :: Maybe FilePath
-  , patchDir     :: Maybe FilePath
+  , patches      :: Maybe (Either FilePath [URI])
   , crossTarget  :: Maybe Text
   , addConfArgs  :: [Text]
   , setCompile   :: Bool
@@ -84,10 +85,11 @@ data HLSCompileOptions = HLSCompileOptions
   , setCompile   :: Bool
   , ovewrwiteVer :: Maybe Version
   , isolateDir   :: Maybe FilePath
-  , cabalProject :: Maybe FilePath
+  , cabalProject :: Maybe (Either FilePath URI)
-  , cabalProjectLocal :: Maybe FilePath
+  , cabalProjectLocal :: Maybe URI
-  , patchDir     :: Maybe FilePath
+  , patches      :: Maybe (Either FilePath [URI])
   , targetGHCs   :: [ToolVersion]
+  , cabalArgs    :: [Text]
   }
 
 
@@ -148,7 +150,10 @@ Examples:
   These need to be available in PATH prior to compilation.
 
 Examples:
-  ghcup compile hls -v 1.4.0 -j 12 8.10.5 8.10.7 9.0.1|]
+  # compile 1.4.0 for ghc 8.10.5 and 8.10.7
+  ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7
+  # compile from master for ghc 8.10.7, linking everything dynamically
+  ghcup compile hls -g master -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|]
 
 
 ghcCompileOpts :: Parser GHCCompileOptions
@@ -160,6 +165,7 @@ ghcCompileOpts =
           )
           (short 'v' <> long "version" <> metavar "VERSION" <> help
             "The tool version to compile"
+            <> (completer $ versionCompleter Nothing GHC)
           )
           ) <|>
           (Right <$> (GitBranch <$> option
@@ -167,7 +173,10 @@ ghcCompileOpts =
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
             "The git commit/branch/ref to build from"
           ) <*>
-          optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
+          optional (option str (
+            short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
+            <> completer (gitFileUri ["https://gitlab.haskell.org/ghc/ghc.git"])
+            ))
           )))
     <*> option
           (eitherReader
@@ -180,12 +189,14 @@ ghcCompileOpts =
           <> metavar "BOOTSTRAP_GHC"
           <> help
                "The GHC version (or full path) to bootstrap with (must be installed)"
+          <> (completer $ versionCompleter Nothing GHC)
           )
     <*> optional
           (option
             (eitherReader (readEither @Int))
             (short 'j' <> long "jobs" <> metavar "JOBS" <> help
               "How many jobs to use for make"
+              <> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
             )
           )
     <*> optional
@@ -193,15 +204,28 @@ ghcCompileOpts =
             str
             (short 'c' <> long "config" <> metavar "CONFIG" <> help
               "Absolute path to build config file"
+             <> completer (bashCompleter "file")
             )
           )
-    <*> optional
+    <*> (optional
-          (option
+          (
-            str
+            (fmap Right $ many $ option
-            (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
+              (eitherReader uriParser)
-              "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
+              (long "patch" <> metavar "PATCH_URI" <> help
+                "URI to a patch (https/http/file)"
+               <> completer fileUri
+              )
+            )
+            <|>
+            (fmap Left $ option
+              str
+              (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
+                "Absolute path to patch directory (applies all .patch and .diff files in order using -p1. This order is determined by a quilt series file if it exists, or the patches are lexicographically ordered)"
+               <> completer (bashCompleter "directory")
+              )
             )
           )
+        )
     <*> optional
           (option
             str
@@ -210,12 +234,7 @@ ghcCompileOpts =
             )
           )
     <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
-    <*> flag
+    <*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
-          False
-          True
-          (long "set" <> help
-            "Set as active version after install"
-          )
     <*> optional
           (option
             (eitherReader
@@ -223,6 +242,7 @@ ghcCompileOpts =
             )
             (short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
               "Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
+            <> (completer $ versionCompleter Nothing GHC)
             )
           )
     <*> optional
@@ -242,6 +262,7 @@ ghcCompileOpts =
             <> long "isolate"
             <> metavar "DIR"
             <> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
+            <> completer (bashCompleter "directory")
             )
            )
 
@@ -254,6 +275,7 @@ hlsCompileOpts =
           )
           (short 'v' <> long "version" <> metavar "VERSION" <> help
             "The tool version to compile"
+            <> (completer $ versionCompleter Nothing HLS)
           )
           ) <|>
           (Right <$> (GitBranch <$> option
@@ -261,21 +283,19 @@ hlsCompileOpts =
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
             "The git commit/branch/ref to build from"
           ) <*>
-          optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
+          optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
+            <> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
+          ))
           )))
     <*> optional
           (option
             (eitherReader (readEither @Int))
             (short 'j' <> long "jobs" <> metavar "JOBS" <> help
               "How many jobs to use for make"
+              <> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
             )
           )
-    <*> flag
+    <*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
-          False
-          True
-          (long "set" <> help
-            "Set as active version after install"
-          )
     <*> optional
           (option
             (eitherReader
@@ -283,6 +303,7 @@ hlsCompileOpts =
             )
             (short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
               "Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
+            <> (completer $ versionCompleter Nothing HLS)
             )
           )
     <*> optional
@@ -292,30 +313,51 @@ hlsCompileOpts =
             <> long "isolate"
             <> metavar "DIR"
             <> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
+            <> completer (bashCompleter "directory")
             )
            )
     <*> optional
           (option
-            str
+            ((fmap Right $ eitherReader uriParser) <|> (fmap Left str))
             (long "cabal-project" <> metavar "CABAL_PROJECT" <> help
-              "If relative, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. If absolute, will copy the file over."
+              "If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme."
+              <> completer fileUri
             )
           )
     <*> optional
           (option
-            (eitherReader absolutePathParser)
+            (eitherReader uriParser)
             (long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
-              "Absolute path to a cabal.project.local to be used for the build. Will be copied over."
+              "URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
+              <> completer fileUri
             )
           )
-    <*> optional
+    <*> (optional
-          (option
+          (
-            (eitherReader absolutePathParser)
+            (fmap Right $ many $ option
-            (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
+              (eitherReader uriParser)
-              "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
+              (long "patch" <> metavar "PATCH_URI" <> help
+                "URI to a patch (https/http/file)"
+              <> completer fileUri
+              )
+            )
+            <|>
+            (fmap Left $ option
+              str
+              (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
+                "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
+              <> completer (bashCompleter "directory")
+              )
             )
           )
-    <*> some (toolVersionArgument Nothing (Just GHC))
+        )
+    <*> some (
+          option (eitherReader toolVersionEither)
+            (  long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
+            <> completer (tagCompleter GHC [])
+            <> completer (versionCompleter Nothing GHC))
+        )
+    <*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
 
 
 
@@ -403,11 +445,11 @@ compile :: ( Monad m
            )
       => CompileCommand
       -> Settings
+      -> Dirs
       -> (forall eff a . ReaderT AppState m (VEither eff a) -> m (VEither eff a))
       -> (ReaderT LeanAppState m () -> m ())
       -> m ExitCode
-compile compileCommand settings runAppState runLogger = do
+compile compileCommand settings Dirs{..} runAppState runLogger = do
-  VRight Dirs{ .. }  <- runAppState (VRight <$> getDirs)
   case compileCommand of
     (CompileHLS HLSCompileOptions { .. }) -> do
       runCompileHLS runAppState (do
@@ -430,11 +472,12 @@ compile compileCommand settings runAppState runLogger = do
                     isolateDir
                     cabalProject
                     cabalProjectLocal
-                    patchDir
+                    patches
+                    cabalArgs
         GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
         let vi = getVersionInfo targetVer HLS dls
         when setCompile $ void $ liftE $
-          setHLS targetVer
+          setHLS targetVer SetHLSOnly Nothing
         pure (vi, targetVer)
         )
         >>= \case
@@ -477,7 +520,7 @@ compile compileCommand settings runAppState runLogger = do
                     bootstrapGhc
                     jobs
                     buildConfig
-                    patchDir
+                    patches
                     addConfArgs
                     buildFlavour
                     hadrian
@@ -485,7 +528,7 @@ compile compileCommand settings runAppState runLogger = do
         GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
         let vi = getVersionInfo (_tvVersion targetVer) GHC dls
         when setCompile $ void $ liftE $
-          setGHC targetVer SetGHCOnly
+          setGHC targetVer SetGHCOnly Nothing
         pure (vi, targetVer)
         )
         >>= \case

app/ghcup/GHCup/OptParse/Config.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ExplicitForAll #-}
 
 module GHCup.OptParse.Config where
 
@@ -17,6 +18,7 @@ import           GHCup.Utils
 import           GHCup.Utils.Prelude
 import           GHCup.Utils.Logger
 import           GHCup.Utils.String.QQ
+import           GHCup.OptParse.Common
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -27,10 +29,11 @@ import           Control.Monad.Trans.Resource
 import           Data.Functor
 import           Data.Maybe
 import           Haskus.Utils.Variant.Excepts
-import           Options.Applicative     hiding ( style )
+import           Options.Applicative     hiding ( style, ParseError )
 import           Options.Applicative.Help.Pretty ( text )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
+import           URI.ByteString          hiding ( uriParser )
 
 import qualified Data.Text                     as T
 import qualified Data.ByteString.UTF8          as UTF8
@@ -49,6 +52,7 @@ data ConfigCommand
   = ShowConfig
   | SetConfig String (Maybe String)
   | InitConfig
+  | AddReleaseChannel URI
 
 
 
@@ -62,6 +66,7 @@ configP = subparser
       (  command "init" initP
       <> command "set"  setP -- [set] KEY VALUE at help lhs
       <> command "show" showP
+      <> command "add-release-channel" addP
       )
     <|> argsP -- add show for a single option
     <|> pure ShowConfig
@@ -70,6 +75,8 @@ configP = subparser
   showP = info (pure ShowConfig) (progDesc "Show current config (default)")
   setP  = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
   argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
+  addP  = info (AddReleaseChannel <$> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
+    (progDesc "Add a release channel from a URI")
 
 
 
@@ -114,22 +121,18 @@ formatConfig :: UserSettings -> String
 formatConfig = UTF8.toString . Y.encode
 
 
-updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
+updateSettings :: UserSettings -> Settings -> Settings
-updateSettings config' settings = do
+updateSettings UserSettings{..} Settings{..} =
-  settings' <- lE' (JSONDecodeError . displayException) . Y.decodeEither' $ config'
+   let cache'      = fromMaybe cache uCache
-  pure $ mergeConf settings' settings
+       metaCache'  = fromMaybe metaCache uMetaCache
-  where
+       noVerify'   = fromMaybe noVerify uNoVerify
-   mergeConf :: UserSettings -> Settings -> Settings
+       keepDirs'   = fromMaybe keepDirs uKeepDirs
-   mergeConf UserSettings{..} Settings{..} =
+       downloader' = fromMaybe downloader uDownloader
-     let cache'      = fromMaybe cache uCache
+       verbose'    = fromMaybe verbose uVerbose
-         noVerify'   = fromMaybe noVerify uNoVerify
+       urlSource'  = fromMaybe urlSource uUrlSource
-         keepDirs'   = fromMaybe keepDirs uKeepDirs
+       noNetwork'  = fromMaybe noNetwork uNoNetwork
-         downloader' = fromMaybe downloader uDownloader
+       gpgSetting' = fromMaybe gpgSetting uGPGSetting
-         verbose'    = fromMaybe verbose uVerbose
+   in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
-         urlSource'  = fromMaybe urlSource uUrlSource
-         noNetwork'  = fromMaybe noNetwork uNoNetwork
-         gpgSetting' = fromMaybe gpgSetting uGPGSetting
-     in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
 
 
 
@@ -139,7 +142,7 @@ updateSettings config' settings = do
 
 
 
-config :: ( Monad m
+config :: forall m. ( Monad m
           , MonadMask m
           , MonadUnliftIO m
           , MonadFail m
@@ -160,27 +163,42 @@ config configCommand settings keybindings runLogger = case configCommand of
     liftIO $ putStrLn $ formatConfig $ fromSettings settings (Just keybindings)
     pure ExitSuccess
 
-  (SetConfig k (Just v)) ->
+  (SetConfig k mv) -> do
-    case v of
+    r <- runE @'[JSONError, ParseError] $ do
-      "" -> do
+      case mv of
-        runLogger $ logError "Empty values are not allowed"
+        Just "" ->
-        pure $ ExitFailure 55
+          throwE $ ParseError "Empty values are not allowed"
-      _  -> doConfig (k <> ": " <> v <> "\n")
+        Nothing -> do
+          usersettings <- decodeSettings k
+          lift $ doConfig usersettings
+          pure ()
+        Just v -> do
+          usersettings <- decodeSettings (k <> ": " <> v <> "\n")
+          lift $ doConfig usersettings
+          pure ()
+    case r of
+      VRight _ -> pure ExitSuccess
+      VLeft (V (JSONDecodeError e)) -> do
+        runLogger $ logError $ "Error decoding config: " <> T.pack e
+        pure $ ExitFailure 65
+      VLeft _ -> pure $ ExitFailure 65
 
-  (SetConfig json Nothing) -> doConfig json
+  AddReleaseChannel uri -> do
+    case urlSource settings of
+      AddSource xs -> do
+        doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
+        pure ExitSuccess
+      _ -> do
+        doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
+        pure ExitSuccess
 
  where
-  doConfig val = do
+  doConfig :: MonadIO m => UserSettings -> m ()
-    r <- runE @'[JSONError] $ do
+  doConfig usersettings = do
-      settings' <- updateSettings (UTF8.fromString val) settings
+    let settings' = updateSettings usersettings settings
-      path <- liftIO getConfigFilePath
+    path <- liftIO getConfigFilePath
-      liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
+    liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
-      lift $ runLogger $ logDebug $ T.pack $ show settings'
+    runLogger $ logDebug $ T.pack $ show settings'
-      pure ()
+    pure ()
 
-    case r of
+  decodeSettings = lE' (JSONDecodeError . displayException) . Y.decodeEither' . UTF8.fromString
-        VRight _ -> pure ExitSuccess
-        VLeft (V (JSONDecodeError e)) -> do
-          runLogger $ logError $ "Error decoding config: " <> T.pack e
-          pure $ ExitFailure 65
-        VLeft _ -> pure $ ExitFailure 65

app/ghcup/GHCup/OptParse/DInfo.hs

@@ -51,7 +51,7 @@ describe_result = $( LitE . StringL <$>
                      runIO (do
                              CapturedProcess{..} <-  do
                               dirs <- liftIO getAllDirs
-                              let settings = AppState (Settings True False Never Curl False GHCupURL False GPGNone False)
+                              let settings = AppState (defaultSettings { noNetwork = True })
                                                dirs
                                                defaultKeyBindings
                               flip runReaderT settings $ executeOut "git" ["describe"] Nothing

app/ghcup/GHCup/OptParse/GC.hs

@@ -132,7 +132,7 @@ gc GCOptions{..} runAppState runLogger = runGC runAppState (do
   when gcOldGHC rmOldGHC
   lift $ when gcProfilingLibs rmProfilingLibs
   lift $ when gcShareDir rmShareDir
-  lift $ when gcHLSNoGHC rmHLSNoGHC
+  liftE $ when gcHLSNoGHC rmHLSNoGHC
   lift $ when gcCache rmCache
   lift $ when gcTmp rmTmp
    ) >>= \case

app/ghcup/GHCup/OptParse/Install.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ViewPatterns      #-}
 
 module GHCup.OptParse.Install where
 
@@ -17,7 +18,6 @@ import           GHCup.OptParse.Common
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Utils.File
 import           GHCup.Utils.Logger
 import           GHCup.Utils.String.QQ
 
@@ -37,7 +37,7 @@ import           Options.Applicative.Help.Pretty ( text )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
-import           URI.ByteString
+import           URI.ByteString          hiding ( uriParser )
 
 import qualified Data.Text                     as T
 
@@ -187,21 +187,18 @@ installOpts tool =
     <*> (   (   (,)
             <$> optional
                   (option
-                    (eitherReader bindistParser)
+                    (eitherReader uriParser)
                     (short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
                       "Install the specified version from this bindist"
+                      <> completer (toolDlCompleter (fromMaybe GHC tool))
                     )
                   )
             <*> (Just <$> toolVersionArgument Nothing tool)
             )
         <|> pure (Nothing, Nothing)
         )
-    <*> flag
+    <*> fmap (fromMaybe setDefault) (invertableSwitch "set" Nothing setDefault
-          False
+      (help $ if not setDefault then "Set as active version after install" else "Don't set as active version after install"))
-          True
-          (long "set" <> help
-            "Set as active version after install"
-          )
     <*> optional
           (option
            (eitherReader isolateParser)
@@ -209,10 +206,16 @@ installOpts tool =
            <> long "isolate"
            <> metavar "DIR"
            <> help "install in an isolated dir instead of the default one"
+           <> completer (bashCompleter "directory")
            )
           )
     <*> switch
           (short 'f' <> long "force" <> help "Force install")
+ where
+  setDefault = case tool of
+    Nothing  -> False
+    Just GHC -> False
+    Just _   -> True
           
 
 
@@ -254,6 +257,48 @@ type InstallEffects = '[ AlreadyInstalled
                        , NoToolVersionSet
                        , FileAlreadyExistsError
                        , ProcessError
+
+                       , (AlreadyInstalled, ())
+                       , (UnknownArchive, ())
+                       , (ArchiveResult, ())
+                       , (FileDoesNotExistError, ())
+                       , (CopyError, ())
+                       , (NotInstalled, ())
+                       , (DirNotEmpty, ())
+                       , (NoDownload, ())
+                       , (NotInstalled, ())
+                       , (BuildFailed, ())
+                       , (TagNotFound, ())
+                       , (DigestError, ())
+                       , (GPGError, ())
+                       , (DownloadFailed, ())
+                       , (TarDirDoesNotExist, ())
+                       , (NextVerNotFound, ())
+                       , (NoToolVersionSet, ())
+                       , (FileAlreadyExistsError, ())
+                       , (ProcessError, ())
+
+                       , (AlreadyInstalled, NotInstalled)
+                       , (UnknownArchive, NotInstalled)
+                       , (ArchiveResult, NotInstalled)
+                       , (FileDoesNotExistError, NotInstalled)
+                       , (CopyError, NotInstalled)
+                       , (NotInstalled, NotInstalled)
+                       , (DirNotEmpty, NotInstalled)
+                       , (NoDownload, NotInstalled)
+                       , (NotInstalled, NotInstalled)
+                       , (BuildFailed, NotInstalled)
+                       , (TagNotFound, NotInstalled)
+                       , (DigestError, NotInstalled)
+                       , (GPGError, NotInstalled)
+                       , (DownloadFailed, NotInstalled)
+                       , (TarDirDoesNotExist, NotInstalled)
+                       , (NextVerNotFound, NotInstalled)
+                       , (NoToolVersionSet, NotInstalled)
+                       , (FileAlreadyExistsError, NotInstalled)
+                       , (ProcessError, NotInstalled)
+
+                       , ((), NotInstalled)
                        ]
 
 
@@ -268,6 +313,64 @@ runInstTool appstate' mInstPlatform =
     @InstallEffects
 
 
+type InstallGHCEffects = '[ TagNotFound
+                          , NextVerNotFound
+                          , NoToolVersionSet
+                          , BuildFailed
+                          , DirNotEmpty
+                          , AlreadyInstalled
+
+                          , (AlreadyInstalled, NotInstalled)
+                          , (UnknownArchive, NotInstalled)
+                          , (ArchiveResult, NotInstalled)
+                          , (FileDoesNotExistError, NotInstalled)
+                          , (CopyError, NotInstalled)
+                          , (NotInstalled, NotInstalled)
+                          , (DirNotEmpty, NotInstalled)
+                          , (NoDownload, NotInstalled)
+                          , (BuildFailed, NotInstalled)
+                          , (TagNotFound, NotInstalled)
+                          , (DigestError, NotInstalled)
+                          , (GPGError, NotInstalled)
+                          , (DownloadFailed, NotInstalled)
+                          , (TarDirDoesNotExist, NotInstalled)
+                          , (NextVerNotFound, NotInstalled)
+                          , (NoToolVersionSet, NotInstalled)
+                          , (FileAlreadyExistsError, NotInstalled)
+                          , (ProcessError, NotInstalled)
+
+                          , (AlreadyInstalled, ())
+                          , (UnknownArchive, ())
+                          , (ArchiveResult, ())
+                          , (FileDoesNotExistError, ())
+                          , (CopyError, ())
+                          , (NotInstalled, ())
+                          , (DirNotEmpty, ())
+                          , (NoDownload, ())
+                          , (BuildFailed, ())
+                          , (TagNotFound, ())
+                          , (DigestError, ())
+                          , (GPGError, ())
+                          , (DownloadFailed, ())
+                          , (TarDirDoesNotExist, ())
+                          , (NextVerNotFound, ())
+                          , (NoToolVersionSet, ())
+                          , (FileAlreadyExistsError, ())
+                          , (ProcessError, ())
+
+                          , ((), NotInstalled)
+                          ]
+
+runInstGHC :: AppState
+           -> Maybe PlatformRequest
+           -> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
+           -> IO (VEither InstallGHCEffects a)
+runInstGHC appstate' mInstPlatform =
+  flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
+  . runResourceT
+  . runE
+    @InstallGHCEffects
+
 
     -------------------
     --[ Entrypoints ]--
@@ -288,23 +391,25 @@ install installCommand settings getAppState' runLogger = case installCommand of
   installGHC InstallOptions{..} = do
     s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
     (case instBindist of
-       Nothing -> runInstTool s' instPlatform $ do
+       Nothing -> runInstGHC s' instPlatform $ do
          (v, vi) <- liftE $ fromVersion instVer GHC
-         liftE $ installGHCBin
+         void $ liftE $ sequenceE (installGHCBin
-                   (_tvVersion v)
-                   isolateDir
-                   forceInstall
-         when instSet $ void $ liftE $ setGHC v SetGHCOnly
-         pure vi
-       Just uri -> do
-         runInstTool s'{ settings = settings {noVerify = True}} instPlatform $ do
-           (v, vi) <- liftE $ fromVersion instVer GHC
-           liftE $ installGHCBindist
-                     (DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
                      (_tvVersion v)
                      isolateDir
                      forceInstall
-           when instSet $ void $ liftE $ setGHC v SetGHCOnly
+                   )
+                   $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
+         pure vi
+       Just uri -> do
+         runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
+           (v, vi) <- liftE $ fromVersion instVer GHC
+           void $ liftE $ sequenceE (installGHCBindist
+                       (DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
+                       (_tvVersion v)
+                       isolateDir
+                       forceInstall
+                     )
+                     $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
            pure vi
       )
         >>= \case
@@ -313,14 +418,25 @@ install installCommand settings getAppState' runLogger = case installCommand of
                 forM_ (_viPostInstall =<< vi) $ \msg ->
                   runLogger $ logInfo msg
                 pure ExitSuccess
+
+              VLeft (V (AlreadyInstalled _ v, ())) -> do
+                runLogger $ logWarn $
+                  "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
+                pure ExitSuccess
               VLeft (V (AlreadyInstalled _ v)) -> do
                 runLogger $ logWarn $
                   "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
                 pure ExitSuccess
+
               VLeft (V (DirNotEmpty fp)) -> do
                 runLogger $ logWarn $
                   "Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
                 pure $ ExitFailure 3
+              VLeft (V (DirNotEmpty fp, ())) -> do
+                runLogger $ logWarn $
+                  "Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
+                pure $ ExitFailure 3
+
               VLeft err@(V (BuildFailed tmpdir _)) -> do
                 case keepDirs settings of
                   Never -> runLogger (logError $ T.pack $ prettyShow err)
@@ -328,6 +444,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
                     "Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
                     "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
                 pure $ ExitFailure 3
+              VLeft err@(V (BuildFailed tmpdir _, ())) -> do
+                case keepDirs settings of
+                  Never -> runLogger (logError $ T.pack $ prettyShow err)
+                  _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
+                    "Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
+                    "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
+                pure $ ExitFailure 3
+
               VLeft e -> do
                 runLogger $ do
                   logError $ T.pack $ prettyShow e
@@ -340,20 +464,22 @@ install installCommand settings getAppState' runLogger = case installCommand of
     s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
     (case instBindist of
        Nothing -> runInstTool s' instPlatform $ do
-         (v, vi) <- liftE $ fromVersion instVer Cabal
+         (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
-         liftE $ installCabalBin
+         void $ liftE $ sequenceE (installCabalBin
-                   (_tvVersion v)
+                                    v
-                   isolateDir
+                                    isolateDir
-                   forceInstall
+                                    forceInstall
+                                  ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
          pure vi
        Just uri -> do
          runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
-           (v, vi) <- liftE $ fromVersion instVer Cabal
+           (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
-           liftE $ installCabalBindist 
+           void $ liftE $ sequenceE (installCabalBindist
-                     (DownloadInfo uri Nothing "")
+                                      (DownloadInfo uri Nothing "")
-                     (_tvVersion v)
+                                      v
-                     isolateDir
+                                      isolateDir
-                     forceInstall
+                                      forceInstall
+                                    ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
            pure vi
       )
       >>= \case
@@ -370,6 +496,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
               runLogger $ logWarn $
                 "File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
               pure $ ExitFailure 3
+            VLeft (V (AlreadyInstalled _ v, ())) -> do
+              runLogger $ logWarn $
+                "Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
+              pure ExitSuccess
+            VLeft (V (FileAlreadyExistsError fp, ())) -> do
+              runLogger $ logWarn $
+                "File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
+              pure $ ExitFailure 3
             VLeft e -> do
               runLogger $ do
                 logError $ T.pack $ prettyShow e
@@ -381,20 +515,23 @@ install installCommand settings getAppState' runLogger = case installCommand of
      s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
      (case instBindist of
        Nothing -> runInstTool s' instPlatform $ do
-         (v, vi) <- liftE $ fromVersion instVer HLS
+         (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-         liftE $ installHLSBin
+         void $ liftE $ sequenceE (installHLSBin
-                   (_tvVersion v)
+                                    v
-                   isolateDir
+                                    isolateDir
-                   forceInstall
+                                    forceInstall
+                                  ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
          pure vi
        Just uri -> do
          runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
-           (v, vi) <- liftE $ fromVersion instVer HLS
+           (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-           liftE $ installHLSBindist
+           -- TODO: support legacy
-                     (DownloadInfo uri Nothing "")
+           void $ liftE $ sequenceE (installHLSBindist
-                     (_tvVersion v)
+                                      (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
-                     isolateDir
+                                      v
-                     forceInstall
+                                      isolateDir
+                                      forceInstall
+                                    ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
            pure vi
       )
       >>= \case
@@ -415,6 +552,18 @@ install installCommand settings getAppState' runLogger = case installCommand of
               runLogger $ logWarn $
                 "File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
               pure $ ExitFailure 3
+            VLeft (V (AlreadyInstalled _ v, ())) -> do
+              runLogger $ logWarn $
+                  "HLS ver "
+                <> prettyVer v
+                <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
+                <> prettyVer v
+                <> "'"
+              pure ExitSuccess
+            VLeft (V (FileAlreadyExistsError fp, ())) -> do
+              runLogger $ logWarn $
+                "File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
+              pure $ ExitFailure 3
             VLeft e -> do
               runLogger $ do
                 logError $ T.pack $ prettyShow e
@@ -426,20 +575,22 @@ install installCommand settings getAppState' runLogger = case installCommand of
      s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
      (case instBindist of
         Nothing -> runInstTool s' instPlatform $ do
-          (v, vi) <- liftE $ fromVersion instVer Stack
+          (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
-          liftE $ installStackBin
+          void $ liftE $ sequenceE (installStackBin
-                    (_tvVersion v)
+                                     v
-                    isolateDir
+                                     isolateDir
-                    forceInstall
+                                     forceInstall
+                                   ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
           pure vi
         Just uri -> do
           runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
-            (v, vi) <- liftE $ fromVersion instVer Stack
+            (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
-            liftE $ installStackBindist
+            void $ liftE $ sequenceE (installStackBindist
-                      (DownloadInfo uri Nothing "")
+                                       (DownloadInfo uri Nothing "")
-                      (_tvVersion v)
+                                       v
-                      isolateDir
+                                       isolateDir
-                      forceInstall
+                                       forceInstall
+                                     ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
             pure vi
       )
       >>= \case
@@ -456,6 +607,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
               runLogger $ logWarn $
                 "File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
               pure $ ExitFailure 3
+            VLeft (V (AlreadyInstalled _ v, ())) -> do
+              runLogger $ logWarn $
+                "Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
+              pure ExitSuccess
+            VLeft (V (FileAlreadyExistsError fp, ())) -> do
+              runLogger $ logWarn $
+                "File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
+              pure $ ExitFailure 3
             VLeft e -> do
               runLogger $ do
                 logError $ T.pack $ prettyShow e

app/ghcup/GHCup/OptParse/List.hs

@@ -69,6 +69,7 @@ listOpts =
             (eitherReader toolParser)
             (short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
               "Tool to list versions for. Default is all"
+              <> completer (toolCompleter)
             )
           )
     <*> optional
@@ -78,6 +79,7 @@ listOpts =
             <> long "show-criteria"
             <> metavar "<installed|set|available>"
             <> help "Show only installed/set/available tool versions"
+              <> completer (listCompleter ["installed", "set", "available"])
             )
           )
     <*> switch
@@ -141,11 +143,11 @@ printListResult no_color raw lr = do
             )
         $ lr
   let cols =
-        foldr (\xs ys -> zipWith (:) xs ys) (replicate (length rows) []) rows
+        foldr (\xs ys -> zipWith (:) xs ys) (repeat []) rows
       lengths = fmap (maximum . fmap strWidth) cols
       padded  = fmap (\xs -> zipWith padTo xs lengths) rows
 
-  forM_ padded $ \row -> putStrLn $ unwords row
+  forM_ (if raw then rows else padded) $ \row -> putStrLn $ unwords row
  where
 
   padTo str' x =

app/ghcup/GHCup/OptParse/Prefetch.hs

@@ -83,7 +83,7 @@ prefetchP = subparser
         (PrefetchGHC
           <$> (PrefetchGHCOptions
                 <$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
-                <*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
+                <*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
           <*>  optional (toolVersionArgument Nothing (Just GHC)) )
         ( progDesc "Download GHC assets for installation")
       )
@@ -92,7 +92,7 @@ prefetchP = subparser
       "cabal"
       (info 
         (PrefetchCabal
-          <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
+          <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
           <*> ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper ))
         ( progDesc "Download cabal assets for installation")
       )
@@ -101,7 +101,7 @@ prefetchP = subparser
       "hls"
       (info 
         (PrefetchHLS
-          <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
+          <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
           <*> ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper ))
         ( progDesc "Download HLS assets for installation")
       )
@@ -110,7 +110,7 @@ prefetchP = subparser
       "stack"
       (info 
         (PrefetchStack
-          <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
+          <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
           <*> ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper ))
         ( progDesc "Download stack assets for installation")
       )

app/ghcup/GHCup/OptParse/Run.hs

@@ -0,0 +1,463 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE TypeFamilies      #-}
+module GHCup.OptParse.Run where
+
+
+import           GHCup
+import           GHCup.Utils
+import           GHCup.Utils.Prelude
+import           GHCup.Utils.File
+import           GHCup.OptParse.Common
+import           GHCup.Errors
+import           GHCup.Types
+import           GHCup.Types.Optics
+import           GHCup.Utils.Logger
+import           GHCup.Utils.String.QQ
+
+import           Control.Exception.Safe         ( MonadMask, MonadCatch )
+#if !MIN_VERSION_base(4,13,0)
+import           Control.Monad.Fail             ( MonadFail )
+#endif
+import           Codec.Archive
+import           Control.Monad.Reader
+import           Control.Monad.Trans.Resource
+import           Data.Functor
+import           Data.Maybe (isNothing)
+import           Data.List                      ( intercalate )
+import           Haskus.Utils.Variant.Excepts
+import           Options.Applicative     hiding ( style )
+import           Prelude                 hiding ( appendFile )
+import           System.Directory
+import           System.FilePath
+import           System.Environment
+import           System.Exit
+import           Text.PrettyPrint.HughesPJClass ( prettyShow )
+
+import qualified Data.Map.Strict               as Map
+import qualified Data.Text                     as T
+#ifndef IS_WINDOWS
+import qualified System.Posix.Process          as SPP
+#endif
+
+
+
+
+
+    ---------------
+    --[ Options ]--
+    ---------------
+
+
+data RunOptions = RunOptions
+  { runAppendPATH :: Bool
+  , runInstTool'  :: Bool
+  , runGHCVer     :: Maybe ToolVersion
+  , runCabalVer   :: Maybe ToolVersion
+  , runHLSVer     :: Maybe ToolVersion
+  , runStackVer   :: Maybe ToolVersion
+  , runBinDir     :: Maybe FilePath
+  , runCOMMAND    :: [String]
+  }
+
+
+
+    ---------------
+    --[ Parsers ]--
+    ---------------
+
+          
+    
+runOpts :: Parser RunOptions
+runOpts =
+  RunOptions
+    <$> switch
+          (short 'a' <> long "append" <> help "Append bin/ dir to PATH instead of prepending (this means that e.g. a system installation may take precedence)")
+    <*> switch
+          (short 'i' <> long "install" <> help "Install the tool, if missing")
+    <*> optional
+          (option
+            (eitherReader toolVersionEither)
+            (metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
+            <> completer (tagCompleter GHC [])
+            <> (completer $ versionCompleter Nothing GHC)
+            )
+          )
+    <*> optional
+          (option
+            (eitherReader toolVersionEither)
+            (metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
+            <> completer (tagCompleter Cabal [])
+            <> (completer $ versionCompleter Nothing Cabal)
+            )
+          )
+    <*> optional
+          (option
+            (eitherReader toolVersionEither)
+            (metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
+            <> completer (tagCompleter HLS [])
+            <> (completer $ versionCompleter Nothing HLS)
+            )
+          )
+    <*> optional
+          (option
+            (eitherReader toolVersionEither)
+            (metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
+            <> completer (tagCompleter Stack [])
+            <> (completer $ versionCompleter Nothing Stack)
+            )
+          )
+    <*> optional
+          (option
+           (eitherReader isolateParser)
+           (  short 'b'
+           <> long "bindir"
+           <> metavar "DIR"
+           <> help "directory where to create the tool symlinks (default: newly created system temp dir)"
+           <> completer (bashCompleter "directory")
+           )
+          )
+    <*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
+          
+
+
+
+    --------------
+    --[ Footer ]--
+    --------------
+
+
+runFooter :: String
+runFooter = [s|Discussion:
+  Adds the given tools to a dedicated bin/ directory and adds them to PATH, exposing
+  the relevant binaries, then executes a command.
+
+Examples:
+  # run VSCode with all latest toolchain exposed, installing missing versions if necessary
+  ghcup run --ghc latest --cabal latest --hls latest --stack latest --install -- code Setup.hs
+
+  # create a custom toolchain bin/ dir with GHC and cabal that can be manually added to PATH
+  ghcup run --ghc 8.10.7 --cabal 3.2.0.0 --bindir $HOME/toolchain/bin
+
+  # run a specific ghc version
+  ghcup run --ghc 8.10.7 -- ghc --version|]
+
+
+
+
+    ---------------------------
+    --[ Effect interpreters ]--
+    ---------------------------
+
+
+type RunEffects = '[ AlreadyInstalled
+                   , UnknownArchive
+                   , ArchiveResult
+                   , FileDoesNotExistError
+                   , CopyError
+                   , NotInstalled
+                   , DirNotEmpty
+                   , NoDownload
+                   , NotInstalled
+                   , BuildFailed
+                   , TagNotFound
+                   , DigestError
+                   , GPGError
+                   , DownloadFailed
+                   , TarDirDoesNotExist
+                   , NextVerNotFound
+                   , NoToolVersionSet
+                   , FileAlreadyExistsError
+                   , ProcessError
+                   ]
+
+runLeanRUN :: (MonadUnliftIO m, MonadIO m)
+           => LeanAppState
+           -> Excepts RunEffects (ReaderT LeanAppState m) a
+           -> m (VEither RunEffects a)
+runLeanRUN leanAppstate =
+    -- Don't use runLeanAppState here, which is disabled on windows.
+    -- This is the only command on all platforms that doesn't need full appstate.
+    flip runReaderT leanAppstate
+    . runE
+      @RunEffects
+
+runRUN :: MonadUnliftIO m
+      => IO AppState
+      -> Excepts RunEffects (ResourceT (ReaderT AppState m)) a
+      -> m (VEither RunEffects a)
+runRUN appState action' = do
+  s' <- liftIO appState
+  flip runReaderT s'
+    . runResourceT
+    . runE
+      @RunEffects
+    $ action'
+
+
+
+    ------------------
+    --[ Entrypoint ]--
+    ------------------
+
+
+
+run :: forall m. 
+       ( MonadFail m
+       , MonadMask m
+       , MonadCatch m
+       , MonadIO m
+       , MonadUnliftIO m
+       )
+   => RunOptions
+   -> IO AppState
+   -> LeanAppState
+   -> (ReaderT LeanAppState m () -> m ())
+   -> m ExitCode
+run RunOptions{..} runAppState leanAppstate runLogger = do
+   r <- if or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool'
+        then runRUN runAppState $ do
+         toolchain <- liftE resolveToolchainFull
+         tmp <- case runBinDir of
+           Just bindir -> do
+             liftIO $ createDirRecursive' bindir
+             liftIO $ canonicalizePath bindir
+           Nothing -> do
+             d <- liftIO $ predictableTmpDir toolchain
+             liftIO $ createDirRecursive' d
+             liftIO $ canonicalizePath d
+         liftE $ installToolChainFull toolchain tmp
+         pure tmp
+        else runLeanRUN leanAppstate $ do
+         toolchain <- resolveToolchain
+         tmp <- case runBinDir of
+           Just bindir -> do
+             liftIO $ createDirRecursive' bindir
+             liftIO $ canonicalizePath bindir
+           Nothing -> do
+             d <- liftIO $ predictableTmpDir toolchain
+             liftIO $ createDirRecursive' d
+             liftIO $ canonicalizePath d
+         liftE $ installToolChain toolchain tmp
+         pure tmp
+   case r of
+         VRight tmp -> do
+           case runCOMMAND of
+             [] -> do
+               liftIO $ putStr tmp
+               pure ExitSuccess
+             (cmd:args) -> do
+               newEnv <- liftIO $ addToPath tmp
+#ifndef IS_WINDOWS
+               void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
+               pure ExitSuccess
+#else
+               r' <- runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
+               case r' of
+                 VRight _ -> pure ExitSuccess
+                 VLeft e -> do
+                   runLogger $ logError $ T.pack $ prettyShow e
+                   pure $ ExitFailure 28
+#endif
+         VLeft e -> do
+           runLogger $ logError $ T.pack $ prettyShow e
+           pure $ ExitFailure 27
+
+  where
+
+   isToolTag :: ToolVersion -> Bool
+   isToolTag (ToolTag _) = True
+   isToolTag _           = False
+
+   -- TODO: doesn't work for cross
+   resolveToolchainFull :: ( MonadFail m
+                           , MonadThrow m
+                           , MonadIO m
+                           , MonadCatch m
+                           )
+                        => Excepts
+                             '[ TagNotFound
+                              , NextVerNotFound
+                              , NoToolVersionSet
+                              ] (ResourceT (ReaderT AppState m)) Toolchain
+   resolveToolchainFull = do
+         ghcVer <- forM runGHCVer $ \ver -> do
+           (v, _) <- liftE $ fromVersion (Just ver) GHC
+           pure v
+         cabalVer <- forM runCabalVer $ \ver -> do
+           (v, _) <- liftE $ fromVersion (Just ver) Cabal
+           pure v
+         hlsVer <- forM runHLSVer $ \ver -> do
+           (v, _) <- liftE $ fromVersion (Just ver) HLS
+           pure v
+         stackVer <- forM runStackVer $ \ver -> do
+           (v, _) <- liftE $ fromVersion (Just ver) Stack
+           pure v
+         pure Toolchain{..}
+
+   resolveToolchain = do
+         ghcVer <- case runGHCVer of
+            Just (ToolVersion v) -> pure $ Just v
+            Nothing -> pure Nothing
+            _ -> fail "Internal error"
+         cabalVer <- case runCabalVer of
+            Just (ToolVersion v) -> pure $ Just v
+            Nothing -> pure Nothing
+            _ -> fail "Internal error"
+         hlsVer <- case runHLSVer of
+            Just (ToolVersion v) -> pure $ Just v
+            Nothing -> pure Nothing
+            _ -> fail "Internal error"
+         stackVer <- case runStackVer of
+            Just (ToolVersion v) -> pure $ Just v
+            Nothing -> pure Nothing
+            _ -> fail "Internal error"
+         pure Toolchain{..}
+
+   installToolChainFull :: ( MonadFail m
+                           , MonadThrow m
+                           , MonadIO m
+                           , MonadCatch m
+                           )
+                        => Toolchain
+                        -> FilePath
+                        -> Excepts
+                             '[ TagNotFound
+                              , NextVerNotFound
+                              , NoToolVersionSet
+                              , UnknownArchive
+                              , TarDirDoesNotExist
+                              , ProcessError
+                              , NotInstalled
+                              , NoDownload
+                              , GPGError
+                              , DownloadFailed
+                              , DirNotEmpty
+                              , DigestError
+                              , BuildFailed
+                              , ArchiveResult
+                              , AlreadyInstalled
+                              , FileAlreadyExistsError
+                              , CopyError
+                              ] (ResourceT (ReaderT AppState m)) ()
+   installToolChainFull Toolchain{..} tmp = do
+         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
+           isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt
+           case mt of
+             Just (GHC, v) -> do
+               unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
+                 (_tvVersion v)
+                 Nothing
+                 False
+               setTool GHC v tmp
+             Just (Cabal, v) -> do
+               unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
+                 (_tvVersion v)
+                 Nothing
+                 False
+               setTool Cabal v tmp
+             Just (Stack, v) -> do
+               unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
+                 (_tvVersion v)
+                 Nothing
+                 False
+               setTool Stack v tmp
+             Just (HLS, v) -> do
+               unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
+                 (_tvVersion v)
+                 Nothing
+                 False
+               setTool HLS v tmp
+             _ -> pure ()
+
+   installToolChain :: ( MonadFail m
+                       , MonadThrow m
+                       , MonadIO m
+                       , MonadCatch m
+                       )
+                    => Toolchain
+                    -> FilePath
+                    -> Excepts '[NotInstalled] (ReaderT LeanAppState m) ()
+   installToolChain Toolchain{..} tmp = do
+         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
+           case mt of
+             Just (GHC, v)   -> setTool GHC v tmp
+             Just (Cabal, v) -> setTool Cabal v tmp
+             Just (Stack, v) -> setTool Stack v tmp
+             Just (HLS, v)   -> setTool HLS v tmp
+             _ -> pure ()
+
+   setTool tool v tmp =
+      case tool of
+        GHC -> do
+          void $ liftE $ setGHC v SetGHC_XYZ (Just tmp)
+          void $ liftE $ setGHC v SetGHCOnly (Just tmp)
+        Cabal -> do
+          bin  <- liftE $ whereIsTool Cabal v
+          cbin <- liftIO $ canonicalizePath bin
+          lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("cabal" <.> exeExt))
+        Stack -> do
+          bin  <- liftE $ whereIsTool Stack v
+          cbin <- liftIO $ canonicalizePath bin
+          lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("stack" <.> exeExt))
+        HLS -> do
+          Dirs {..}  <- getDirs
+          let v' = _tvVersion v
+          legacy <- isLegacyHLS v'
+          if legacy
+          then do
+            -- TODO: factor this out
+            hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v' !? (NotInstalled HLS (mkTVer v'))
+            cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)
+            lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)
+            hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
+            forM_ hlsBins $ \bin ->
+              lift $ createLink (relativeSymlink tmp bin) (tmp </> takeFileName bin)
+            liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
+          else do
+            liftE $ setHLS (_tvVersion v) SetHLS_XYZ (Just tmp)
+            liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
+        GHCup -> pure ()
+       
+   addToPath path = do
+    cEnv <- Map.fromList <$> getEnvironment
+    let paths          = ["PATH", "Path"]
+        curPaths       = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
+        newPath        = intercalate [searchPathSeparator] (if runAppendPATH then (curPaths ++ [path]) else (path : curPaths))
+        envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
+        pathVar        = if isWindows then "Path" else "PATH"
+        envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
+    liftIO $ setEnv pathVar newPath
+    return envWithNewPath
+
+   predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) =
+     liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none"))
+   predictableTmpDir Toolchain{..} = do
+      tmp <- getTemporaryDirectory
+      pure $ tmp
+        </> ("ghcup-" <> intercalate "_"
+              (  maybe [] ( (:[]) . ("ghc-"   <>) . T.unpack . tVerToText) ghcVer
+              <> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . tVerToText) cabalVer
+              <> maybe [] ( (:[]) . ("hls-"   <>) . T.unpack . tVerToText) hlsVer
+              <> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . tVerToText) stackVer
+              )
+            )
+
+
+
+    -------------------------
+    --[ Other local types ]--
+    -------------------------
+
+
+
+data Toolchain = Toolchain
+  { ghcVer     :: Maybe GHCTargetVersion
+  , cabalVer   :: Maybe GHCTargetVersion
+  , hlsVer     :: Maybe GHCTargetVersion
+  , stackVer   :: Maybe GHCTargetVersion
+  }

app/ghcup/GHCup/OptParse/Set.hs

@@ -271,10 +271,10 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
           -> m ExitCode
   setGHC' SetOptions{ sToolVer } =
     case sToolVer of
-      (SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly >> pure v)
+      (SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
       _ -> runSetGHC runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer GHC
-          liftE $ setGHC v SetGHCOnly
+          liftE $ setGHC v SetGHCOnly Nothing
         )
       >>= \case
             VRight GHCTargetVersion{..} -> do
@@ -311,10 +311,10 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
           -> m ExitCode
   setHLS' SetOptions{ sToolVer } =
     case sToolVer of
-      (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) >> pure v)
+      (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing >> pure v)
       _ -> runSetHLS runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer HLS
-          liftE $ setHLS (_tvVersion v)
+          liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
           pure v
         )
       >>= \case

app/ghcup/GHCup/OptParse/ToolRequirements.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE QuasiQuotes #-}
 
 module GHCup.OptParse.ToolRequirements where
 
@@ -11,6 +12,7 @@ module GHCup.OptParse.ToolRequirements where
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Utils.Logger
+import           GHCup.Utils.String.QQ
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -34,6 +36,41 @@ import System.IO
 
 
 
+    ---------------
+    --[ Options ]--
+    ---------------
+
+
+data ToolReqOpts = ToolReqOpts
+  { tlrRaw :: Bool
+  }
+
+
+
+
+    ---------------
+    --[ Parsers ]--
+    ---------------
+
+          
+toolReqP :: Parser ToolReqOpts
+toolReqP =
+  ToolReqOpts
+    <$> switch (short 'r' <> long "raw-format" <> help "machine-parsable format")
+
+
+
+
+    --------------
+    --[ Footer ]--
+    --------------
+
+
+toolReqFooter :: String
+toolReqFooter = [s|Discussion:
+  Print tool requirements on the current platform.
+  If you want to pass this to your package manage, use '--raw-format'.|]
+
 
 
     ---------------------------
@@ -66,14 +103,17 @@ toolRequirements :: ( Monad m
                     , MonadFail m
                     , Alternative m
                     )
-                 => (ReaderT AppState m (VEither ToolRequirementsEffects ()) -> m (VEither ToolRequirementsEffects ()))
+                 => ToolReqOpts
+                 -> (ReaderT AppState m (VEither ToolRequirementsEffects ()) -> m (VEither ToolRequirementsEffects ()))
                  -> (ReaderT LeanAppState m () -> m ())
                  -> m ExitCode
-toolRequirements runAppState runLogger = runToolRequirements runAppState (do
+toolRequirements ToolReqOpts{..} runAppState runLogger = runToolRequirements runAppState (do
     GHCupInfo { .. } <- lift getGHCupInfo
     platform' <- liftE getPlatform
-    req      <- getCommonRequirements platform' _toolRequirements ?? NoToolRequirements
+    req       <- getCommonRequirements platform' _toolRequirements ?? NoToolRequirements
-    liftIO $ T.hPutStr stdout (prettyRequirements req)
+    if tlrRaw
+    then liftIO $ T.hPutStr stdout (rawRequirements req)
+    else liftIO $ T.hPutStr stdout (prettyRequirements req)
   )
     >>= \case
           VRight _ -> pure ExitSuccess

app/ghcup/GHCup/OptParse/Upgrade.hs

@@ -72,6 +72,7 @@ upgradeOptsP =
               str
               (short 't' <> long "target" <> metavar "TARGET_DIR" <> help
                 "Absolute filepath to write ghcup into"
+                <> completer (bashCompleter "file")
               )
         )
     <|> pure UpgradeGHCupDir
@@ -113,17 +114,17 @@ runUpgrade runAppState =
 
 
 upgrade :: ( Monad m
-         , MonadMask m
+           , MonadMask m
-         , MonadUnliftIO m
+           , MonadUnliftIO m
-         , MonadFail m
+           , MonadFail m
-         )
+           )
         => UpgradeOpts
         -> Bool
+        -> Dirs
         -> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
         -> (ReaderT LeanAppState m () -> m ())
         -> m ExitCode
-upgrade uOpts force' runAppState runLogger = do
+upgrade uOpts force' Dirs{..} runAppState runLogger = do
-  VRight Dirs{ .. }  <- runAppState (VRight <$> getDirs)
   target <- case uOpts of
     UpgradeInplace  -> Just <$> liftIO getExecutablePath
     (UpgradeAt p)   -> pure $ Just p

app/ghcup/Main.hs

@@ -20,6 +20,7 @@ import           GHCup.Download
 import           GHCup.Errors
 import           GHCup.Platform
 import           GHCup.Types
+import           GHCup.Types.Optics      hiding ( toolRequirements )
 import           GHCup.Utils
 import           GHCup.Utils.Logger
 import           GHCup.Utils.Prelude
@@ -39,6 +40,7 @@ import           Data.Aeson.Encode.Pretty       ( encodePretty )
 import           Data.Either
 import           Data.Functor
 import           Data.Maybe
+import           Data.Versions
 import           GHC.IO.Encoding
 import           Haskus.Utils.Variant.Excepts
 import           Language.Haskell.TH
@@ -55,6 +57,7 @@ import qualified Data.ByteString               as B
 import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
 import qualified Data.Text.Encoding            as E
+import qualified GHCup.Types                   as Types
 
 
 
@@ -72,15 +75,16 @@ toSettings options = do
  where
    mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
    mergeConf Options{..} UserSettings{..} noColor =
-     let cache       = fromMaybe (fromMaybe False uCache) optCache
+     let cache       = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache
-         noVerify    = fromMaybe (fromMaybe False uNoVerify) optNoVerify
+         metaCache   = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache
-         verbose     = fromMaybe (fromMaybe False uVerbose) optVerbose
+         noVerify    = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify
-         keepDirs    = fromMaybe (fromMaybe Errors uKeepDirs) optKeepDirs
+         verbose     = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose
+         keepDirs    = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
          downloader  = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
          keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
-         urlSource   = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource
+         urlSource   = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) (OwnSource . (:[]) . Right) optUrlSource
-         noNetwork   = fromMaybe (fromMaybe False uNoNetwork) optNoNetwork
+         noNetwork   = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
-         gpgSetting  = fromMaybe (fromMaybe GPGNone uGPGSetting) optGpg
+         gpgSetting  = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
      in (Settings {..}, keyBindings)
 #if defined(INTERNAL_DOWNLOADER)
    defaultDownloader = Internal
@@ -136,7 +140,12 @@ main = do
         <> hidden
         )
   let listCommands = infoOption
-        "install set rm install-cabal list upgrade compile debug-info tool-requirements changelog"
+        ("install set rm install-cabal list"
+#ifndef DISABLE_UPGRADE
+          <> " upgrade"
+#endif
+          <> " compile debug-info tool-requirements changelog"
+        )
         (  long "list-commands"
         <> help "List available commands for shell completion"
         <> internal
@@ -189,7 +198,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
           -------------------------
 
 
-              appState = do
+          let appState = do
                 pfreq <- (
                   runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
                   ) >>= \case
@@ -219,14 +228,40 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   Nuke -> pure ()
                   Whereis _ _ -> pure ()
                   DInfo -> pure ()
-                  ToolRequirements -> pure ()
+                  ToolRequirements _ -> pure ()
                   ChangeLog _ -> pure ()
                   UnSet _ -> pure ()
 #if defined(BRICK)
                   Interactive -> pure ()
 #endif
-                  _ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
+                  -- check for new tools
-                         Nothing -> runReaderT checkForUpdates s'
+                  _
+                    | Just False <- optVerbose -> pure ()
+                    | otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
+                         Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
+                           newTools <- lift checkForUpdates 
+                           forM_ newTools $ \newTool@(t, l) -> do
+                             -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
+                             alreadyInstalling' <- alreadyInstalling optCommand newTool
+                             when (not alreadyInstalling') $
+                               case t of
+#ifdef DISABLE_UPGRADE
+                                 GHCup -> pure ()
+#else
+                                 GHCup -> runLogger $
+                                            logWarn ("New GHCup version available: "
+                                              <> prettyVer l
+                                              <> ". To upgrade, run 'ghcup upgrade'")
+#endif
+                                 _ -> runLogger $
+                                        logWarn ("New "
+                                          <> T.pack (prettyShow t)
+                                          <> " version available. "
+                                          <> "To upgrade, run 'ghcup install "
+                                          <> T.pack (prettyShow t)
+                                          <> " "
+                                          <> prettyVer l
+                                          <> "'")
                          Just _ -> pure ()
 
                 -- TODO: always run for windows
@@ -268,16 +303,19 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
             List lo                  -> list lo no_color runAppState
             Rm rmCommand             -> rm rmCommand runAppState runLogger
             DInfo                    -> dinfo runAppState runLogger
-            Compile compileCommand   -> compile compileCommand settings runAppState runLogger
+            Compile compileCommand   -> compile compileCommand settings dirs runAppState runLogger
             Config configCommand     -> config configCommand settings keybindings runLogger
             Whereis whereisOptions
                     whereisCommand   -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
-            Upgrade uOpts force'     -> upgrade uOpts force' runAppState runLogger
+#ifndef DISABLE_UPGRADE
-            ToolRequirements         -> toolRequirements runAppState runLogger
+            Upgrade uOpts force'     -> upgrade uOpts force' dirs runAppState runLogger
+#endif
+            ToolRequirements topts   -> toolRequirements topts runAppState runLogger
             ChangeLog changelogOpts  -> changelog changelogOpts runAppState runLogger
             Nuke                     -> nuke appState runLogger
             Prefetch pfCom           -> prefetch pfCom runAppState runLogger
             GC gcOpts                -> gc gcOpts runAppState runLogger
+            Run runCommand           -> run runCommand appState leanAppstate runLogger
 
           case res of
             ExitSuccess        -> pure ()
@@ -285,4 +323,58 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
   pure ()
 
+ where
+  alreadyInstalling :: ( HasLog env
+                       , MonadFail m
+                       , MonadReader env m
+                       , HasGHCupInfo env
+                       , HasDirs env
+                       , MonadThrow m
+                       , MonadIO m
+                       , MonadCatch m
+                       )
+                    => Command
+                    -> (Tool, Version)
+                    -> Excepts
+                         '[ TagNotFound
+                          , NextVerNotFound
+                          , NoToolVersionSet
+                          ] m Bool
+  alreadyInstalling (Install (Right InstallOptions{..}))                 (GHC, ver)   = cmp' GHC instVer ver
+  alreadyInstalling (Install (Left (InstallGHC InstallOptions{..})))     (GHC, ver)   = cmp' GHC instVer ver
+  alreadyInstalling (Install (Left (InstallCabal InstallOptions{..})))   (Cabal, ver) = cmp' Cabal instVer ver
+  alreadyInstalling (Install (Left (InstallHLS InstallOptions{..})))     (HLS, ver)   = cmp' HLS instVer ver
+  alreadyInstalling (Install (Left (InstallStack InstallOptions{..})))   (Stack, ver) = cmp' Stack instVer ver
+  alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
+    (GHC, ver)   = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
+  alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
+    (GHC, ver)   = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
+  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Just over }))
+    (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
+  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
+    (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
+#ifndef DISABLE_UPGRADE
+  alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True
+#endif
+  alreadyInstalling _ _ = pure False
 
+  cmp' :: ( HasLog env
+          , MonadFail m
+          , MonadReader env m
+          , HasGHCupInfo env
+          , HasDirs env
+          , MonadThrow m
+          , MonadIO m
+          , MonadCatch m
+          )
+       => Tool
+       -> Maybe ToolVersion
+       -> Version
+       -> Excepts
+            '[ TagNotFound
+             , NextVerNotFound
+             , NoToolVersionSet
+             ] m Bool
+  cmp' tool instVer ver = do
+    (v, _) <- liftE $ fromVersion instVer tool
+    pure (v == mkTVer ver)

cabal.ghc8107.project

@@ -8,6 +8,11 @@ package ghcup
     tests: True
     flags: +tui
 
+source-repository-package
+  type: git
+  location: https://github.com/bgamari/terminal-size.git
+  tag: 34ea816bd63f75f800eedac12c6908c6f3736036
+
 constraints: http-io-streams -brotli,
              any.Cabal ==3.6.2.0,
              any.aeson >= 2.0.1.0

cabal.ghc8107.project.freeze

@@ -4,18 +4,18 @@ constraints: any.Cabal ==3.6.2.0,
              any.HUnit ==1.6.2.0,
              any.HsOpenSSL ==0.11.7.2,
              HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
+             any.OneTuple ==0.3.1,
              any.QuickCheck ==2.14.2,
              QuickCheck -old-random +templatehaskell,
              any.StateVar ==1.2.2,
              any.abstract-deque ==0.3,
              abstract-deque -usecas,
-             any.aeson ==2.0.1.0,
+             any.aeson ==2.0.3.0,
-             aeson -bytestring-builder -cffi +ordered-keymap,
+             aeson -cffi +ordered-keymap,
              any.aeson-pretty ==0.8.9,
              aeson-pretty +lib-only,
-             any.alex ==3.2.6,
+             any.alex ==3.2.7.1,
-             alex +small_base,
+             any.ansi-terminal ==0.11.1,
-             any.ansi-terminal ==0.11,
              ansi-terminal -example,
              any.ansi-wl-pprint ==0.6.9,
              ansi-wl-pprint -example,
@@ -25,14 +25,14 @@ constraints: any.Cabal ==3.6.2.0,
              async -bench,
              any.atomic-primops ==0.8.4,
              atomic-primops -debug,
-             any.attoparsec ==0.13.2.5,
+             any.attoparsec ==0.14.4,
              attoparsec -developer,
              any.base ==4.14.3.0,
-             any.base-compat ==0.12.0,
+             any.base-compat ==0.12.1,
-             any.base-compat-batteries ==0.12.0,
+             any.base-compat-batteries ==0.12.1,
-             any.base-orphans ==0.8.5,
+             any.base-orphans ==0.8.6,
-             any.base16-bytestring ==1.0.1.0,
+             any.base16-bytestring ==1.0.2.0,
-             any.base64-bytestring ==1.1.0.0,
+             any.base64-bytestring ==1.2.1.0,
              any.bifunctors ==5.5.11,
              bifunctors +semigroups +tagged,
              any.binary ==0.8.8.0,
@@ -52,7 +52,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.chs-cabal ==0.1.1.1,
              any.chs-deps ==0.1.0.0,
              chs-deps -cross,
-             any.clock ==0.8.2,
+             any.clock ==0.8.3,
              clock -llvm,
              any.colour ==2.3.6,
              any.comonad ==5.0.8,
@@ -66,10 +66,10 @@ constraints: any.Cabal ==3.6.2.0,
              contravariant +semigroups +statevar +tagged,
              any.cpphs ==1.20.9.1,
              cpphs -old-locale,
-             any.cryptohash-sha1 ==0.11.100.1,
+             any.cryptohash-sha1 ==0.11.101.0,
              any.cryptohash-sha256 ==0.11.102.1,
              cryptohash-sha256 -exe +use-cbits,
-             any.data-clist ==0.1.2.3,
+             any.data-clist ==0.2,
              any.data-fix ==0.3.2,
              any.deepseq ==1.4.4.0,
              any.directory ==1.3.6.0,
@@ -82,29 +82,34 @@ constraints: any.Cabal ==3.6.2.0,
              any.filepath ==1.4.2.1,
              any.free ==5.1.7,
              any.fusion-plugin-types ==0.1.0,
-             any.generic-arbitrary ==0.1.0,
+             any.generic-arbitrary ==0.2.0,
+             any.ghc ==8.10.7,
+             any.ghc-boot ==8.10.7,
              any.ghc-boot-th ==8.10.7,
              any.ghc-byteorder ==4.11.0.0.10,
+             any.ghc-heap ==8.10.7,
              any.ghc-prim ==0.6.1,
+             any.ghci ==8.10.7,
              any.happy ==1.20.0,
-             any.hashable ==1.3.4.1,
+             any.hashable ==1.4.0.2,
-             hashable +integer-gmp -random-initial-seed,
+             hashable +containers +integer-gmp -random-initial-seed,
              any.haskus-utils-data ==1.4,
              any.haskus-utils-types ==1.5.1,
-             any.haskus-utils-variant ==3.1,
+             any.haskus-utils-variant ==3.2.1,
              any.heaps ==0.4,
-             any.hsc2hs ==0.68.7,
+             any.hpc ==0.6.1.0,
+             any.hsc2hs ==0.68.8,
              hsc2hs -in-ghc-tree,
-             any.hspec ==2.7.10,
+             any.hspec ==2.9.4,
-             any.hspec-core ==2.7.10,
+             any.hspec-core ==2.9.4,
-             any.hspec-discover ==2.7.10,
+             any.hspec-discover ==2.9.4,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
              any.http-io-streams ==0.1.6.0,
              http-io-streams -brotli +fast-xor,
              any.indexed-profunctors ==0.1.1,
-             any.indexed-traversable ==0.1.1,
+             any.indexed-traversable ==0.1.2,
-             any.indexed-traversable-instances ==0.1,
+             any.indexed-traversable-instances ==0.1.1,
              any.integer-gmp ==1.0.3.0,
              any.integer-logarithms ==1.0.3.1,
              integer-logarithms -check-bounds +integer-gmp,
@@ -112,20 +117,20 @@ constraints: any.Cabal ==3.6.2.0,
              io-streams +network -nointeractivetests +zlib,
              any.language-c ==0.9.0.1,
              language-c -allwarnings +iecfpextension +usebytestrings,
-             any.libarchive ==3.0.3.1,
+             any.libarchive ==3.0.3.2,
-             libarchive -cross -low-memory -system-libarchive,
+             libarchive -cross -low-memory +no-exe -system-libarchive,
-             any.libyaml-streamly ==0.2.0,
+             any.libyaml-streamly ==0.2.1,
              libyaml-streamly -no-unicode -system-libyaml,
              any.lockfree-queue ==0.2.3.1,
              any.lzma-static ==5.2.5.4,
-             any.megaparsec ==9.0.1,
+             any.megaparsec ==9.2.0,
              megaparsec -dev,
              any.microlens ==0.4.12.0,
              any.microlens-mtl ==0.2.0.1,
              any.microlens-th ==0.4.3.10,
              any.monad-control ==1.0.3.1,
              any.mtl ==2.2.2,
-             any.network ==3.1.2.5,
+             any.network ==3.1.2.7,
              network -devel,
              any.network-uri ==2.6.4.1,
              any.openssl-streams ==1.2.3.0,
@@ -134,7 +139,7 @@ constraints: any.Cabal ==3.6.2.0,
              optics-core -explicit-generic-labels,
              any.optics-extra ==0.4,
              any.optics-th ==0.4,
-             any.optparse-applicative ==0.16.1.0,
+             any.optparse-applicative ==0.17.0.0,
              optparse-applicative +process,
              any.os-release ==1.0.2.1,
              os-release -devel,
@@ -145,15 +150,15 @@ constraints: any.Cabal ==3.6.2.0,
              any.polyparse ==1.13,
              any.pretty ==1.1.3.6,
              any.pretty-terminal ==0.1.0.0,
-             any.primitive ==0.7.2.0,
+             any.primitive ==0.7.3.0,
              any.process ==1.6.13.2,
              any.profunctors ==5.6.2,
              any.quickcheck-arbitrary-adt ==0.3.1.0,
              any.quickcheck-io ==0.2.0,
              any.random ==1.2.1,
-             any.recursion-schemes ==5.2.2.1,
+             any.recursion-schemes ==5.2.2.2,
              recursion-schemes +template-haskell,
-             any.regex-base ==0.94.0.1,
+             any.regex-base ==0.94.0.2,
              any.regex-posix ==0.96.0.1,
              regex-posix -_regex-posix-clib,
              any.resourcet ==1.2.4.3,
@@ -164,34 +169,37 @@ constraints: any.Cabal ==3.6.2.0,
              any.safe-exceptions ==0.1.7.2,
              any.scientific ==0.3.7.0,
              scientific -bytestring-builder -integer-simple,
-             any.semialign ==1.2,
+             any.semialign ==1.2.0.1,
              semialign +semigroupoids,
-             any.semigroupoids ==5.3.6,
+             any.semigroupoids ==5.3.7,
              semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
              any.setenv ==0.1.1.3,
              any.split ==0.2.3.4,
-             any.splitmix ==0.1.0.3,
+             any.splitmix ==0.1.0.4,
              splitmix -optimised-mixer,
              any.stm ==2.5.0.1,
-             any.streamly ==0.8.0,
+             any.streamly ==0.8.2,
-             streamly -debug -dev -fusion-plugin -has-llvm -inspection -no-fusion +opt -streamk -use-c-malloc,
+             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc -use-unliftio,
              any.strict ==0.4.0.1,
              strict +assoc,
              any.strict-base ==0.4.0.0,
              any.tagged ==0.8.6.1,
              tagged +deepseq +transformers,
+             any.tagsoup ==0.14.8,
              any.template-haskell ==2.16.0.0,
              any.temporary ==1.3,
              any.terminal-progress-bar ==0.4.1,
              any.terminal-size ==0.3.2.1,
              any.terminfo ==0.4.1.4,
              any.text ==1.2.4.1,
+             any.text-short ==0.1.5,
+             text-short -asserts,
              any.text-zipper ==0.11,
              any.tf-random ==0.5,
              any.th-abstraction ==0.4.3.0,
              any.th-compat ==0.1.3,
              any.th-lift ==0.8.2,
-             any.th-lift-instances ==0.1.18,
+             any.th-lift-instances ==0.1.19,
              any.these ==1.1.1.1,
              these +assoc,
              any.time ==1.9.3,
@@ -200,14 +208,16 @@ constraints: any.Cabal ==3.6.2.0,
              any.transformers ==0.5.6.2,
              any.transformers-base ==0.4.6,
              transformers-base +orphaninstances,
-             any.transformers-compat ==0.7,
+             any.transformers-compat ==0.7.1,
              transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
+             any.unicode-data ==0.3.0,
+             unicode-data -ucd2haskell,
              any.unix ==2.7.2.2,
-             any.unix-bytestring ==0.3.7.5,
+             any.unix-bytestring ==0.3.7.6,
-             any.unix-compat ==0.5.3,
+             any.unix-compat ==0.5.4,
              unix-compat -old-time,
              any.unliftio-core ==0.2.0.1,
-             any.unordered-containers ==0.2.14.0,
+             any.unordered-containers ==0.2.17.0,
              unordered-containers -debug,
              any.uri-bytestring ==0.3.3.1,
              uri-bytestring -lib-werror,
@@ -215,15 +225,15 @@ constraints: any.Cabal ==3.6.2.0,
              any.uuid-types ==1.0.5,
              any.vector ==0.12.3.1,
              vector +boundschecks -internalchecks -unsafechecks -wall,
-             any.versions ==5.0.0,
+             any.versions ==5.0.3,
              any.vty ==5.33,
              any.witherable ==0.4.2,
              any.word-wrap ==0.5,
              any.word8 ==0.1.3,
-             any.xor ==0.0.1.0,
+             any.xor ==0.0.1.1,
-             any.yaml-streamly ==0.12.0,
+             any.yaml-streamly ==0.12.1,
              yaml-streamly +no-examples +no-exe,
              any.zlib ==0.6.2.3,
              zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
              any.zlib-bindings ==0.1.1.5
-index-state: hackage.haskell.org 2021-10-24T10:21:56Z
+index-state: hackage.haskell.org 2022-03-15T16:43:02Z

cabal.ghc902.project

@@ -8,6 +8,11 @@ package ghcup
     tests: True
     flags: +tui
 
+source-repository-package
+  type: git
+  location: https://github.com/bgamari/terminal-size.git
+  tag: 34ea816bd63f75f800eedac12c6908c6f3736036
+
 constraints: http-io-streams -brotli,
              any.Cabal ==3.6.2.0,
              any.aeson >= 2.0.1.0
@@ -26,4 +31,4 @@ package aeson
 
 allow-newer: base, ghc-prim, template-haskell, language-c
 
-with-compiler: ghc-9.0.1
+with-compiler: ghc-9.0.2

cabal.ghc902.project.freeze

@@ -4,18 +4,18 @@ constraints: any.Cabal ==3.6.2.0,
              any.HUnit ==1.6.2.0,
              any.HsOpenSSL ==0.11.7.2,
              HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
+             any.OneTuple ==0.3.1,
              any.QuickCheck ==2.14.2,
              QuickCheck -old-random +templatehaskell,
              any.StateVar ==1.2.2,
              any.abstract-deque ==0.3,
              abstract-deque -usecas,
-             any.aeson ==2.0.1.0,
+             any.aeson ==2.0.3.0,
-             aeson -bytestring-builder -cffi +ordered-keymap,
+             aeson -cffi +ordered-keymap,
              any.aeson-pretty ==0.8.9,
              aeson-pretty +lib-only,
-             any.alex ==3.2.6,
+             any.alex ==3.2.7.1,
-             alex +small_base,
+             any.ansi-terminal ==0.11.1,
-             any.ansi-terminal ==0.11,
              ansi-terminal -example,
              any.ansi-wl-pprint ==0.6.9,
              ansi-wl-pprint -example,
@@ -25,14 +25,14 @@ constraints: any.Cabal ==3.6.2.0,
              async -bench,
              any.atomic-primops ==0.8.4,
              atomic-primops -debug,
-             any.attoparsec ==0.13.2.5,
+             any.attoparsec ==0.14.4,
              attoparsec -developer,
-             any.base ==4.15.0.0,
+             any.base ==4.15.1.0,
-             any.base-compat ==0.12.0,
+             any.base-compat ==0.12.1,
-             any.base-compat-batteries ==0.12.0,
+             any.base-compat-batteries ==0.12.1,
-             any.base-orphans ==0.8.5,
+             any.base-orphans ==0.8.6,
-             any.base16-bytestring ==1.0.1.0,
+             any.base16-bytestring ==1.0.2.0,
-             any.base64-bytestring ==1.1.0.0,
+             any.base64-bytestring ==1.2.1.0,
              any.bifunctors ==5.5.11,
              bifunctors +semigroups +tagged,
              any.binary ==0.8.8.0,
@@ -52,7 +52,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.chs-cabal ==0.1.1.1,
              any.chs-deps ==0.1.0.0,
              chs-deps -cross,
-             any.clock ==0.8.2,
+             any.clock ==0.8.3,
              clock -llvm,
              any.colour ==2.3.6,
              any.comonad ==5.0.8,
@@ -66,13 +66,13 @@ constraints: any.Cabal ==3.6.2.0,
              contravariant +semigroups +statevar +tagged,
              any.cpphs ==1.20.9.1,
              cpphs -old-locale,
-             any.cryptohash-sha1 ==0.11.100.1,
+             any.cryptohash-sha1 ==0.11.101.0,
              any.cryptohash-sha256 ==0.11.102.1,
              cryptohash-sha256 -exe +use-cbits,
-             any.data-clist ==0.1.2.3,
+             any.data-clist ==0.2,
              any.data-fix ==0.3.2,
              any.deepseq ==1.4.5.0,
-             any.directory ==1.3.6.1,
+             any.directory ==1.3.6.2,
              any.disk-free-space ==0.1.0.1,
              any.distributive ==0.6.2.1,
              distributive +semigroups +tagged,
@@ -82,50 +82,55 @@ constraints: any.Cabal ==3.6.2.0,
              any.filepath ==1.4.2.1,
              any.free ==5.1.7,
              any.fusion-plugin-types ==0.1.0,
-             any.generic-arbitrary ==0.1.0,
+             any.generic-arbitrary ==0.2.0,
-             any.ghc-bignum ==1.0,
+             any.ghc ==9.0.2,
-             any.ghc-boot-th ==9.0.1,
+             any.ghc-bignum ==1.1,
+             any.ghc-boot ==9.0.2,
+             any.ghc-boot-th ==9.0.2,
              any.ghc-byteorder ==4.11.0.0.10,
+             any.ghc-heap ==9.0.2,
              any.ghc-prim ==0.7.0,
+             any.ghci ==9.0.2,
              any.happy ==1.20.0,
-             any.hashable ==1.3.4.1,
+             any.hashable ==1.4.0.2,
-             hashable +integer-gmp -random-initial-seed,
+             hashable +containers +integer-gmp -random-initial-seed,
              any.haskus-utils-data ==1.4,
              any.haskus-utils-types ==1.5.1,
-             any.haskus-utils-variant ==3.1,
+             any.haskus-utils-variant ==3.2.1,
              any.heaps ==0.4,
-             any.hsc2hs ==0.68.7,
+             any.hpc ==0.6.1.0,
+             any.hsc2hs ==0.68.8,
              hsc2hs -in-ghc-tree,
-             any.hspec ==2.7.10,
+             any.hspec ==2.9.4,
-             any.hspec-core ==2.7.10,
+             any.hspec-core ==2.9.4,
-             any.hspec-discover ==2.7.10,
+             any.hspec-discover ==2.9.4,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
              any.http-io-streams ==0.1.6.0,
              http-io-streams -brotli +fast-xor,
              any.indexed-profunctors ==0.1.1,
-             any.indexed-traversable ==0.1.1,
+             any.indexed-traversable ==0.1.2,
-             any.indexed-traversable-instances ==0.1,
+             any.indexed-traversable-instances ==0.1.1,
              any.integer-logarithms ==1.0.3.1,
              integer-logarithms -check-bounds +integer-gmp,
              any.io-streams ==1.5.2.1,
              io-streams +network -nointeractivetests +zlib,
              any.language-c ==0.9.0.1,
              language-c -allwarnings +iecfpextension +usebytestrings,
-             any.libarchive ==3.0.3.1,
+             any.libarchive ==3.0.3.2,
-             libarchive -cross -low-memory -system-libarchive,
+             libarchive -cross -low-memory +no-exe -system-libarchive,
-             any.libyaml-streamly ==0.2.0,
+             any.libyaml-streamly ==0.2.1,
              libyaml-streamly -no-unicode -system-libyaml,
              any.lockfree-queue ==0.2.3.1,
              any.lzma-static ==5.2.5.4,
-             any.megaparsec ==9.0.1,
+             any.megaparsec ==9.2.0,
              megaparsec -dev,
              any.microlens ==0.4.12.0,
              any.microlens-mtl ==0.2.0.1,
              any.microlens-th ==0.4.3.10,
              any.monad-control ==1.0.3.1,
              any.mtl ==2.2.2,
-             any.network ==3.1.2.5,
+             any.network ==3.1.2.7,
              network -devel,
              any.network-uri ==2.6.4.1,
              any.openssl-streams ==1.2.3.0,
@@ -134,7 +139,7 @@ constraints: any.Cabal ==3.6.2.0,
              optics-core -explicit-generic-labels,
              any.optics-extra ==0.4,
              any.optics-th ==0.4,
-             any.optparse-applicative ==0.16.1.0,
+             any.optparse-applicative ==0.17.0.0,
              optparse-applicative +process,
              any.os-release ==1.0.2.1,
              os-release -devel,
@@ -145,53 +150,56 @@ constraints: any.Cabal ==3.6.2.0,
              any.polyparse ==1.13,
              any.pretty ==1.1.3.6,
              any.pretty-terminal ==0.1.0.0,
-             any.primitive ==0.7.2.0,
+             any.primitive ==0.7.3.0,
-             any.process ==1.6.11.0,
+             any.process ==1.6.13.2,
              any.profunctors ==5.6.2,
              any.quickcheck-arbitrary-adt ==0.3.1.0,
              any.quickcheck-io ==0.2.0,
              any.random ==1.2.1,
-             any.recursion-schemes ==5.2.2.1,
+             any.recursion-schemes ==5.2.2.2,
              recursion-schemes +template-haskell,
-             any.regex-base ==0.94.0.1,
+             any.regex-base ==0.94.0.2,
              any.regex-posix ==0.96.0.1,
              regex-posix -_regex-posix-clib,
              any.resourcet ==1.2.4.3,
              any.retry ==0.8.1.2,
              retry -lib-werror,
-             any.rts ==1.0,
+             any.rts ==1.0.2,
              any.safe ==0.3.19,
              any.safe-exceptions ==0.1.7.2,
              any.scientific ==0.3.7.0,
              scientific -bytestring-builder -integer-simple,
-             any.semialign ==1.2,
+             any.semialign ==1.2.0.1,
              semialign +semigroupoids,
-             any.semigroupoids ==5.3.6,
+             any.semigroupoids ==5.3.7,
              semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
              any.setenv ==0.1.1.3,
              any.split ==0.2.3.4,
-             any.splitmix ==0.1.0.3,
+             any.splitmix ==0.1.0.4,
              splitmix -optimised-mixer,
              any.stm ==2.5.0.0,
-             any.streamly ==0.8.0,
+             any.streamly ==0.8.2,
-             streamly -debug -dev -fusion-plugin -has-llvm -inspection -no-fusion +opt -streamk -use-c-malloc,
+             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc -use-unliftio,
              any.strict ==0.4.0.1,
              strict +assoc,
              any.strict-base ==0.4.0.0,
              any.tagged ==0.8.6.1,
              tagged +deepseq +transformers,
+             any.tagsoup ==0.14.8,
              any.template-haskell ==2.17.0.0,
              any.temporary ==1.3,
              any.terminal-progress-bar ==0.4.1,
              any.terminal-size ==0.3.2.1,
-             any.terminfo ==0.4.1.4,
+             any.terminfo ==0.4.1.5,
-             any.text ==1.2.4.1,
+             any.text ==1.2.5.0,
+             any.text-short ==0.1.5,
+             text-short -asserts,
              any.text-zipper ==0.11,
              any.tf-random ==0.5,
              any.th-abstraction ==0.4.3.0,
              any.th-compat ==0.1.3,
              any.th-lift ==0.8.2,
-             any.th-lift-instances ==0.1.18,
+             any.th-lift-instances ==0.1.19,
              any.these ==1.1.1.1,
              these +assoc,
              any.time ==1.9.3,
@@ -200,14 +208,16 @@ constraints: any.Cabal ==3.6.2.0,
              any.transformers ==0.5.6.2,
              any.transformers-base ==0.4.6,
              transformers-base +orphaninstances,
-             any.transformers-compat ==0.7,
+             any.transformers-compat ==0.7.1,
              transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
+             any.unicode-data ==0.3.0,
+             unicode-data -ucd2haskell,
              any.unix ==2.7.2.2,
-             any.unix-bytestring ==0.3.7.5,
+             any.unix-bytestring ==0.3.7.6,
-             any.unix-compat ==0.5.3,
+             any.unix-compat ==0.5.4,
              unix-compat -old-time,
              any.unliftio-core ==0.2.0.1,
-             any.unordered-containers ==0.2.14.0,
+             any.unordered-containers ==0.2.17.0,
              unordered-containers -debug,
              any.uri-bytestring ==0.3.3.1,
              uri-bytestring -lib-werror,
@@ -215,15 +225,15 @@ constraints: any.Cabal ==3.6.2.0,
              any.uuid-types ==1.0.5,
              any.vector ==0.12.3.1,
              vector +boundschecks -internalchecks -unsafechecks -wall,
-             any.versions ==5.0.0,
+             any.versions ==5.0.3,
              any.vty ==5.33,
              any.witherable ==0.4.2,
              any.word-wrap ==0.5,
              any.word8 ==0.1.3,
-             any.xor ==0.0.1.0,
+             any.xor ==0.0.1.1,
-             any.yaml-streamly ==0.12.0,
+             any.yaml-streamly ==0.12.1,
              yaml-streamly +no-examples +no-exe,
              any.zlib ==0.6.2.3,
              zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
              any.zlib-bindings ==0.1.1.5
-index-state: hackage.haskell.org 2021-10-24T10:21:56Z
+index-state: hackage.haskell.org 2022-03-15T16:43:02Z

cabal.project

@@ -8,6 +8,11 @@ package ghcup
     tests: True
     flags: +tui
 
+source-repository-package
+  type: git
+  location: https://github.com/bgamari/terminal-size.git
+  tag: 34ea816bd63f75f800eedac12c6908c6f3736036
+
 constraints: http-io-streams -brotli,
              any.Cabal ==3.6.2.0,
              any.aeson >= 2.0.1.0

data/config.yaml

@@ -36,6 +36,10 @@ key-bindings:
   show-all-tools:
     KChar: 't'
 
+# The caching for the metadata files containing download info, depending on last access time
+# of the file. These usually are in '~/.ghcup/cache/ghcup-<ver>.yaml'.
+meta-cache: 300 # in seconds
+
 # Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
 # check the 'URLSource' type in the code.
 url-source:
@@ -44,12 +48,16 @@ url-source:
 
   ## Example 1: Read download info from this location instead
   ## Accepts file/http/https scheme
+  ## Can also be an array of URLs or an array of 'Either GHCupInfo URL', in
+  ## which case they are merged right-biased (overwriting duplicate versions).
   # OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
 
-  ## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions
+  ## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions.
+  ## Can also be an array of 'Either GHCupInfo URL', also see Example 3.
   # AddSource:
     # Left:
-      # toolRequirements: {} # this is ignored
+      # globalTools: {}
+      # toolRequirements: {}
       # ghcupDownloads:
         # GHC:
           # 9.10.2:
@@ -62,6 +70,8 @@ url-source:
                     # dlSubdir: ghc-7.10.3
                     # dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
 
-  ## Example 3: Add a custom download file to the default downloads, overwriting duplicate versions
+  ## Example 3: Add multiple custom download files to the default downloads via right-biased merge (overwriting duplicate
+  ## versions).
   # AddSource:
-    # Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
+    # - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
+    # - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"

docs/css/extra.css

@@ -1,5 +1,8 @@
 :root {
   --theme-purple: #5E5184;
+  --theme-purple-dark: rgba(69, 59, 97, 0.5);
+  --ukraine-top: #0057B8;
+  --ukraine-bottom: #FFD700;
   --link-pink: #9E358F;
 }
 
@@ -108,12 +111,12 @@ body.homepage>div.container div.col-md-9 {
 
 .bg-primary {
   background-image: none;
-  background-color: var(--theme-purple) !important;
+  background-color: var(--ukraine-top) !important;
 }
 
 body .bg-primary {
   background-image: none;
-  background-color: var(--theme-purple);
+  background-color: var(--ukraine-top);
   border: 0px;
 }
 
@@ -125,8 +128,8 @@ body .btn-primary {
 
 .navbar.fixed-top {
   background-image: none;
-  background-color: var(--theme-purple);
+  background-color: var(--ukraine-top);
-  border-bottom: 5px solid rgba(69, 59, 97, 0.5);
+  border-bottom: 40px solid var(--ukraine-bottom);
   padding: 0px;
 }
 

docs/dev.md

@@ -12,8 +12,7 @@ organised tree-ish in `GHCup.Utils` and `GHCup.Utils.*`.
 Anything dealing with ghcup specific directories is in
 `GHCup.Utils.Dirs`.
 
-Download information on where to fetch bindists from is in the appropriate
+Download information on where to fetch bindists from is in the [ghcup-metadata](https://github.com/haskell/ghcup-metadata) repository.
-yaml files: `data/metadata/ghcup-<yaml-ver>.yaml`.
 
 ## Design decisions
 
@@ -89,27 +88,33 @@ Every subcommand now lives in its own module under [GHCup.OptParse.MyCommand](ht
 
 # Releasing
 
-1. Update version in `ghcup.cabal` and `boostrap-haskell` (`ghver` variable at the top of the script)
+1. Update version in `ghcup.cabal`
 
 2. Update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `GHCupInfo` type or the YAML representation of it. The version of the YAML represents the change increments. `ghcUpVer` is the current application version, read from `ghcup.cabal`.
 
 3. Add ChangeLog entry
 
-4. Add/fix downloads in `ghcup-<ver>.yaml` ([ghcup-metadata repo](https://github.com/haskell/ghcup-metadata)), then verify with `ghcup-gen check -f ghcup-<ver>.yaml` and possibly (example only) `ghcup-gen check-tarballs -f ghcup-<ver>.yaml -u 'ghc-8.10.7'`. Generally, new GHC/cabal/stack/hls versions are only added to the latest yaml file. New GHCup versions are added to all (great care must be taken here to not break the parser... e.g. ARM platforms don't parse in all older formats).
+4. If a new ghcup yaml version is needed, create one at [ghcup-metadata repo](https://github.com/haskell/ghcup-metadata) and push to a temporary release branch, then update the `data/metadata` submodule in ghcup-hs repo to that branch, so CI can pass
 
 5. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
 
-6. Download release artifacts and upload them `downloads.haskell.org/~ghcup` along with checksum files (`sha256sum --tag * > SHA256SUMS && gpg --detach-sign -u <your-email> SHA256SUMS`)
+6. Download release artifacts and upload them `downloads.haskell.org/~ghcup` along with checksum files (also check `scripts/releasing/pull_release_artifacts.sh` and `scripts/releasing/sftp-upload-artifacts.sh`)
 
-7. Add ghcup release artifacts to ALL yaml files (see point 4.)
+7. Add ghcup release artifacts to ALL yaml files, see [ghcup-metadata repo](https://github.com/haskell/ghcup-metadata)
 
 8. Upload the final `ghcup-<ver>.yaml` (and a detached GPG sig of it) to `webhost.haskell.org/ghcup/data/` (for yaml versions <= 0.0.6) as well as [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata) (for all versions).
 
-9. Upload `bootstrap-haskell` and `bootstrap-haskell.ps1` to `webhost.haskell.org/ghcup/sh/`
+9. Update version in `scripts/bootstrap/bootstrap-haskell` (`ghver` variable at the top of the script)
 
-10. Update the top-level ghcup symlinks at `downloads.haskell.org/~ghcup`
+10. Upload `scripts/bootstrap/bootstrap-haskell` and `scripts/bootstrap/bootstrap-haskell.ps1` to `webhost.haskell.org/ghcup/sh/`
 
-11. Post on reddit/discourse/etc. and collect rewards
+11. Update the top-level ghcup symlinks at `downloads.haskell.org/~ghcup` (see `scripts/releasing/sftp-symlink-artifacts.sh`)
+
+12. Update the `data/metadata` submodule in ghcup-hs repo to master
+
+13. Do hackage release
+
+14. Post on reddit/discourse/etc. and collect rewards
 
 # Documentation
 

docs/guide.md

@@ -32,6 +32,17 @@ ghcup install cabal
 ghcup upgrade
 ```
 
+### Tags and shortcuts
+
+GHCup has a number of tags and version shortcuts, that can be used as arguments to **install**/**set** etc.
+All of the following are valid arguments to `ghcup install ghc`:
+
+* `latest`, `recommended`
+* `base-4.15.1.0`
+* `9.0.2`, `9.0`, `9`
+
+If the argument is omitted, the default is `recommended`.
+
 ## Configuration
 
 A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
@@ -53,6 +64,25 @@ as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
 and make sure your bashrc sources the startup script
 (`/usr/share/bash-completion/bash_completion` on some distros).
 
+## Caching
+
+GHCup has a few caching mechanisms to avoid redownloads. All cached files end up in `~/.ghcup/cache` by default.
+
+### Downloads cache
+
+Downloaded tarballs (such as GHC, cabal, etc.) are not cached by default unless you pass `ghcup --cache` or set caching
+in your [config](#configuration) via `ghcup config set cache true`.
+
+### Metadata cache
+
+The metadata files (also see [github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata))
+have a 5 minutes cache per default depending on the last access time of the file. That means if you run
+`ghcup list` 10 times in a row, only the first time will trigger a download attempt.
+
+### Clearing the cache
+
+If you experience problems, consider clearing the cache via `ghcup gc --cache`.
+
 ## Compiling GHC from source
 
 Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help`
@@ -119,6 +149,31 @@ and produce the binaries `ghc-8.10.2-eff` and `ghc-head` respectively.
 GHCup always needs to know which version the bindist corresponds to (this is not automatically
 detected).
 
+## Mirrors
+
+GHCup allows to use custom mirrors/download-info hosted by yourself or 3rd parties.
+
+To use a mirror, set the following option in `~/.ghcup/config.yaml`:
+
+```yml
+url-source:
+  # Accepts file/http/https scheme
+  OwnSource: "https://some-url/ghcup-0.0.6.yaml"
+```
+
+See [config.yaml](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/data/config.yaml)
+for more options.
+
+Alternatively you can do it via a cli switch:
+
+```sh
+ghcup --url-source=https://some-url/ghcup-0.0.6.yaml list
+```
+
+### Known mirrors
+
+1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup)
+
 ## Isolated installs
 
 Ghcup also enables you to install a tool (GHC, Cabal, HLS, Stack) at an isolated location of your choosing.
@@ -169,66 +224,10 @@ For the full list of env variables and parameters to tweak the script behavior,
 * [bootstrap-haskell for linux/darwin/freebsd](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
 * [bootstrap-haskell.ps1 for windows](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
 
-### Example github workflow
+### github workflows
 
-On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/)
+On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/).
-
+GHCup itself is also pre-installed on all platforms, but may use non-standard install locations.
-If you want to install ghcup manually though, here's an example config:
-
-```yml
-name: Haskell CI
-
-on:
-  push:
-    branches: [ master ]
-  pull_request:
-    branches: [ master ]
-
-jobs:
-  build-cabal:
-
-    runs-on: ${{ matrix.os }}
-    strategy:
-      fail-fast: false
-      matrix:
-        os: [ubuntu-latest, macOS-latest, windows-latest]
-        ghc: ['8.10.7', '9.0.1']
-        cabal: ['3.4.0.0']
-
-    steps:
-    - uses: actions/checkout@v2
-
-    - if: matrix.os == 'windows-latest'
-      name: Install ghcup on windows
-      run: Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
-
-    - if: matrix.os == 'windows-latest'
-      name: Add ghcup to PATH
-      run: echo "/c/ghcup/bin" >> $GITHUB_PATH
-      shell: bash
-
-    - if: matrix.os != 'windows-latest'
-      name: Install ghcup on non-windows
-      run: curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
-
-    - name: Install ghc/cabal
-      run: |
-        ghcup install ghc ${{ matrix.ghc }}
-        ghcup install cabal ${{ matrix.cabal }}
-      shell: bash
-
-    - name: Update cabal index
-      run: cabal update
-      shell: bash
-
-    - name: Build
-      run: cabal build --enable-tests --enable-benchmarks
-      shell: bash
-
-    - name: Run tests
-      run: cabal test
-      shell: bash
-```
 
 ## GPG verification
 
@@ -260,48 +259,14 @@ You can also pass the mode via `ghcup --gpg <strict|lax|none>`.
    
 ## Tips and tricks
 
-### with_ghc wrapper (e.g. for HLS)
+### Execute command with certain GHC in PATH
 
-Due to some HLS [bugs](https://github.com/mpickering/hie-bios/issues/194) it's necessary that the `ghc` in PATH
+If you don't want to explicitly switch the active GHC all the time and are using
-is the one defined in `cabal.project`. With some simple shell functions, we can start our editor with the appropriate
+tools that rely on the plain `ghc` binary, GHCup provides an easy way to execute
-path prepended.
+commands with a certain toolchain prepended to PATH, e.g.:
-
-For bash, in e.g. `~/.bashrc` define:
 
 ```sh
-with_ghc() {
+ghcup run --ghc 8.10.7 --cabal latest --hls latest --stack latest --install -- code Setup.hs
-  local np=$(ghcup --offline whereis -d ghc $1 || { ghcup --cache install ghc $1 && ghcup whereis -d ghc $1 ;})
-  if [ -e "${np}" ] ; then
-    shift
-    PATH="$np:$PATH" "$@"
-  else
-    >&2 echo "Cannot find or install GHC version $1"
-    return 1
-  fi
-}
 ```
 
-For fish shell, in e.g. `~/.config/fish/config.fish` define:
+This will execute vscode with GHC set to 8.10.7 and all other tools to their latest version.
-
-```fish
-function with_ghc
-  set --local np (ghcup --offline whereis -d ghc $argv[1] ; or begin ghcup --cache install ghc $argv[1] ; and ghcup whereis -d ghc $argv[1] ; end)
-  if test -e "$np"
-    PATH="$np:$PATH" $argv[2..-1]
-  else
-    echo "Cannot find or install GHC version $argv[1]" 1>&2
-    return 1
-  end
-end
-```
-
-Then start a new shell and issue:
-
-```sh
-# replace 'code' with your editor
-with_ghc 8.10.5 code path/to/haskell/source
-```
-
-Cabal and HLS will now see `8.10.5` as the primary GHC, without the need to
-run `ghcup set` all the time when switching between projects.
-

docs/install.md

@@ -24,10 +24,20 @@ Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager
 
 If you want to know what these scripts do, check out the [source code at the repository](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries.
 
+### Which versions get installed?
+
+GHCup has two main channels for every tool: **recommended** and **latest**. By default, it installs *recommended*.
+
+*latest* follows the latest release of every tool, while *recommended* is at the discretion of the GHCup maintainers and based on community adoption (hackage libraries, tools like HLS, stackage support, etc.) and known bugs.
+
+Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information.
+
 ## First steps
 
-1. To get started with creating a Haskell project, follow the [Getting Started with Haskell and Cabal](https://cabal.readthedocs.io/en/latest/getting-started.html) guide
+1. To get started with creating a Haskell project, follow the [Getting Started with Haskell and Cabal](https://cabal.readthedocs.io/en/stable/getting-started.html) guide
-2. To properly learn Haskell, run through the [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises
+2. To learn Haskell, try any of those:
+    - A beginner friendly [4-lectures course](https://github.com/haskell-beginners-2022/course-plan) with exercises (by [Kowainik](https://kowainik.github.io/))
+    - An in-depth university [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises (by [Brent Yorgey](https://byorgey.wordpress.com/))
 3. To learn more about Haskell Toolchain management, check out the [ghcup user guide](./guide.md)
 
 ## Uninstallation
@@ -40,10 +50,90 @@ On windows, double-click on the `Uninstall Haskell.ps1` PowerShell script on you
 
 GHCup supports the following tools, which are also known as the **Haskell Toolchain**:
 
-1. [GHC](https://www.haskell.org/ghc/)
+<details>
-2. [cabal-install](https://cabal.readthedocs.io/en/latest/)
+  <summary>Show all supported <a href='https://www.haskell.org/ghc/'>GHC</a> versions</summary>
-3. [haskell-language-server](https://haskell-language-server.readthedocs.io/en/latest/)
+  
-4. [stack](https://docs.haskellstack.org/en/latest/README/)
+<table>
+<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
+<tbody>
+<tr><td>7.10.3</td><td>base-4.8.2.0</td></tr>
+<tr><td>8.0.2</td><td>base-4.9.1.0</td></tr>
+<tr><td>8.2.2</td><td>base-4.10.1.0</td></tr>
+<tr><td>8.4.1</td><td>base-4.11.0.0</td></tr>
+<tr><td>8.4.2</td><td>base-4.11.1.0</td></tr>
+<tr><td>8.4.3</td><td>base-4.11.1.0</td></tr>
+<tr><td>8.4.4</td><td>base-4.11.1.0</td></tr>
+<tr><td>8.6.1</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.6.2</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.6.3</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.6.4</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.6.5</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.8.1</td><td>base-4.13.0.0</td></tr>
+<tr><td>8.8.2</td><td>base-4.13.0.0</td></tr>
+<tr><td>8.8.3</td><td>base-4.13.0.0</td></tr>
+<tr><td>8.8.4</td><td>base-4.13.0.0</td></tr>
+<tr><td>8.10.1</td><td>base-4.14.0.0</td></tr>
+<tr><td>8.10.2</td><td>base-4.14.1.0</td></tr>
+<tr><td>8.10.3</td><td>base-4.14.1.0</td></tr>
+<tr><td>8.10.4</td><td>base-4.14.1.0</td></tr>
+<tr><td>8.10.5</td><td>base-4.14.2.0</td></tr>
+<tr><td>8.10.6</td><td>base-4.14.3.0</td></tr>
+<tr><td>8.10.7</td><td><span style="color:green">recommended</span>, base-4.14.3.0</td></tr>
+<tr><td>9.0.1</td><td>base-4.15.0.0</td></tr>
+<tr><td>9.0.2</td><td>base-4.15.1.0</td></tr>
+<tr><td>9.2.1</td><td>base-4.16.0.0</td></tr>
+<tr><td>9.2.2</td><td><span style="color:blue">latest</span>, base-4.16.1.0</td></tr>
+</tbody>
+</table>
+
+</details>
+
+<details>
+  <summary>Show all supported <a href='https://cabal.readthedocs.io/en/stable/'>cabal-install</a> versions</summary>
+  <table>
+<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
+<tbody>
+<tr><td>2.4.1.0</td><td></td></tr>
+<tr><td>3.0.0.0</td><td></td></tr>
+<tr><td>3.2.0.0</td><td></td></tr>
+<tr><td>3.4.0.0</td><td></td></tr>
+<tr><td>3.4.1.0</td><td></td></tr>
+<tr><td>3.6.0.0</td><td></td></tr>
+<tr><td>3.6.2.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+</tbody>
+</table>
+
+</details>
+
+<details>
+  <summary>Show all supported <a href='https://haskell-language-server.readthedocs.io/en/stable/'>HLS</a> versions</summary>
+<table>
+<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
+<tbody>
+<tr><td>1.1.0</td><td></td></tr>
+<tr><td>1.2.0</td><td></td></tr>
+<tr><td>1.3.0</td><td></td></tr>
+<tr><td>1.4.0</td><td></td></tr>
+<tr><td>1.5.0</td><td></td></tr>
+<tr><td>1.5.1</td><td></td></tr>
+<tr><td>1.6.0.0</td><td></td></tr>
+<tr><td>1.6.1.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+</tbody>
+</table>
+</details>
+
+<details>
+  <summary>Show all supported <a href='https://docs.haskellstack.org/en/stable/README/'>Stack</a> versions</summary>
+<table>
+<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
+<tbody>
+<tr><td>2.5.1</td><td></td></tr>
+<tr><td>2.7.1</td><td></td></tr>
+<tr><td>2.7.3</td><td></td></tr>
+<tr><td>2.7.5</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+</tbody>
+</table>
+</details>
 
 ## Supported platforms
 
@@ -78,14 +168,15 @@ May or may not work, several issues:
 
 Unsupported. GHC may or may not work. Upgrade to WSL2.
 
-### MacOS <13
+### MacOS <10.13
 
-Not supported. Would require separate binaries, since >=13 binaries are incompatible.
+Not supported. Would require separate binaries, since >=10.13 binaries are incompatible.
 Please upgrade.
 
 ### MacOS aarch64
 
-HLS bindists are still experimental. Stack is theoretically supported, but has no binaries yet.
+HLS bindists are still experimental. Stack has only unofficial binaries for this platform.
+There are various issues with GHC itself.
 
 ### FreeBSD
 
@@ -94,7 +185,7 @@ HLS bindists are experimental.
 
 ### Linux ARMv7/AARCH64
 
-Lower availability of bindists. HLS only has experimental ones. Stack not supported currently.
+Lower availability of bindists. Stack and HLS binaries are experimental.
 
 ## Manual install
 

ghcup.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               ghcup
-version:            0.1.17.3
+version:            0.1.17.6
 license:            LGPL-3.0-only
 license-file:       LICENSE
 copyright:          Julian Ospald 2020
@@ -43,6 +43,18 @@ flag internal-downloader
   default:     False
   manual:      True
 
+flag no-exe
+  description: Don't build any executables 
+  default:     False
+  manual:      True
+
+flag disable-upgrade
+  description:
+    Disable upgrade functionality. This is mainly to support brew packagers.
+
+  default:     False
+  manual:      True
+
 library
   exposed-modules:
     GHCup
@@ -53,6 +65,7 @@ library
     GHCup.Requirements
     GHCup.Types
     GHCup.Types.JSON
+    GHCup.Types.JSON.Utils
     GHCup.Types.Optics
     GHCup.Utils
     GHCup.Utils.Dirs
@@ -91,7 +104,7 @@ library
   build-depends:
     , aeson                 >=1.4
     , async                 >=0.8        && <2.3
-    , base                  >=4.13       && <5
+    , base                  >=4.12       && <5
     , base16-bytestring     >=0.1.1.6    && <1.1
     , binary                ^>=0.8.6.0
     , bytestring            ^>=0.10
@@ -105,10 +118,10 @@ library
     , disk-free-space       ^>=0.1.0.1
     , filepath              ^>=1.4.2.1
     , haskus-utils-types    ^>=1.5
-    , haskus-utils-variant  >=3.0        && <3.2
+    , haskus-utils-variant  ^>=3.2.1
     , libarchive            ^>=3.0.3.0
     , lzma-static           ^>=5.2.5.3
-    , megaparsec            >=8.0.0      && <9.1
+    , megaparsec            >=8.0.0      && <9.3
     , mtl                   ^>=2.2
     , optics                ^>=0.4
     , os-release            ^>=1.0.0
@@ -161,11 +174,10 @@ library
       GHCup.Utils.File.Posix
       GHCup.Utils.Posix
       GHCup.Utils.Prelude.Posix
-      System.Console.Terminal.Common
-      System.Console.Terminal.Posix
 
     build-depends:
       , bz2              >=0.5.0.5 && <1.1
+      , terminal-size    ^>=0.3.2.1
       , unix             ^>=2.7
       , unix-bytestring  ^>=0.3.7.3
 
@@ -188,10 +200,10 @@ executable ghcup
     GHCup.OptParse.Nuke
     GHCup.OptParse.Prefetch
     GHCup.OptParse.Rm
+    GHCup.OptParse.Run
     GHCup.OptParse.Set
     GHCup.OptParse.ToolRequirements
     GHCup.OptParse.UnSet
-    GHCup.OptParse.Upgrade
     GHCup.OptParse.Whereis
 
   hs-source-dirs:     app/ghcup
@@ -214,27 +226,33 @@ executable ghcup
     , aeson                 >=1.4
     , aeson-pretty          ^>=0.8.8
     , async                 ^>=2.2.3
-    , base                  >=4.13     && <5
+    , base                  >=4.12     && <5
     , bytestring            ^>=0.10
     , cabal-plan            ^>=0.7.2
     , containers            ^>=0.6
     , deepseq               ^>=1.4
+    , directory             ^>=1.3.6.0
     , filepath              ^>=1.4.2.1
     , ghcup
-    , haskus-utils-variant  >=3.0      && <3.2
+    , haskus-utils-variant  ^>=3.2.1
     , libarchive            ^>=3.0.3.0
-    , megaparsec            >=8.0.0    && <9.1
+    , megaparsec            >=8.0.0    && <9.3
     , mtl                   ^>=2.2
-    , optparse-applicative  >=0.15.1.0 && <0.17
+    , optparse-applicative  >=0.15.1.0 && <0.18
     , pretty                ^>=1.1.3.1
     , pretty-terminal       ^>=0.1.0.0
+    , process               ^>=1.6.11.0
     , resourcet             ^>=1.2.2
     , safe                  ^>=0.3.18
     , safe-exceptions       ^>=0.1
+    , tagsoup               ^>=0.14
     , template-haskell      >=2.7      && <2.18
+    , temporary             ^>=1.3
     , text                  ^>=1.2.4.0
+    , unordered-containers  ^>=0.2
     , uri-bytestring        ^>=0.3.2.2
     , utf8-string           ^>=1.0
+    , vector                ^>=0.12
     , versions              >=4.0.1    && <5.1
     , yaml-streamly         ^>=0.12.0
 
@@ -247,56 +265,23 @@ executable ghcup
     build-depends:
       , brick         ^>=0.64
       , transformers  ^>=0.5
-      , vector        ^>=0.12
+      , unix          ^>=2.7
       , vty           >=5.28.2 && <5.34
 
   if os(windows)
     cpp-options: -DIS_WINDOWS
 
-executable ghcup-gen
+  else
-  main-is:            Main.hs
+    build-depends: unix ^>=2.7
-  hs-source-dirs:     app/ghcup-gen
-  other-modules:      Validate
-  default-language:   Haskell2010
-  default-extensions:
-    DeriveGeneric
-    LambdaCase
-    MultiWayIf
-    NamedFieldPuns
-    PackageImports
-    QuasiQuotes
-    RecordWildCards
-    ScopedTypeVariables
-    StrictData
-    TupleSections
-    TypeApplications
-    TypeFamilies
-    ViewPatterns
 
-  ghc-options:
+  if flag(no-exe)
-    -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
+    buildable: False
-    -fwarn-incomplete-record-updates -threaded
 
-  build-depends:
+  if flag(disable-upgrade)
-    , base                  >=4.13     && <5
+    cpp-options: -DDISABLE_UPGRADE
-    , bytestring            ^>=0.10
+
-    , containers            ^>=0.6
+  else
-    , filepath              ^>=1.4.2.1
+    other-modules: GHCup.OptParse.Upgrade
-    , ghcup
-    , haskus-utils-variant  >=3.0      && <3.2
-    , libarchive            ^>=3.0.3.0
-    , mtl                   ^>=2.2
-    , optics                ^>=0.4
-    , optparse-applicative  >=0.15.1.0 && <0.17
-    , pretty                ^>=1.1.3.1
-    , pretty-terminal       ^>=0.1.0.0
-    , regex-posix           ^>=0.96
-    , resourcet             ^>=1.2.2
-    , safe-exceptions       ^>=0.1
-    , text                  ^>=1.2.4.0
-    , transformers          ^>=0.5
-    , versions              >=4.0.1    && <5.1
-    , yaml-streamly         ^>=0.12.0
 
 test-suite ghcup-test
   type:               exitcode-stdio-1.0
@@ -322,12 +307,12 @@ test-suite ghcup-test
     -fwarn-incomplete-record-updates
 
   build-depends:
-    , base                      >=4.13    && <5
+    , base                      >=4.12    && <5
     , bytestring                ^>=0.10
     , containers                ^>=0.6
-    , generic-arbitrary         ^>=0.1.0
+    , generic-arbitrary         >=0.1.0   && <0.3
     , ghcup
-    , hspec                     ^>=2.7.10
+    , hspec                     >=2.7.10  && <2.10
     , hspec-golden-aeson        ^>=0.9
     , QuickCheck                ^>=2.14.1
     , quickcheck-arbitrary-adt  ^>=0.3.1.0

hie.yaml

@@ -4,7 +4,5 @@ cradle:
     path: ./lib
   - component: "ghcup:exe:ghcup"
     path: ./app/ghcup
-  - component: "ghcup:exe:ghcup-gen"
-    path: "./app/ghcup-gen"
   - component: "ghcup:test:ghcup-test"
     path: ./test

lib/GHCup.hs

@@ -5,8 +5,8 @@
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE TemplateHaskell       #-}
 
 {-|
 Module      : GHCup
@@ -62,7 +62,7 @@ import           Data.String                    ( fromString )
 import           Data.Text                      ( Text )
 import           Data.Time.Clock
 import           Data.Time.Format.ISO8601
-import           Data.Versions
+import           Data.Versions                hiding ( patch )
 import           Distribution.Types.Version   hiding ( Version )
 import           Distribution.Types.PackageId
 import           Distribution.Types.PackageDescription
@@ -84,6 +84,7 @@ import           System.IO.Error
 import           System.IO.Temp
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           Text.Regex.Posix
+import           URI.ByteString
 
 import qualified Crypto.Hash.SHA256            as SHA256
 import qualified Data.List.NonEmpty            as NE
@@ -300,22 +301,6 @@ installPackedGHC dl msubdir inst ver forceInstall = do
   liftE $ runBuildAction tmpUnpack
                          (Just inst)
                          (installUnpackedGHC workdir inst ver)
- where
-  -- | Does basic checks for isolated installs
-  -- Isolated Directory:
-  --   1. if it doesn't exist -> proceed
-  --   2. if it exists and is empty -> proceed
-  --   3. if it exists and is non-empty -> panic and leave the house
-  installDestSanityCheck :: ( MonadIO m
-                            , MonadCatch m
-                            ) =>
-                            FilePath ->
-                            Excepts '[DirNotEmpty] m ()
-  installDestSanityCheck isoDir = do
-    hideErrorDef [doesNotExistErrorType] () $ do
-      contents <- liftIO $ getDirectoryContentsRecursive isoDir
-      unless (null contents) (throwE $ DirNotEmpty isoDir)
-
 
 
 -- | Install an unpacked GHC distribution. This only deals with the GHC
@@ -483,10 +468,6 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do
     Nothing -> do                 -- regular install
       liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall
 
-      -- create symlink if this is the latest version for regular installs
-      cVers <- lift $ fmap rights getInstalledCabals
-      let lInstCabal = headMay . reverse . sort $ cVers
-      when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
       
 -- | Install an unpacked cabal distribution.Symbol
 installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
@@ -581,6 +562,8 @@ installHLSBindist :: ( MonadMask m
                         , TarDirDoesNotExist
                         , ArchiveResult
                         , FileAlreadyExistsError
+                        , ProcessError
+                        , DirNotEmpty
                         ]
                        m
                        ()
@@ -616,26 +599,54 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
 
   -- the subdir of the archive where we do the work
   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
+  legacy <- liftIO $ isLegacyHLSBindist workdir
+
+  if
+    | not forceInstall
+    , not legacy
+    , (Just fp) <- isoFilepath -> liftE $ installDestSanityCheck fp
+    | otherwise -> pure ()
 
   case isoFilepath of
     Just isoDir -> do
       lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
-      liftE $ installHLSUnpacked workdir isoDir Nothing forceInstall
+      if legacy
+      then liftE $ installHLSUnpackedLegacy workdir isoDir Nothing forceInstall
+      else liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir isoDir ver
 
     Nothing -> do
-      liftE $ installHLSUnpacked workdir binDir (Just ver) forceInstall
+      if legacy
+      then liftE $ installHLSUnpackedLegacy workdir binDir (Just ver) forceInstall
+      else do
+        inst <- ghcupHLSDir ver
+        liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir inst ver
+        liftE $ setHLS ver SetHLS_XYZ Nothing
 
-  liftE $ installHLSPostInst isoFilepath ver
 
+isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
+                   -> IO Bool
+isLegacyHLSBindist path = do
+  not <$> doesFileExist (path </> "GNUmakefile")
 
 -- | Install an unpacked hls distribution.
-installHLSUnpacked :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
+installHLSUnpacked :: (MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m, HasLog env, HasDirs env, HasSettings env, MonadCatch m, MonadIO m)
-              => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
+                   => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
-              -> FilePath      -- ^ Path to install to
+                   -> FilePath      -- ^ Path to install to
-              -> Maybe Version -- ^ Nothing for isolated install
+                   -> Version
-              -> Bool          -- ^ is it a force install
+                   -> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m ()
-              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
+installHLSUnpacked path inst _ = do
-installHLSUnpacked path inst mver' forceInstall = do
+  lift $ logInfo "Installing HLS"
+  liftIO $ createDirRecursive' inst
+  lEM $ make ["PREFIX=" <> inst, "install"] (Just path)
+
+-- | Install an unpacked hls distribution (legacy).
+installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
+                         => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
+                         -> FilePath      -- ^ Path to install to
+                         -> Maybe Version -- ^ Nothing for isolated install
+                         -> Bool          -- ^ is it a force install
+                         -> Excepts '[CopyError, FileAlreadyExistsError] m ()
+installHLSUnpackedLegacy path inst mver' forceInstall = do
   lift $ logInfo "Installing HLS"
   liftIO $ createDirRecursive' inst
 
@@ -680,19 +691,6 @@ installHLSUnpacked path inst mver' forceInstall = do
   lift $ chmod_755 destWrapperPath
 
 
-installHLSPostInst :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m, MonadCatch m, MonadMask m, MonadFail m, MonadUnliftIO m)
-                   => Maybe FilePath
-                   -> Version
-                   -> Excepts '[NotInstalled] m ()
-installHLSPostInst isoFilepath ver = 
-  case isoFilepath of
-    Just _ -> pure ()
-    Nothing -> do
-      -- create symlink if this is the latest version in a regular install
-      hlsVers <- lift $ fmap rights getInstalledHLSs
-      let lInstHLS = headMay . reverse . sort $ hlsVers
-      when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
-
 
 -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
 -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
@@ -724,6 +722,8 @@ installHLSBin :: ( MonadMask m
                     , TarDirDoesNotExist
                     , ArchiveResult
                     , FileAlreadyExistsError
+                    , ProcessError
+                    , DirNotEmpty
                     ]
                    m
                    ()
@@ -750,9 +750,10 @@ compileHLS :: ( MonadMask m
            -> Maybe Int
            -> Maybe Version
            -> Maybe FilePath
-           -> Maybe FilePath
+           -> Maybe (Either FilePath URI)
-           -> Maybe FilePath
+           -> Maybe URI
-           -> Maybe FilePath
+           -> Maybe (Either FilePath [URI])  -- ^ patches
+           -> [Text]                   -- ^ additional args to cabal install
            -> Excepts '[ NoDownload
                        , GPGError
                        , DownloadFailed
@@ -763,11 +764,12 @@ compileHLS :: ( MonadMask m
                        , BuildFailed
                        , NotInstalled
                        ] m Version
-compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patchdir = do
+compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patches cabalArgs = do
   PlatformRequest { .. } <- lift getPlatformReq
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   Dirs { .. } <- lift getDirs
 
+
   (workdir, tver) <- case targetHLS of
     -- unpack from version tarball
     Left tver -> do
@@ -834,48 +836,51 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
   liftE $ runBuildAction
     workdir
     Nothing
-    (reThrowAll @_ @'[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do
+    (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do
       let installDir = workdir </> "out"
       liftIO $ createDirRecursive' installDir
 
       -- apply patches
-      forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
+      liftE $ applyAnyPatch patches workdir
 
       -- set up project files
       cp <- case cabalProject of
-        Just cp
+        Just (Left cp)
           | isAbsolute cp -> do
               copyFileE cp (workdir </> "cabal.project")
               pure "cabal.project"
           | otherwise -> pure (takeFileName cp)
+        Just (Right uri) -> do
+          tmpUnpack <- lift withGHCupTmpDir
+          cp <- liftE $ download uri Nothing Nothing tmpUnpack (Just "cabal.project") False
+          copyFileE cp (workdir </> "cabal.project")
+          pure "cabal.project"
         Nothing -> pure "cabal.project"
-      forM_ cabalProjectLocal $ \cpl -> copyFileE cpl (workdir </> cp <.> "local")
+      forM_ cabalProjectLocal $ \uri -> do
-
+        tmpUnpack <- lift withGHCupTmpDir
-      let targets = ["exe:haskell-language-server", "exe:haskell-language-server-wrapper"]
+        cpl <- liftE $ download uri Nothing Nothing tmpUnpack (Just (cp <.> "local")) False
-
+        copyFileE cpl (workdir </> cp <.> "local")
       artifacts <- forM (sort ghcs) $ \ghc -> do
         let ghcInstallDir = installDir </> T.unpack (prettyVer ghc)
-        liftIO $ createDirRecursive' ghcInstallDir
+        liftIO $ createDirRecursive' installDir
         lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
         liftE $ lEM @_ @'[ProcessError] $
-          execLogged "cabal" ( [ "v2-build"
+          execLogged "cabal" ( [ "v2-install"
                                , "-w"
                                , "ghc-" <> T.unpack (prettyVer ghc)
+                               , "--install-method=copy"
                                ] ++
                                maybe [] (\j -> ["--jobs=" <> show j]) jobs ++
-                               [ "--project-file=" <> cp
+                               [ "--overwrite-policy=always"
-                               ] ++ targets
+                               , "--disable-profiling"
+                               , "--disable-tests"
+                               , "--installdir=" <> ghcInstallDir
+                               , "--project-file=" <> cp
+                               ] ++ fmap T.unpack cabalArgs ++ [
+                                 "exe:haskell-language-server"
+                               , "exe:haskell-language-server-wrapper"]
                              )
           (Just workdir) "cabal" Nothing
-        forM_ targets $ \target -> do
-          let cabal = "cabal"
-              args = ["list-bin", target]
-          CapturedProcess{..} <- lift $ executeOut cabal args  (Just workdir) 
-          case _exitCode of
-            ExitFailure i -> throwE (NonZeroExit i cabal args)
-            _ -> pure ()
-          let cbin = stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
-          copyFileE cbin (ghcInstallDir </> takeFileName cbin)
         pure ghcInstallDir
 
       forM_ artifacts $ \artifact -> do
@@ -888,13 +893,11 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
       case isolateDir of
         Just isoDir -> do
           lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
-          liftE $ installHLSUnpacked installDir isoDir Nothing True
+          liftE $ installHLSUnpackedLegacy installDir isoDir Nothing True
         Nothing -> do
-          liftE $ installHLSUnpacked installDir binDir (Just installVer) True
+          liftE $ installHLSUnpackedLegacy installDir binDir (Just installVer) True
     )
 
-  liftE $ installHLSPostInst isolateDir installVer
-
   pure installVer
 
 
@@ -1011,11 +1014,6 @@ installStackBindist dlinfo ver isoFilepath forceInstall = do
     Nothing -> do                     -- regular install
       liftE $ installStackUnpacked workdir binDir (Just ver) forceInstall
 
-      -- create symlink if this is the latest version and a regular install
-      sVers <- lift $ fmap rights getInstalledStacks
-      let lInstStack = headMay . reverse . sort $ sVers
-      when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
-
 
 -- | Install an unpacked stack distribution.
 installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
@@ -1069,22 +1067,29 @@ setGHC :: ( MonadReader env m
           )
        => GHCTargetVersion
        -> SetGHC
+       -> Maybe FilePath  -- if set, signals that we're not operating in ~/.ghcup/bin
+                          -- and don't want mess with other versions
        -> Excepts '[NotInstalled] m GHCTargetVersion
-setGHC ver sghc = do
+setGHC ver sghc mBinDir = do
   let verS = T.unpack $ prettyVer (_tvVersion ver)
   ghcdir                        <- lift $ ghcupGHCDir ver
 
   whenM (lift $ not <$> ghcInstalled ver) (throwE (NotInstalled GHC ver))
 
   -- symlink destination
-  Dirs {..} <- lift getDirs
+  binDir <- case mBinDir of
+    Just x -> pure x
+    Nothing -> do
+      Dirs {binDir = f} <- lift getDirs
+      pure f
 
   -- first delete the old symlinks (this fixes compatibility issues
   -- with old ghcup)
-  case sghc of
+  when (isNothing mBinDir) $
-    SetGHCOnly -> liftE $ rmPlain (_tvTarget ver)
+    case sghc of
-    SetGHC_XY  -> liftE $ rmMajorSymlinks ver
+      SetGHCOnly -> liftE $ rmPlainGHC (_tvTarget ver)
-    SetGHC_XYZ -> liftE $ rmMinorSymlinks ver
+      SetGHC_XY  -> liftE $ rmMajorGHCSymlinks ver
+      SetGHC_XYZ -> liftE $ rmMinorGHCSymlinks ver
 
   -- for ghc tools (ghc, ghci, haddock, ...)
   verfiles <- ghcToolFiles ver
@@ -1102,16 +1107,18 @@ setGHC ver sghc = do
         pure $ Just (file <> "-" <> verS)
 
     -- create symlink
-    forM mTargetFile $ \targetFile -> do
+    forM_ mTargetFile $ \targetFile -> do
+      bindir <- ghcInternalBinDir ver
       let fullF = binDir </> targetFile  <> exeExt
-          fileWithExt = file <> exeExt
+          fileWithExt = bindir </> file <> exeExt
-      destL <- lift $ ghcLinkDestination fileWithExt ver
+      destL <- binarySymLinkDestination binDir fileWithExt
       lift $ createLink destL fullF
 
-  -- create symlink for share dir
+  when (isNothing mBinDir) $ do
-  when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS
+    -- create symlink for share dir
+    when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS
 
-  when (sghc == SetGHCOnly) $ lift warnAboutHlsCompatibility
+    when (sghc == SetGHCOnly) $ lift warnAboutHlsCompatibility
 
   pure ver
 
@@ -1164,7 +1171,7 @@ unsetGHC :: ( MonadReader env m
             )
          => Maybe Text
          -> Excepts '[NotInstalled] m ()
-unsetGHC = rmPlain
+unsetGHC = rmPlainGHC
 
 
 -- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
@@ -1216,35 +1223,60 @@ setHLS :: ( MonadReader env m
           , MonadUnliftIO m
           )
        => Version
+       -> SetHLS -- Nothing for legacy
+       -> Maybe FilePath  -- if set, signals that we're not operating in ~/.ghcup/bin
+                          -- and don't want mess with other versions
        -> Excepts '[NotInstalled] m ()
-setHLS ver = do
+setHLS ver shls mBinDir = do
-  Dirs {..} <- lift getDirs
+  whenM (lift $ not <$> hlsInstalled ver) (throwE (NotInstalled HLS (GHCTargetVersion Nothing ver)))
 
-  -- Delete old symlinks, since these might have different ghc versions than the
+  -- symlink destination
-  -- selected version, so we could end up with stray or incorrect symlinks.
+  binDir <- case mBinDir of
-  oldSyms <- lift hlsSymlinks
+    Just x -> pure x
-  forM_ oldSyms $ \f -> do
+    Nothing -> do
-    lift $ logDebug $ "rm " <> T.pack (binDir </> f)
+      Dirs {binDir = f} <- lift getDirs
-    lift $ rmLink (binDir </> f)
+      pure f
 
-  -- set haskell-language-server-<ghcver> symlinks
+  -- first delete the old symlinks
-  bins <- lift $ hlsServerBinaries ver Nothing
+  when (isNothing mBinDir) $
-  when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
+    case shls of
+      -- not for legacy
+      SetHLS_XYZ -> liftE $ rmMinorHLSSymlinks ver
+      -- legacy and new
+      SetHLSOnly -> liftE rmPlainHLS
 
-  forM_ bins $ \f -> do
+  case shls of
-    let destL = f
+    -- not for legacy
-    let target = (<> exeExt) . head . splitOn "~" $ f
+    SetHLS_XYZ -> do
-    lift $ createLink destL (binDir </> target)
+      bins <- lift $ hlsInternalServerScripts ver Nothing
 
-  -- set haskell-language-server-wrapper symlink
+      forM_ bins $ \f -> do
-  let destL = "haskell-language-server-wrapper-" <> T.unpack (prettyVer ver) <> exeExt
+        let fname = takeFileName f
-  let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
+        destL <- binarySymLinkDestination binDir f
+        let target = if "haskell-language-server-wrapper" `isPrefixOf` fname
+                     then fname <> "-" <> T.unpack (prettyVer ver) <> exeExt
+                     else fname <> "~" <> T.unpack (prettyVer ver) <> exeExt
+        lift $ createLink destL (binDir </> target)
 
-  lift $ createLink destL wrapper
+    -- legacy and new
+    SetHLSOnly -> do
+      -- set haskell-language-server-<ghcver> symlinks
+      bins <- lift $ hlsServerBinaries ver Nothing
+      when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
 
-  lift warnAboutHlsCompatibility
+      forM_ bins $ \f -> do
+        let destL = f
+        let target = (<> exeExt) . head . splitOn "~" $ f
+        lift $ createLink destL (binDir </> target)
 
-  pure ()
+      -- set haskell-language-server-wrapper symlink
+      let destL = "haskell-language-server-wrapper-" <> T.unpack (prettyVer ver) <> exeExt
+      let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
+
+      lift $ createLink destL wrapper
+
+      when (isNothing mBinDir) $
+        lift warnAboutHlsCompatibility
 
 
 unsetHLS :: ( MonadMask m
@@ -1574,7 +1606,7 @@ listVersions lt' criteria = do
 
   currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
   currentGHCup av =
-    let currentVer = fromJust $ pvpToVersion ghcUpVer
+    let currentVer = fromJust $ pvpToVersion ghcUpVer ""
         listVer    = Map.lookup currentVer av
         latestVer  = fst <$> headOf (getTagged Latest) av
         recommendedVer = fst <$> headOf (getTagged Latest) av
@@ -1714,14 +1746,14 @@ rmGHCVer ver = do
   -- this isn't atomic, order matters
   when isSetGHC $ do
     lift $ logInfo "Removing ghc symlinks"
-    liftE $ rmPlain (_tvTarget ver)
+    liftE $ rmPlainGHC (_tvTarget ver)
 
   lift $ logInfo "Removing ghc-x.y.z symlinks"
-  liftE $ rmMinorSymlinks ver
+  liftE $ rmMinorGHCSymlinks ver
 
   lift $ logInfo "Removing/rewiring ghc-x.y symlinks"
   -- first remove
-  handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
+  handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorGHCSymlinks ver
   -- then fix them (e.g. with an earlier version)
 
   lift $ logInfo $ "Removing directory recursively: " <> T.pack dir
@@ -1733,7 +1765,7 @@ rmGHCVer ver = do
     $ fmap Just
     $ getMajorMinorV (_tvVersion ver)
   forM_ v' $ \(mj, mi) -> lift (getGHCForPVP (PVP (fromIntegral mj :| [fromIntegral mi])) (_tvTarget ver))
-    >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
+    >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY Nothing)
 
   Dirs {..} <- lift getDirs
 
@@ -1788,24 +1820,19 @@ rmHLSVer :: ( MonadMask m
 rmHLSVer ver = do
   whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver))
 
-  isHlsSet      <- lift hlsSet
+  isHlsSet <- lift hlsSet
 
-  Dirs {..} <- lift getDirs
+  liftE $ rmMinorHLSSymlinks ver
-
+  hlsDir <- ghcupHLSDir ver
-  bins <- lift $ hlsAllBinaries ver
+  recyclePathForcibly hlsDir
-  forM_ bins $ \f -> lift $ recycleFile (binDir </> f)
 
   when (Just ver == isHlsSet) $ do
     -- delete all set symlinks
-    oldSyms <- lift hlsSymlinks
+    rmPlainHLS
-    forM_ oldSyms $ \f -> do
-      let fullF = binDir </> f
-      lift $ logDebug $ "rm " <> T.pack fullF
-      lift $ rmLink fullF
     -- set latest hls
     hlsVers <- lift $ fmap rights getInstalledHLSs
     case headMay . reverse . sort $ hlsVers of
-      Just latestver -> setHLS latestver
+      Just latestver -> setHLS latestver SetHLSOnly Nothing
       Nothing        -> pure ()
 
 
@@ -2090,7 +2117,7 @@ compileGHC :: ( MonadMask m
            -> Either Version FilePath  -- ^ version to bootstrap with
            -> Maybe Int                -- ^ jobs
            -> Maybe FilePath           -- ^ build config
-           -> Maybe FilePath           -- ^ patch directory
+           -> Maybe (Either FilePath [URI])  -- ^ patches
            -> [Text]                   -- ^ additional args to ./configure
            -> Maybe String             -- ^ build flavour
            -> Bool
@@ -2119,7 +2146,7 @@ compileGHC :: ( MonadMask m
                  ]
                 m
                 GHCTargetVersion
-compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian isolateDir
+compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian isolateDir
   = do
     PlatformRequest { .. } <- lift getPlatformReq
     GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -2143,7 +2170,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
         workdir <- maybe (pure tmpUnpack)
                          (liftE . intoSubdir tmpUnpack)
                          (view dlSubdir dlInfo)
-        forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
+        liftE $ applyAnyPatch patches workdir
 
         pure (workdir, tmpUnpack, tver)
 
@@ -2151,7 +2178,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
       Right GitBranch{..} -> do
         tmpUnpack <- lift mkGhcupTmpDir
         let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
-        tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH] DownloadFailed $ do
+        tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] DownloadFailed $ do
           let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
           lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
           lEM $ git [ "init" ]
@@ -2171,7 +2198,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
 
           lEM $ git [ "checkout", "FETCH_HEAD" ]
           lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
-          forM_ patchdir (\dir -> liftE $ applyPatches dir tmpUnpack)
+          liftE $ applyAnyPatch patches tmpUnpack
           lEM $ execWithGhcEnv "python3" ["./boot"] (Just tmpUnpack) "ghc-bootstrap"
           lEM $ execWithGhcEnv "sh" ["./configure"] (Just tmpUnpack) "ghc-bootstrap"
           CapturedProcess {..} <- lift $ makeOut
@@ -2239,7 +2266,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
       Nothing -> do
         reThrowAll GHCupSetError $ postGHCInstall installVer
         -- restore
-        when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly
+        when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly Nothing
         
       _ -> pure ()
 
@@ -2505,6 +2532,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
   execWithGhcEnv :: ( MonadReader env m
                     , HasSettings env
                     , HasDirs env
+                    , HasLog env
                     , MonadIO m
                     , MonadThrow m)
                  => FilePath         -- ^ thing to execute
@@ -2576,7 +2604,7 @@ upgradeGHCup mtarget force' = do
 
   lift $ logInfo "Upgrading GHCup..."
   let latestVer = fromJust $ fst <$> getLatest dls GHCup
-  (Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer
+  (Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
   when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
   dli   <- liftE $ getDownloadInfo GHCup latestVer
   tmp   <- lift withGHCupTmpDir
@@ -2632,7 +2660,7 @@ postGHCInstall :: ( MonadReader env m
                => GHCTargetVersion
                -> Excepts '[NotInstalled] m ()
 postGHCInstall ver@GHCTargetVersion {..} = do
-  void $ liftE $ setGHC ver SetGHC_XYZ
+  void $ liftE $ setGHC ver SetGHC_XYZ Nothing
 
   -- Create ghc-x.y symlinks. This may not be the current
   -- version, create it regardless.
@@ -2641,7 +2669,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
     $ fmap Just
     $ getMajorMinorV _tvVersion
   forM_ v' $ \(mj, mi) -> lift (getGHCForPVP (PVP (fromIntegral mj :| [fromIntegral mi])) _tvTarget)
-    >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
+    >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY Nothing)
 
 
 -- | Reports the binary location of a given tool:
@@ -2680,7 +2708,11 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
     HLS -> do
       whenM (lift $ fmap not $ hlsInstalled _tvVersion)
         $ throwE (NotInstalled HLS (GHCTargetVersion Nothing _tvVersion))
-      pure (binDir dirs </> "haskell-language-server-wrapper-" <> T.unpack (prettyVer _tvVersion) <> exeExt)
+      ifM (lift $ isLegacyHLS _tvVersion)
+        (pure (binDir dirs </> "haskell-language-server-wrapper-" <> T.unpack (prettyVer _tvVersion) <> exeExt))
+        $ do
+          bdir <- lift $ ghcupHLSDir _tvVersion
+          pure (bdir </> "bin" </> "haskell-language-server-wrapper" <> exeExt)
 
     Stack -> do
       whenM (lift $ fmap not $ stackInstalled _tvVersion)
@@ -2698,13 +2730,21 @@ checkIfToolInstalled :: ( MonadIO m
                         Tool ->
                         Version ->
                         m Bool
+checkIfToolInstalled tool ver = checkIfToolInstalled' tool (mkTVer ver)
 
-checkIfToolInstalled tool ver =
+checkIfToolInstalled' :: ( MonadIO m
+                         , MonadReader env m
+                         , HasDirs env
+                         , MonadCatch m) =>
+                        Tool ->
+                        GHCTargetVersion ->
+                        m Bool
+checkIfToolInstalled' tool ver =
   case tool of
-    Cabal -> cabalInstalled ver
+    Cabal -> cabalInstalled (_tvVersion ver)
-    HLS   -> hlsInstalled ver
+    HLS   -> hlsInstalled (_tvVersion ver)
-    Stack -> stackInstalled ver
+    Stack -> stackInstalled (_tvVersion ver)
-    GHC   -> ghcInstalled $ mkTVer ver
+    GHC   -> ghcInstalled ver
     _     -> pure False
 
 throwIfFileAlreadyExists :: ( MonadIO m ) =>
@@ -2793,21 +2833,31 @@ rmHLSNoGHC :: ( MonadReader env m
               , HasLog env
               , MonadIO m
               , MonadMask m
+              , MonadFail m
+              , MonadUnliftIO m
               )
-           => m ()
+           => Excepts '[NotInstalled] m ()
 rmHLSNoGHC = do
   Dirs {..} <- getDirs
   ghcs <- fmap rights getInstalledGHCs
   hlses <- fmap rights getInstalledHLSs
   forM_ hlses $ \hls -> do
     hlsGHCs <- fmap mkTVer <$> hlsGHCVersions' hls
-    forM_ hlsGHCs $ \ghc -> do 
+    let candidates = filter (`notElem` ghcs) hlsGHCs
-      when (ghc `notElem` ghcs) $ do
+    if (length hlsGHCs - length candidates) <= 0
-        bins <- hlsServerBinaries hls (Just $ _tvVersion ghc)
+    then rmHLSVer hls
-        forM_ bins $ \bin -> do
+    else
-          let f = binDir </> bin
+      forM_ candidates $ \ghc -> do
+        bins1 <- fmap (binDir </>) <$> hlsServerBinaries hls (Just $ _tvVersion ghc)
+        bins2 <- ifM (isLegacyHLS hls) (pure []) $ do
+          shs <- hlsInternalServerScripts hls (Just $ _tvVersion ghc)
+          bins <- hlsInternalServerBinaries hls (Just $ _tvVersion ghc)
+          libs <- hlsInternalServerLibs hls (_tvVersion ghc)
+          pure (shs ++ bins ++ libs)
+        forM_ (bins1 ++ bins2) $ \f -> do
           logDebug $ "rm " <> T.pack f
           rmFile f
+    pure ()
 
 
 rmCache :: ( MonadReader env m
@@ -2845,3 +2895,25 @@ rmTmp = do
     let p = tmpdir </> f
     logDebug $ "rm -rf " <> T.pack p
     rmPathForcibly p
+
+
+applyAnyPatch :: ( MonadReader env m
+                 , HasDirs env
+                 , HasLog env
+                 , HasSettings env
+                 , MonadUnliftIO m
+                 , MonadCatch m
+                 , MonadResource m
+                 , MonadThrow m
+                 , MonadMask m
+                 , MonadIO m)
+              => Maybe (Either FilePath [URI])
+              -> FilePath
+              -> Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
+applyAnyPatch Nothing _                   = pure ()
+applyAnyPatch (Just (Left pdir)) workdir  = liftE $ applyPatches pdir workdir
+applyAnyPatch (Just (Right uris)) workdir = do
+  tmpUnpack <- lift withGHCupTmpDir
+  forM_ uris $ \uri -> do
+    patch <- liftE $ download uri Nothing Nothing tmpUnpack Nothing False
+    liftE $ applyPatch patch workdir

lib/GHCup/Download.hs

@@ -121,28 +121,25 @@ getDownloadsF = do
   Settings { urlSource } <- lift getSettings
   case urlSource of
     GHCupURL -> liftE $ getBase ghcupURL
-    (OwnSource url) -> liftE $ getBase url
+    (OwnSource exts) -> do
+      ext  <- liftE $ mapM (either pure getBase) exts
+      mergeGhcupInfo ext
     (OwnSpec av) -> pure av
-    (AddSource (Left ext)) -> do
+    (AddSource exts) -> do
       base <- liftE $ getBase ghcupURL
-      pure (mergeGhcupInfo base ext)
+      ext  <- liftE $ mapM (either pure getBase) exts
-    (AddSource (Right uri)) -> do
+      mergeGhcupInfo (base:ext)
-      base <- liftE $ getBase ghcupURL
-      ext  <- liftE $ getBase uri
-      pure (mergeGhcupInfo base ext)
 
-    where
+ where
-
+  mergeGhcupInfo :: MonadFail m
-  mergeGhcupInfo :: GHCupInfo -- ^ base to merge with
+                 => [GHCupInfo]
-                 -> GHCupInfo -- ^ extension overwriting the base
+                 -> m GHCupInfo
-                 -> GHCupInfo
+  mergeGhcupInfo [] = fail "mergeGhcupInfo: internal error: need at least one GHCupInfo"
-  mergeGhcupInfo (GHCupInfo tr base base2) (GHCupInfo _ ext ext2) =
+  mergeGhcupInfo xs@(GHCupInfo{}: _) =
-    let newDownloads = M.mapWithKey (\k a -> case M.lookup k ext of
+    let newDownloads   = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_ghcupDownloads   <$> xs)
-                                        Just a' -> M.union a' a
+        newGlobalTools = M.unionsWith (\_ a2 -> a2              ) (_globalTools      <$> xs)
-                                        Nothing -> a
+        newToolReqs    = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_toolRequirements <$> xs)
-                                    ) base
+    in pure $ GHCupInfo newToolReqs newDownloads newGlobalTools
-        newGlobalTools = M.union base2 ext2
-    in GHCupInfo tr newDownloads newGlobalTools
 
 
 yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
@@ -242,14 +239,18 @@ getBase uri = do
     e <- liftIO $ doesFileExist json_file
     currentTime <- liftIO getCurrentTime
     Dirs { cacheDir } <- lift getDirs
+    Settings { metaCache } <- lift getSettings
 
        -- for local files, let's short-circuit and ignore access time
     if | scheme == "file" -> liftE $ download uri' Nothing Nothing cacheDir Nothing True
        | e -> do
-          accessTime <- liftIO $ getAccessTime json_file
+          accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file
-
+          let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime
+          let cacheInterval = fromInteger metaCache
+          lift $ logDebug $ "last access was " <> T.pack (show sinceLastAccess) <> " ago, cache interval is " <> T.pack (show cacheInterval)
           -- access time won't work on most linuxes, but we can try regardless
-          if | ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) ->
+          if | metaCache <= 0 -> dlWithMod currentTime json_file
+             | (sinceLastAccess > cacheInterval) ->
                 -- no access in last 5 minutes, re-check upstream mod time
                 dlWithMod currentTime json_file
              | otherwise -> pure json_file

lib/GHCup/Platform.hs

@@ -1,9 +1,10 @@
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE QuasiQuotes           #-}
-{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
 
 
 {-|
@@ -27,6 +28,9 @@ import           GHCup.Utils.Logger
 import           GHCup.Utils.Prelude
 import           GHCup.Utils.String.QQ
 
+#if !MIN_VERSION_base(4,13,0)
+import           Control.Monad.Fail             ( MonadFail )
+#endif
 import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad

lib/GHCup/Requirements.hs

@@ -67,3 +67,9 @@ prettyRequirements Requirements {..} =
         else ""
       n = if not . T.null $ _notes then "\n  Note: " <> _notes else ""
   in  "System requirements " <> d <> n
+
+rawRequirements :: Requirements -> T.Text
+rawRequirements Requirements {..} =
+  if not . null $ _distroPKGs
+  then T.intercalate " " _distroPKGs
+  else ""

lib/GHCup/Types.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 
 {-|
@@ -30,12 +31,15 @@ import           Data.Map.Strict                ( Map )
 import           Data.List.NonEmpty             ( NonEmpty (..) )
 import           Data.Text                      ( Text )
 import           Data.Versions
-import           Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
+import           GHC.IO.Exception               ( ExitCode )
+import           Optics                         ( makeLenses )
+import           Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text, (<+>))
 import           URI.ByteString
 #if defined(BRICK)
 import           Graphics.Vty                   ( Key(..) )
 #endif
 
+import qualified Data.ByteString.Lazy          as BL
 import qualified Data.Text                     as T
 import qualified GHC.Generics                  as GHC
 
@@ -282,9 +286,9 @@ instance Pretty TarDir where
 
 -- | Where to fetch GHCupDownloads from.
 data URLSource = GHCupURL
-               | OwnSource URI
+               | OwnSource [Either GHCupInfo URI] -- ^ complete source list
                | OwnSpec GHCupInfo
-               | AddSource (Either GHCupInfo URI) -- ^ merge with GHCupURL
+               | AddSource [Either GHCupInfo URI] -- ^ merge with GHCupURL
                deriving (GHC.Generic, Show)
 
 instance NFData URLSource
@@ -294,6 +298,7 @@ instance NFData (URIRef Absolute) where
 
 data UserSettings = UserSettings
   { uCache       :: Maybe Bool
+  , uMetaCache   :: Maybe Integer
   , uNoVerify    :: Maybe Bool
   , uVerbose     :: Maybe Bool
   , uKeepDirs    :: Maybe KeepDirs
@@ -306,12 +311,13 @@ data UserSettings = UserSettings
   deriving (Show, GHC.Generic)
 
 defaultUserSettings :: UserSettings
-defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
 fromSettings Settings{..} Nothing =
   UserSettings {
       uCache = Just cache
+    , uMetaCache = Just metaCache
     , uNoVerify = Just noVerify
     , uVerbose = Just verbose
     , uKeepDirs = Just keepDirs
@@ -335,6 +341,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
             }
   in UserSettings {
       uCache = Just cache
+    , uMetaCache = Just metaCache
     , uNoVerify = Just noVerify
     , uVerbose = Just verbose
     , uKeepDirs = Just keepDirs
@@ -410,6 +417,7 @@ instance NFData LeanAppState
 
 data Settings = Settings
   { cache      :: Bool
+  , metaCache  :: Integer
   , noVerify   :: Bool
   , keepDirs   :: KeepDirs
   , downloader :: Downloader
@@ -421,6 +429,12 @@ data Settings = Settings
   }
   deriving (Show, GHC.Generic)
 
+defaultMetaCache :: Integer
+defaultMetaCache = 300 -- 5 minutes
+
+defaultSettings :: Settings
+defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False
+
 instance NFData Settings
 
 data Dirs = Dirs
@@ -474,6 +488,10 @@ data SetGHC = SetGHCOnly  -- ^ unversioned 'ghc'
             | SetGHC_XYZ  -- ^ ghc-x.y.z
             deriving (Eq, Show)
 
+data SetHLS = SetHLSOnly  -- ^ unversioned 'hls'
+            | SetHLS_XYZ  -- ^ haskell-language-server-a.b.c~x.y.z, where a.b.c is GHC version and x.y.z is HLS version
+            deriving (Eq, Show)
+
 
 data PlatformResult = PlatformResult
   { _platform      :: Platform
@@ -586,3 +604,27 @@ data LoggerConfig = LoggerConfig
 
 instance NFData LoggerConfig where
   rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors)
+
+data ProcessError = NonZeroExit Int FilePath [String]
+                  | PTerminated FilePath [String]
+                  | PStopped FilePath [String]
+                  | NoSuchPid FilePath [String]
+                  deriving Show
+
+instance Pretty ProcessError where
+  pPrint (NonZeroExit e exe args) =
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
+  pPrint (PTerminated exe args) =
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
+  pPrint (PStopped exe args) =
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
+  pPrint (NoSuchPid exe args) =
+    text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
+data CapturedProcess = CapturedProcess
+  { _exitCode :: ExitCode
+  , _stdOut   :: BL.ByteString
+  , _stdErr   :: BL.ByteString
+  }
+  deriving (Eq, Show)
+
+makeLenses ''CapturedProcess

lib/GHCup/Types/JSON.hs

@@ -22,10 +22,8 @@ Portability : portable
 module GHCup.Types.JSON where
 
 import           GHCup.Types
+import           GHCup.Types.JSON.Utils
 import           GHCup.Utils.MegaParsec
-import           GHCup.Utils.Prelude
-import           GHCup.Utils.Logger             () -- TH is broken shite and needs GHCup.Utils.Logger for linking, although we don't depend on the file.
-                                                   -- This is due to the boot file.
 
 import           Control.Applicative            ( (<|>) )
 import           Data.Aeson              hiding (Key)
@@ -40,6 +38,7 @@ import           Text.Casing
 
 import qualified Data.List.NonEmpty            as NE
 import qualified Data.Text                     as T
+import qualified Data.Text.Encoding.Error      as E
 import qualified Text.Megaparsec               as MP
 import qualified Text.Megaparsec.Char          as MPC
 
@@ -78,7 +77,39 @@ instance FromJSON Tag where
     x -> pure (UnknownTag x)
 
 instance ToJSON URI where
-  toJSON = toJSON . decUTF8Safe . serializeURIRef'
+  toJSON = toJSON . E.decodeUtf8With E.lenientDecode . serializeURIRef'
+
+instance FromJSON URLSource where
+  parseJSON v =
+        parseGHCupURL v
+    <|> parseOwnSourceLegacy v
+    <|> parseOwnSourceNew1 v
+    <|> parseOwnSourceNew2 v
+    <|> parseOwnSpec v
+    <|> legacyParseAddSource v
+    <|> newParseAddSource v
+   where
+    parseOwnSourceLegacy = withObject "URLSource" $ \o -> do
+      r :: URI <- o .: "OwnSource"
+      pure (OwnSource [Right r])
+    parseOwnSourceNew1 = withObject "URLSource" $ \o -> do
+      r :: [URI] <- o .: "OwnSource"
+      pure (OwnSource (fmap Right r))
+    parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
+      r :: [Either GHCupInfo URI] <- o .: "OwnSource"
+      pure (OwnSource r)
+    parseOwnSpec = withObject "URLSource" $ \o -> do
+      r :: GHCupInfo <- o .: "OwnSpec"
+      pure (OwnSpec r)
+    parseGHCupURL = withObject "URLSource" $ \o -> do
+      _ :: [Value] <- o .: "GHCupURL"
+      pure GHCupURL
+    legacyParseAddSource = withObject "URLSource" $ \o -> do
+      r :: Either GHCupInfo URI <- o .: "AddSource"
+      pure (AddSource [r])
+    newParseAddSource = withObject "URLSource" $ \o -> do
+      r :: [Either GHCupInfo URI] <- o .: "AddSource"
+      pure (AddSource r)
 
 instance FromJSON URI where
   parseJSON = withText "URL" $ \t ->
@@ -315,7 +346,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requir
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
-deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
+deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
 deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings

lib/GHCup/Types/JSON/Utils.hs

@@ -0,0 +1,17 @@
+{-|
+Module      : GHCup.Types.JSON.Utils
+Description : Utils for TH splices
+Copyright   : (c) Julian Ospald, 2020
+License     : LGPL-3.0
+Maintainer  : hasufell@hasufell.de
+Stability   : experimental
+Portability : portable
+-}
+
+module GHCup.Types.JSON.Utils where
+
+import qualified Data.Text                     as T
+
+removeLensFieldLabel :: String -> String
+removeLensFieldLabel str' =
+  maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'

lib/GHCup/Utils.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE QuasiQuotes           #-}
-{-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE ViewPatterns          #-}
 
@@ -59,6 +58,7 @@ import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
                                          hiding ( throwM )
 import           Control.Monad.IO.Unlift        ( MonadUnliftIO( withRunInIO ) )
+import           Data.Bifunctor                 ( first )
 import           Data.ByteString                ( ByteString )
 import           Data.Either
 import           Data.Foldable
@@ -66,7 +66,7 @@ import           Data.List
 import           Data.List.NonEmpty             ( NonEmpty( (:|) ))
 import           Data.Maybe
 import           Data.Text                      ( Text )
-import           Data.Versions
+import           Data.Versions         hiding   ( patch )
 import           GHC.IO.Exception
 import           Haskus.Utils.Variant.Excepts
 import           Optics
@@ -110,8 +110,8 @@ import qualified Data.List.NonEmpty            as NE
 -- >>> import Text.PrettyPrint.HughesPJClass ( prettyShow )
 -- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
 -- >>> dirs' <- getAllDirs
--- >>> let installedVersions = [ ([pver|8.10.7|], Nothing), ([pver|8.10.4|], Nothing), ([pver|8.8.4|], Nothing), ([pver|8.8.3|], Nothing) ]
+-- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ]
--- >>> let settings = Settings True False Never Curl False GHCupURL True GPGNone False
+-- >>> let settings = Settings True 0 False Never Curl False GHCupURL True GPGNone False
 -- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
 -- >>> cwd <- getCurrentDirectory
 -- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
@@ -124,31 +124,32 @@ import qualified Data.List.NonEmpty            as NE
     ------------------------
 
 
--- | The symlink destination of a ghc tool.
+-- | Create a relative symlink destination for the binary directory,
-ghcLinkDestination :: ( MonadReader env m
+-- given a target toolpath.
-                      , HasDirs env
+binarySymLinkDestination :: ( MonadThrow m
-                      , MonadThrow m, MonadIO m)
+                            , MonadIO m
-                   => FilePath -- ^ the tool, such as 'ghc', 'haddock' etc.
+                            )
-                   -> GHCTargetVersion
+                         => FilePath -- ^ binary dir
-                   -> m FilePath
+                         -> FilePath -- ^ the full toolpath
-ghcLinkDestination tool ver = do
+                         -> m FilePath
-  Dirs {..}  <- getDirs
+binarySymLinkDestination binDir toolPath = do
-  ghcd <- ghcupGHCDir ver
+  toolPath' <- liftIO $ canonicalizePath toolPath
-  pure (relativeSymlink binDir (ghcd </> "bin" </> tool))
+  binDir' <- liftIO $ canonicalizePath binDir
+  pure (relativeSymlink binDir' toolPath')
 
 
 -- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
-rmMinorSymlinks :: ( MonadReader env m
+rmMinorGHCSymlinks :: ( MonadReader env m
-                   , HasDirs env
+                      , HasDirs env
-                   , MonadIO m
+                      , MonadIO m
-                   , HasLog env
+                      , HasLog env
-                   , MonadThrow m
+                      , MonadThrow m
-                   , MonadFail m
+                      , MonadFail m
-                   , MonadMask m
+                      , MonadMask m
-                   )
+                      )
-                => GHCTargetVersion
+                   => GHCTargetVersion
-                -> Excepts '[NotInstalled] m ()
+                   -> Excepts '[NotInstalled] m ()
-rmMinorSymlinks tv@GHCTargetVersion{..} = do
+rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do
   Dirs {..}  <- lift getDirs
 
   files                         <- liftE $ ghcToolFiles tv
@@ -160,17 +161,17 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
 
 
 -- | Removes the set ghc version for the given target, if any.
-rmPlain :: ( MonadReader env m
+rmPlainGHC :: ( MonadReader env m
-           , HasDirs env
+              , HasDirs env
-           , HasLog env
+              , HasLog env
-           , MonadThrow m
+              , MonadThrow m
-           , MonadFail m
+              , MonadFail m
-           , MonadIO m
+              , MonadIO m
-           , MonadMask m
+              , MonadMask m
-           )
+              )
-        => Maybe Text -- ^ target
+           => Maybe Text -- ^ target
-        -> Excepts '[NotInstalled] m ()
+           -> Excepts '[NotInstalled] m ()
-rmPlain target = do
+rmPlainGHC target = do
   Dirs {..}  <- lift getDirs
   mtv                           <- lift $ ghcSet target
   forM_ mtv $ \tv -> do
@@ -186,17 +187,17 @@ rmPlain target = do
 
 
 -- | Remove the major GHC symlink, e.g. ghc-8.6.
-rmMajorSymlinks :: ( MonadReader env m
+rmMajorGHCSymlinks :: ( MonadReader env m
-                   , HasDirs env
+                      , HasDirs env
-                   , MonadIO m
+                      , MonadIO m
-                   , HasLog env
+                      , HasLog env
-                   , MonadThrow m
+                      , MonadThrow m
-                   , MonadFail m
+                      , MonadFail m
-                   , MonadMask m
+                      , MonadMask m
-                   )
+                      )
-                => GHCTargetVersion
+                   => GHCTargetVersion
-                -> Excepts '[NotInstalled] m ()
+                   -> Excepts '[NotInstalled] m ()
-rmMajorSymlinks tv@GHCTargetVersion{..} = do
+rmMajorGHCSymlinks tv@GHCTargetVersion{..} = do
   Dirs {..}  <- lift getDirs
   (mj, mi) <- getMajorMinorV _tvVersion
   let v' = intToText mj <> "." <> intToText mi
@@ -209,6 +210,62 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
     lift $ hideError doesNotExistErrorType $ rmLink fullF
 
 
+-- | Removes the minor HLS files, e.g. 'haskell-language-server-8.10.7~1.6.1.0'
+-- and 'haskell-language-server-wrapper-1.6.1.0'.
+rmMinorHLSSymlinks :: ( MonadReader env m
+                      , HasDirs env
+                      , MonadIO m
+                      , HasLog env
+                      , MonadThrow m
+                      , MonadFail m
+                      , MonadMask m
+                      )
+                   => Version
+                   -> Excepts '[NotInstalled] m ()
+rmMinorHLSSymlinks ver = do
+  Dirs {..}  <- lift getDirs
+
+  hlsBins <- hlsAllBinaries ver
+  forM_ hlsBins $ \f -> do
+    let fullF = binDir </> f
+    lift $ logDebug ("rm -f " <> T.pack fullF)
+    -- on unix, this may be either a file (legacy) or a symlink
+    -- on windows, this is always a file... hence 'rmFile'
+    -- works consistently across platforms
+    lift $ rmFile fullF
+
+-- | Removes the set HLS version, if any.
+rmPlainHLS :: ( MonadReader env m
+              , HasDirs env
+              , HasLog env
+              , MonadThrow m
+              , MonadFail m
+              , MonadIO m
+              , MonadMask m
+              )
+           => Excepts '[NotInstalled] m ()
+rmPlainHLS = do
+  Dirs {..}  <- lift getDirs
+
+  -- delete 'haskell-language-server-8.10.7'
+  hlsBins <- fmap (filter (\f -> not ("haskell-language-server-wrapper" `isPrefixOf` f) && ('~' `notElem` f)))
+    $ liftIO $ handleIO (\_ -> pure []) $ findFiles
+      binDir
+      (makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString))
+  forM_ hlsBins $ \f -> do
+    let fullF = binDir </> f
+    lift $ logDebug ("rm -f " <> T.pack fullF)
+    if isWindows
+    then lift $ rmLink fullF
+    else lift $ rmFile fullF
+
+  -- 'haskell-language-server-wrapper'
+  let hlswrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
+  lift $ logDebug ("rm -f " <> T.pack hlswrapper)
+  if isWindows
+  then lift $ hideError doesNotExistErrorType $ rmLink hlswrapper
+  else lift $ hideError doesNotExistErrorType $ rmFile hlswrapper
+
 
 
     -----------------------------------
@@ -352,7 +409,8 @@ cabalSet = do
 
 
 -- | Get all installed hls, by matching on
--- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
+-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@,
+-- as well as @~\/.ghcup\/hls\/<\hlsver\>@
 getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
                  => m [Either FilePath Version]
 getInstalledHLSs = do
@@ -363,7 +421,7 @@ getInstalledHLSs = do
                    execBlank
                    ([s|^haskell-language-server-wrapper-.*$|] :: ByteString)
     )
-  forM bins $ \f ->
+  legacy <- forM bins $ \f ->
     case
           version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
       of
@@ -371,6 +429,14 @@ getInstalledHLSs = do
         Just (Left  _) -> pure $ Left f
         Nothing        -> pure $ Left f
 
+  hlsdir <- ghcupHLSBaseDir
+  fs     <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory hlsdir
+  new <- forM fs $ \f -> case parseGHCupHLSDir f of
+    Right r -> pure $ Right r
+    Left  _ -> pure $ Left f
+  pure (nub (new <> legacy))
+
+
 -- | Get all installed stacks, by matching on
 -- @~\/.ghcup\/bin/stack-<\stackver\>@.
 getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
@@ -446,6 +512,10 @@ hlsInstalled ver = do
   vers <- fmap rights getInstalledHLSs
   pure $ elem ver vers
 
+isLegacyHLS :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
+isLegacyHLS ver = do
+  bdir <- ghcupHLSDir ver
+  not <$> liftIO (doesDirectoryExist bdir)
 
 
 -- Return the currently set hls version, if any.
@@ -517,7 +587,7 @@ hlsGHCVersions' v' = do
   pure . sortBy (flip compare) . rights $ vers
 
 
--- | Get all server binaries for an hls version, if any.
+-- | Get all server binaries for an hls version from the ~/.ghcup/bin directory, if any.
 hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
                   => Version
                   -> Maybe Version   -- ^ optional GHC version
@@ -538,6 +608,44 @@ hlsServerBinaries ver mghcVer = do
       )
     )
 
+-- | Get all scripts for a hls version from the ~/.ghcup/hls/<ver>/bin directory, if any.
+-- Returns the full path.
+hlsInternalServerScripts :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
+                          => Version
+                          -> Maybe Version   -- ^ optional GHC version
+                          -> m [FilePath]
+hlsInternalServerScripts ver mghcVer = do
+  dir <- ghcupHLSDir ver
+  let bdir = dir </> "bin"
+  fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
+    <$> liftIO (listDirectory bdir)
+
+-- | Get all binaries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/bin directory, if any.
+-- Returns the full path.
+hlsInternalServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadFail m)
+                          => Version
+                          -> Maybe Version   -- ^ optional GHC version
+                          -> m [FilePath]
+hlsInternalServerBinaries ver mghcVer = do
+  dir <- ghcupHLSDir ver
+  let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
+  (Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left "bin"]
+  fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
+    <$> liftIO (listDirectory bdir)
+
+-- | Get all libraries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/lib/<ghc-ver>/
+-- directory, if any.
+-- Returns the full path.
+hlsInternalServerLibs :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadFail m)
+                      => Version
+                      -> Version   -- ^ GHC version
+                      -> m [FilePath]
+hlsInternalServerLibs ver ghcVer = do
+  dir <- ghcupHLSDir ver
+  let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
+  (Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left ("lib" </> T.unpack (prettyVer ghcVer))]
+  fmap (bdir </>) <$> liftIO (listDirectory bdir)
+
 
 -- | Get the wrapper binary for an hls version, if any.
 hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
@@ -568,22 +676,6 @@ hlsAllBinaries ver = do
   pure (maybeToList wrapper ++ hls)
 
 
--- | Get the active symlinks for hls.
-hlsSymlinks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) => m [FilePath]
-hlsSymlinks = do
-  Dirs {..}  <- getDirs
-  oldSyms                       <- liftIO $ handleIO (\_ -> pure []) $ findFiles
-    binDir
-    (makeRegexOpts compExtended
-                   execBlank
-                   ([s|^haskell-language-server-.*$|] :: ByteString)
-    )
-  filterM
-    ( liftIO
-    . pathIsLink
-    . (binDir </>)
-    )
-    oldSyms
 
 
 
@@ -631,34 +723,34 @@ getGHCForPVP pvpIn mt = do
   ghcs <- rights <$> getInstalledGHCs
   -- we're permissive here... failed parse just means we have no match anyway
   let ghcs' = catMaybes $ flip fmap ghcs $ \GHCTargetVersion{..} -> do
-        pvp_ <- versionToPVP _tvVersion
+        (pvp_, rest) <- versionToPVP _tvVersion
-        pure (pvp_, _tvTarget)
+        pure (pvp_, rest, _tvTarget)
 
   getGHCForPVP' pvpIn ghcs' mt
 
 -- | Like 'getGHCForPVP', except with explicit input parameter.
 --
--- >>> fmap prettyShow $ getGHCForPVP' [pver|8|] installedVersions Nothing
+-- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
--- "Just 8.10.7"
+-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = (Digits 8 :| []) :| [Digits 10 :| [],Digits 7 :| []], _vRel = [Str "debug" :| []], _vMeta = Just "lol"}})
 -- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
 -- "Just 8.8.4"
 -- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
 -- "Just 8.10.4"
 getGHCForPVP' :: MonadThrow m
              => PVP
-             -> [(PVP, Maybe Text)] -- ^ installed GHCs
+             -> [(PVP, Text, Maybe Text)] -- ^ installed GHCs
              -> Maybe Text          -- ^ the target triple
              -> m (Maybe GHCTargetVersion)
 getGHCForPVP' pvpIn ghcs' mt = do
   let mResult = lastMay
-                  . sortBy (\(x, _) (y, _) -> compare x y)
+                  . sortBy (\(x, _, _) (y, _, _) -> compare x y)
                   . filter
-                      (\(pvp_, target) ->
+                      (\(pvp_, _, target) ->
                         target == mt && matchPVPrefix pvp_ pvpIn
                       )
                   $ ghcs'
-  forM mResult $ \(pvp_, target) -> do
+  forM mResult $ \(pvp_, rest, target) -> do
-    ver' <- pvpToVersion pvp_
+    ver' <- pvpToVersion pvp_ rest
     pure (GHCTargetVersion target ver')
 
 
@@ -679,7 +771,7 @@ getLatestToolFor :: MonadThrow m
 getLatestToolFor tool pvpIn dls = do
   let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
   let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
-  pure . headMay . filter (\(v, _) -> matchPVPrefix pvpIn v) $ ps
+  pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
 
 
 
@@ -714,7 +806,7 @@ unpackToDir dfp av = do
       (untar . GZip.decompress =<< rf av)
     | ".tar.xz" `isSuffixOf` fn -> do
       filecontents <- liftE $ rf av
-      let decompressed = Lzma.decompress filecontents
+      let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
       liftE $ untar decompressed
     | ".tar.bz2" `isSuffixOf` fn ->
       liftE (untar . BZip.decompress =<< rf av)
@@ -743,7 +835,7 @@ getArchiveFiles av = do
       (entries . GZip.decompress =<< rf av)
     | ".tar.xz" `isSuffixOf` fn -> do
       filecontents <- liftE $ rf av
-      let decompressed = Lzma.decompress filecontents
+      let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
       liftE $ entries decompressed
     | ".tar.bz2" `isSuffixOf` fn ->
       liftE (entries . BZip.decompress =<< rf av)
@@ -808,8 +900,16 @@ getLatestBaseVersion av pvpVer =
     --[ Other ]--
     -------------
 
+-- | Usually @~\/.ghcup\/ghc\/\<ver\>\/bin\/@
+ghcInternalBinDir :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
+                  => GHCTargetVersion
+                  -> m FilePath
+ghcInternalBinDir ver = do
+  ghcdir <- ghcupGHCDir ver
+  pure (ghcdir </> "bin")
 
--- | Get tool files from @~\/.ghcup\/bin\/ghc\/\<ver\>\/bin\/\*@
+
+-- | Get tool files from @~\/.ghcup\/ghc\/\<ver\>\/bin\/\*@
 -- while ignoring @*-\<ver\>@ symlinks and accounting for cross triple prefix.
 --
 -- Returns unversioned relative files without extension, e.g.:
@@ -819,11 +919,10 @@ ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, Mona
              => GHCTargetVersion
              -> Excepts '[NotInstalled] m [FilePath]
 ghcToolFiles ver = do
-  ghcdir <- lift $ ghcupGHCDir ver
+  bindir <- ghcInternalBinDir ver
-  let bindir = ghcdir </> "bin"
 
   -- fail if ghc is not installed
-  whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
+  whenM (fmap not $ ghcInstalled ver)
         (throwE (NotInstalled GHC ver))
 
   files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
@@ -855,6 +954,7 @@ make :: ( MonadThrow m
         , MonadIO m
         , MonadReader env m
         , HasDirs env
+        , HasLog env
         , HasSettings env
         )
      => [String]
@@ -877,28 +977,43 @@ makeOut args workdir = do
   executeOut mymake args workdir
 
 
--- | Try to apply patches in order. Fails with 'PatchFailed'
+-- | Try to apply patches in order. The order is determined by
--- on first failure.
+-- a quilt series file (in the patch directory) if one exists,
+-- else the patches are applied in lexicographical order.
+-- Fails with 'PatchFailed' on first failure.
 applyPatches :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
              => FilePath   -- ^ dir containing patches
              -> FilePath   -- ^ dir to apply patches in
              -> Excepts '[PatchFailed] m ()
 applyPatches pdir ddir = do
-  patches <- (fmap . fmap) (pdir </>) $ liftIO $ findFiles
+  let lexicographical = (fmap . fmap) (pdir </>) $ sort <$> findFiles
-      pdir
+        pdir
-      (makeRegexOpts compExtended
+        (makeRegexOpts compExtended
-                     execBlank
+                       execBlank
-                     ([s|.+\.(patch|diff)$|] :: ByteString)
+                       ([s|.+\.(patch|diff)$|] :: ByteString)
-      )
+        )
-  forM_ (sort patches) $ \patch' -> do
+  let quilt = map (pdir </>) . lines <$> readFile (pdir </> "series")
-    lift $ logInfo $ "Applying patch " <> T.pack patch'
+
-    fmap (either (const Nothing) Just)
+  patches <- liftIO $ quilt `catchIO` (\e ->
-         (exec
+    if isDoesNotExistError e || isPermissionError e then
-           "patch"
+      lexicographical 
-           ["-p1", "-i", patch']
+    else throwIO e)
-           (Just ddir)
+  forM_ patches $ \patch' -> applyPatch patch' ddir
-           Nothing)
+
-      !? PatchFailed
+
+applyPatch :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
+           => FilePath   -- ^ Patch
+           -> FilePath   -- ^ dir to apply patches in
+           -> Excepts '[PatchFailed] m ()
+applyPatch patch ddir = do
+  lift $ logInfo $ "Applying patch " <> T.pack patch
+  fmap (either (const Nothing) Just)
+       (exec
+         "patch"
+         ["-p1", "-s", "-f", "-i", patch]
+         (Just ddir)
+         Nothing)
+    !? PatchFailed
 
 
 -- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
@@ -1132,11 +1247,27 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
 
 -- | For ghc without arch triple, this is:
 --
---    - ghc-<ver> (e.g. ghc-8.10.4)
+--    - ghc
 --
 -- For ghc with arch triple:
 --
---    - <triple>-ghc-<ver> (e.g. arm-linux-gnueabihf-ghc-8.10.4)
+--    - <triple>-ghc (e.g. arm-linux-gnueabihf-ghc)
 ghcBinaryName :: GHCTargetVersion -> String
-ghcBinaryName (GHCTargetVersion (Just t) v') = T.unpack (t <> "-ghc-" <> prettyVer v' <> T.pack exeExt)
+ghcBinaryName (GHCTargetVersion (Just t) _) = T.unpack (t <> "-ghc" <> T.pack exeExt)
-ghcBinaryName (GHCTargetVersion Nothing  v') = T.unpack ("ghc-" <> prettyVer v' <> T.pack exeExt)
+ghcBinaryName (GHCTargetVersion Nothing  _) = T.unpack ("ghc" <> T.pack exeExt)
+
+
+-- | Does basic checks for isolated installs
+-- Isolated Directory:
+--   1. if it doesn't exist -> proceed
+--   2. if it exists and is empty -> proceed
+--   3. if it exists and is non-empty -> panic and leave the house
+installDestSanityCheck :: ( MonadIO m
+                          , MonadCatch m
+                          ) =>
+                          FilePath ->
+                          Excepts '[DirNotEmpty] m ()
+installDestSanityCheck isoDir = do
+  hideErrorDef [doesNotExistErrorType] () $ do
+    contents <- liftIO $ getDirectoryContentsRecursive isoDir
+    unless (null contents) (throwE $ DirNotEmpty isoDir)

lib/GHCup/Utils/Dirs.hs

@@ -20,8 +20,11 @@ module GHCup.Utils.Dirs
   , ghcupCacheDir
   , ghcupGHCBaseDir
   , ghcupGHCDir
+  , ghcupHLSBaseDir
+  , ghcupHLSDir
   , mkGhcupTmpDir
   , parseGHCupGHCDir
+  , parseGHCupHLSDir
   , relativeSymlink
   , withGHCupTmpDir
   , getConfigFilePath
@@ -46,6 +49,7 @@ import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource hiding (throwM)
 import           Data.Bifunctor
 import           Data.Maybe
+import           Data.Versions
 import           GHC.IO.Exception               ( IOErrorType(NoSuchThing) )
 import           Haskus.Utils.Variant.Excepts
 import           Optics
@@ -244,6 +248,24 @@ parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion
 parseGHCupGHCDir (T.pack -> fp) =
   throwEither $ MP.parse ghcTargetVerP "" fp
 
+parseGHCupHLSDir :: MonadThrow m => FilePath -> m Version
+parseGHCupHLSDir (T.pack -> fp) =
+  throwEither $ MP.parse version' "" fp
+
+-- | ~/.ghcup/hls by default, for new-style installs.
+ghcupHLSBaseDir :: (MonadReader env m, HasDirs env) => m FilePath
+ghcupHLSBaseDir = do
+  Dirs {..}  <- getDirs
+  pure (baseDir </> "hls")
+
+-- | Gets '~/.ghcup/hls/<hls-ver>' for new-style installs.
+ghcupHLSDir :: (MonadReader env m, HasDirs env, MonadThrow m)
+            => Version
+            -> m FilePath
+ghcupHLSDir ver = do
+  basedir <- ghcupHLSBaseDir
+  let verdir = T.unpack $ prettyVer ver
+  pure (basedir </> verdir)
 
 mkGhcupTmpDir :: ( MonadReader env m
                  , HasDirs env
@@ -313,16 +335,19 @@ useXDG :: IO Bool
 useXDG = isJust <$> lookupEnv "GHCUP_USE_XDG_DIRS"
 
 
+-- | Like 'relpath'. Assumes the inputs are resolved in case of symlinks.
 relativeSymlink :: FilePath  -- ^ the path in which to create the symlink
                 -> FilePath  -- ^ the symlink destination
                 -> FilePath
-relativeSymlink p1 p2 =
+relativeSymlink p1 p2
-  let d1      = splitDirectories p1
+  | isWindows = p2 -- windows quickly gets into MAX_PATH issues so we don't care about relative symlinks
-      d2      = splitDirectories p2
+  | otherwise =
-      common  = takeWhile (\(x, y) -> x == y) $ zip d1 d2
+    let d1      = splitDirectories p1
-      cPrefix = drop (length common) d1
+        d2      = splitDirectories p2
-  in  joinPath (replicate (length cPrefix) "..")
+        common  = takeWhile (\(x, y) -> x == y) $ zip d1 d2
-        <> joinPath ([pathSeparator] : drop (length common) d2)
+        cPrefix = drop (length common) d1
+    in  joinPath (replicate (length cPrefix) "..")
+          <> joinPath ([pathSeparator] : drop (length common) d2)
 
 
 cleanupTrash :: ( MonadIO m

lib/GHCup/Utils/File/Common.hs

@@ -1,11 +1,14 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE ViewPatterns      #-}
 
-module GHCup.Utils.File.Common where
+module GHCup.Utils.File.Common (
+  module GHCup.Utils.File.Common
+  , ProcessError(..)
+  , CapturedProcess(..)
+  ) where
 
 import           GHCup.Utils.Prelude
+import           GHCup.Types(ProcessError(..), CapturedProcess(..))
 
 import           Control.Monad.Reader
 import           Data.Maybe
@@ -13,7 +16,7 @@ import           Data.Text               ( Text )
 import           Data.Void
 import           GHC.IO.Exception
 import           Optics                  hiding ((<|), (|>))
-import           System.Directory
+import           System.Directory        hiding (findFiles)
 import           System.FilePath
 import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           Text.Regex.Posix
@@ -24,33 +27,6 @@ import qualified Text.Megaparsec               as MP
 
 
 
-data ProcessError = NonZeroExit Int FilePath [String]
-                  | PTerminated FilePath [String]
-                  | PStopped FilePath [String]
-                  | NoSuchPid FilePath [String]
-                  deriving Show
-
-instance Pretty ProcessError where
-  pPrint (NonZeroExit e exe args) =
-    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
-  pPrint (PTerminated exe args) =
-    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
-  pPrint (PStopped exe args) =
-    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
-  pPrint (NoSuchPid exe args) =
-    text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
-
-data CapturedProcess = CapturedProcess
-  { _exitCode :: ExitCode
-  , _stdOut   :: BL.ByteString
-  , _stdErr   :: BL.ByteString
-  }
-  deriving (Eq, Show)
-
-makeLenses ''CapturedProcess
-
-
-
 -- | Search for a file in the search paths.
 --
 -- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
@@ -100,6 +76,21 @@ isInPath p = do
   else pure False
 
 
+-- | Follows the first match in case of Regex.
+expandFilePath :: [Either FilePath Regex] -> IO [FilePath]
+expandFilePath = go ""
+ where
+  go :: FilePath -> [Either FilePath Regex] -> IO [FilePath]
+  go p [] = pure [p]
+  go p (x:xs) = do
+    case x of
+      Left s -> go (p </> s) xs
+      Right regex -> do
+        fps <- findFiles p regex
+        res <- forM fps $ \fp -> go (p </> fp) xs
+        pure $ mconcat res
+
+
 findFiles :: FilePath -> Regex -> IO [FilePath]
 findFiles path regex = do
   contents <- listDirectory path

lib/GHCup/Utils/File/Posix.hs

@@ -35,7 +35,7 @@ import           Data.Sequence                  ( Seq, (|>) )
 import           Data.List
 import           Data.Word8
 import           GHC.IO.Exception
-import           System.Console.Terminal.Common
+import           System.IO                      ( stderr )
 import           System.IO.Error
 import           System.FilePath
 import           System.Directory
@@ -51,7 +51,7 @@ import qualified Data.Sequence                 as Sq
 import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as E
 import qualified System.Posix.Process          as SPP
-import qualified System.Console.Terminal.Posix as TP
+import qualified System.Console.Terminal.Size  as TP
 import qualified Data.ByteString               as BS
 import qualified Data.ByteString.Lazy          as BL
 import qualified "unix-bytestring" System.Posix.IO.ByteString
@@ -73,6 +73,7 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
 
 execLogged :: ( MonadReader env m
               , HasSettings env
+              , HasLog env
               , HasDirs env
               , MonadIO m
               , MonadThrow m)
@@ -85,6 +86,7 @@ execLogged :: ( MonadReader env m
 execLogged exe args chdir lfile env = do
   Settings {..} <- getSettings
   Dirs {..} <- getDirs
+  logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
   let logfile = logsDir </> lfile <> ".log"
   liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
                    closeFd
@@ -141,14 +143,14 @@ execLogged exe args chdir lfile env = do
   printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO ()
   printToRegion fileFd fdIn size pState no_color = do
     -- init region
-    forM_ [1..size] $ \_ -> BS.putStr "\n"
+    forM_ [1..size] $ \_ -> BS.hPut stderr "\n"
 
     void $ flip runStateT mempty
       $ do
         handle
           (\(ex :: SomeException) -> do
             ps <- liftIO $ takeMVar pState
-            when ps (liftIO $ BS.putStr (pos1 <> moveLineUp size <> clearScreen))
+            when ps (liftIO $ BS.hPut stderr (pos1 <> moveLineUp size <> clearScreen))
             throw ex
           ) $ readTilEOF lineAction fdIn
 
@@ -180,10 +182,10 @@ execLogged exe args chdir lfile env = do
       modify (swapRegs bs')
       liftIO TP.size >>= \case
         Nothing -> pure ()
-        Just (Window _ w) -> do
+        Just (TP.Window _ w) -> do
           regs <- get
           liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
-              BS.putStr
+              BS.hPut stderr
               . overwriteNthLine (size - i)
               . trim w
               . blue

lib/GHCup/Utils/File/Windows.hs

@@ -18,6 +18,7 @@ module GHCup.Utils.File.Windows where
 import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink )
 import           GHCup.Utils.Dirs
 import           GHCup.Utils.File.Common
+import           GHCup.Utils.Logger
 import           GHCup.Types
 import           GHCup.Types.Optics
 
@@ -40,6 +41,7 @@ import qualified Control.Exception             as EX
 import qualified Data.ByteString               as BS
 import qualified Data.ByteString.Lazy          as BL
 import qualified Data.Map.Strict               as Map
+import qualified Data.Text                     as T
 
 
 
@@ -149,6 +151,7 @@ executeOut path args chdir = do
 
 execLogged :: ( MonadReader env m
               , HasDirs env
+              , HasLog env
               , HasSettings env
               , MonadIO m
               , MonadThrow m)
@@ -160,6 +163,7 @@ execLogged :: ( MonadReader env m
            -> m (Either ProcessError ())
 execLogged exe args chdir lfile env = do
   Dirs {..} <- getDirs
+  logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
   let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
       stderrLogfile = logsDir </> lfile <> ".stderr.log"
   cp <- createProcessWithMingwPath ((proc exe args)
@@ -192,7 +196,8 @@ execLogged exe args chdir lfile env = do
           then pure ()
           else do
             void $ BS.appendFile logFile some
-            void $ BS.hPut stdout some
+            -- subprocess stdout also goes to stderr for logging
+            void $ BS.hPut stderr some
             go
         
 

lib/GHCup/Utils/Logger.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE QuasiQuotes      #-}
 {-# LANGUAGE DataKinds        #-}
 {-# LANGUAGE OverloadedStrings   #-}
 
@@ -18,7 +17,7 @@ module GHCup.Utils.Logger where
 
 import           GHCup.Types
 import           GHCup.Types.Optics
-import {-# SOURCE #-} GHCup.Utils.File.Common
+import {-# SOURCE #-} GHCup.Utils.File.Common (findFiles)
 import           GHCup.Utils.String.QQ
 
 import           Control.Exception.Safe

lib/GHCup/Utils/Logger.hs-boot

@@ -1,7 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE QuasiQuotes      #-}
 {-# LANGUAGE DataKinds        #-}
-{-# LANGUAGE OverloadedStrings   #-}
 
 module GHCup.Utils.Logger where
 

lib/GHCup/Utils/Prelude.hs

@@ -30,7 +30,7 @@ where
 import           GHCup.Types
 import           GHCup.Errors
 import           GHCup.Types.Optics
-import {-# SOURCE #-} GHCup.Utils.Logger
+import {-# SOURCE #-} GHCup.Utils.Logger (logWarn)
 #if defined(IS_WINDOWS)
 import           GHCup.Utils.Prelude.Windows
 #else
@@ -44,7 +44,7 @@ import           Control.Monad.IO.Class
 import           Control.Monad.Reader
 import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
-import           Data.List                      ( nub, intercalate, stripPrefix, isPrefixOf, dropWhileEnd )
+import           Data.List                      ( nub, intercalate, stripPrefix, isPrefixOf, dropWhileEnd, intersperse )
 import           Data.Maybe
 import           Data.Foldable
 import           Data.List.NonEmpty             ( NonEmpty( (:|) ))
@@ -308,23 +308,46 @@ intToText :: Integral a => a -> T.Text
 intToText = TL.toStrict . B.toLazyText . B.decimal
 
 
-removeLensFieldLabel :: String -> String
+pvpToVersion :: MonadThrow m => PVP -> Text -> m Version
-removeLensFieldLabel str' =
+pvpToVersion pvp_ rest =
-  maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'
+  either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . (<> rest) . prettyPVP $ pvp_
 
-
+-- | Convert a version to a PVP and unparsable rest.
-pvpToVersion :: MonadThrow m => PVP -> m Version
+--
-pvpToVersion =
+-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
-  either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . prettyPVP
+versionToPVP :: MonadThrow m => Version -> m (PVP, Text)
-
+versionToPVP (Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
-versionToPVP :: MonadThrow m => Version -> m PVP
+versionToPVP v = either (\_ -> (, rest v) <$> alternative v) (pure . (, mempty)) . pvp . prettyVer $ v
-versionToPVP v = either (\_ -> alternative v) pure . pvp . prettyVer $ v
  where
   alternative :: MonadThrow m => Version -> m PVP
   alternative v' = case NE.takeWhile isDigit (_vChunks v') of
     [] -> throwM $ ParseError "Couldn't convert Version to PVP"
     xs -> pure $ pvpFromList (unsafeDigit <$> xs)
 
+  rest :: Version -> Text
+  rest (Version _ cs pr me) =
+    let chunks = NE.dropWhile isDigit cs
+        ver = intersperse (T.pack ".") . chunksAsT $ chunks
+        me' = maybe [] (\m -> [T.pack "+",m]) me
+        pr' = foldable [] (T.pack "-" :) $ intersperse (T.pack ".") (chunksAsT pr)
+        prefix = case (ver, pr', me') of
+                   (_:_, _, _) -> T.pack "."
+                   _           -> T.pack ""
+    in prefix <> mconcat (ver <> pr' <> me')
+   where
+    chunksAsT :: Functor t => t VChunk -> t Text
+    chunksAsT = fmap (foldMap f)
+      where
+        f :: VUnit -> Text
+        f (Digits i) = T.pack $ show i
+        f (Str s)    = s
+
+    foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
+    foldable d g f | null f    = d
+                   | otherwise = g f
+
+
+
   isDigit :: VChunk -> Bool
   isDigit (Digits _ :| []) = True
   isDigit _                = False
@@ -449,7 +472,9 @@ recyclePathForcibly fp
       let dest = tmp </> takeFileName fp
       liftIO (moveFile fp dest)
           `catch`
-          (\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
+          (\e -> if | isDoesNotExistError e -> pure ()
+                    | isPermissionError e {- EXDEV on windows -} -> recover (liftIO $ removePathForcibly fp)
+                    | otherwise -> throwIO e)
           `finally`
             liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp)
   | otherwise = liftIO $ removePathForcibly fp

lib/GHCup/Utils/String/QQ.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
 
 {-|
 Module      : GHCup.Utils.String.QQ

lib/GHCup/Utils/Version/QQ.hs

@@ -4,7 +4,7 @@
 {-# LANGUAGE DeriveLift         #-}
 {-# LANGUAGE FlexibleInstances  #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
 
 
 {-|
@@ -53,6 +53,9 @@ deriving instance Data VUnit
 
 #if !MIN_VERSION_base(4,13,0)
 deriving instance Lift (NonEmpty Word)
+deriving instance Lift (NonEmpty VChunk)
+deriving instance Lift (NonEmpty MChunk)
+deriving instance Lift (NonEmpty VUnit)
 #endif
 
 qq :: (Text -> Q Exp) -> QuasiQuoter

lib/GHCup/Version.hs

@@ -28,7 +28,7 @@ import qualified Data.Text                     as T
 -- Note that when updating this, CI requires that the file exsists AND the same file exists at
 -- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
 ghcupURL :: URI
-ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.6.yaml|]
+ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml|]
 
 -- | The current ghcup version.
 ghcUpVer :: PVP

lib/System/Console/Terminal/Common.hs

@@ -1,43 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveTraversable #-}
-
-#if __GLASGOW_HASKELL__ >= 702
-#define LANGUAGE_DeriveGeneric
-{-# LANGUAGE DeriveGeneric #-}
-#endif
-
-module System.Console.Terminal.Common
-  ( Window(..)
-  ) where
-
-import Data.Data (Typeable, Data)
-
-#if __GLASGOW_HASKELL__ < 710
-import Data.Foldable (Foldable)
-import Data.Traversable (Traversable)
-#endif
-
-#ifdef LANGUAGE_DeriveGeneric
-import GHC.Generics
-  ( Generic
-#if __GLASGOW_HASKELL__ >= 706
-  , Generic1
-#endif
-  )
-#endif
-
--- | Terminal window width and height
-data Window a = Window
-  { height :: !a
-  , width  :: !a
-  } deriving
-    ( Show, Eq, Read, Data, Typeable
-    , Foldable, Functor, Traversable
-#ifdef LANGUAGE_DeriveGeneric
-    , Generic
-#if __GLASGOW_HASKELL__ >= 706
-    , Generic1
-#endif
-#endif
-    )

lib/System/Console/Terminal/Posix.hsc

@@ -1,65 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-
-module System.Console.Terminal.Posix
-  ( size, fdSize, hSize
-  ) where
-
-import System.Console.Terminal.Common
-import Control.Exception (catch)
-import Data.Typeable (cast)
-import Foreign
-import Foreign.C.Error
-import Foreign.C.Types
-import GHC.IO.FD (FD(FD, fdFD))
-import GHC.IO.Handle.Internals (withHandle_)
-import GHC.IO.Handle.Types (Handle, Handle__(Handle__, haDevice))
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 706)
-import Prelude hiding (catch)
-#endif
-import System.Posix.Types (Fd(Fd))
-
-#include <sys/ioctl.h>
-#include <unistd.h>
-
-
-#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
-
-
--- Interesting part of @struct winsize@
-data CWin = CWin CUShort CUShort
-
-instance Storable CWin where
-  sizeOf _ = (#size struct winsize)
-  alignment _ = (#alignment struct winsize)
-  peek ptr = do
-    row <- (#peek struct winsize, ws_row) ptr
-    col <- (#peek struct winsize, ws_col) ptr
-    return $ CWin row col
-  poke ptr (CWin row col) = do
-    (#poke struct winsize, ws_row) ptr row
-    (#poke struct winsize, ws_col) ptr col
-
-
-fdSize :: Integral n => Fd -> IO (Maybe (Window n))
-fdSize (Fd fd) = with (CWin 0 0) $ \ws -> do
-  _ <- throwErrnoIfMinus1 "ioctl" $
-    ioctl fd (#const TIOCGWINSZ) ws
-  CWin row col <- peek ws
-  return . Just $ Window (fromIntegral row) (fromIntegral col)
- `catch`
-  handler
- where
-  handler :: IOError -> IO (Maybe (Window h))
-  handler _ = return Nothing
-
-foreign import capi "sys/ioctl.h ioctl"
-  ioctl :: CInt -> CULong -> Ptr CWin -> IO CInt
-
-size :: Integral n => IO (Maybe (Window n))
-size = fdSize (Fd (#const STDOUT_FILENO))
-
-hSize :: Integral n => Handle -> IO (Maybe (Window n))
-hSize h = withHandle_ "hSize" h $ \Handle__ { haDevice = dev } ->
-  case cast dev of
-    Nothing -> return Nothing
-    Just FD { fdFD = fd } -> fdSize (Fd fd)

mkdocs.yml

@@ -1,6 +1,6 @@
 site_name: GHCup
 site_url: https://www.haskell.org/ghcup
-site_description: GHCup documentation
+site_description: GHCup is an installer for the general purpose language Haskell.
 site_author: GHCup Team
 site_favicon: haskell_logo.png
 

scripts/bootstrap/bootstrap-haskell

@@ -25,7 +25,7 @@
 
 plat="$(uname -s)"
 arch=$(uname -m)
-ghver="0.1.17.3"
+ghver="0.1.17.5"
 base_url="https://downloads.haskell.org/~ghcup"
 
 export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -39,7 +39,6 @@ case "${plat}" in
 			;;
 		*)
 			: "${GHCUP_INSTALL_BASE_PREFIX:=$HOME}"
-			export GHCUP_USE_XDG_DIRS
 
 			if [ -n "${GHCUP_USE_XDG_DIRS}" ] ; then
 				GHCUP_DIR=${XDG_DATA_HOME:=$HOME/.local/share}/ghcup
@@ -182,6 +181,48 @@ _done() {
 	exit 0
 }
 
+# @FUNCTION: posix_realpath
+# @USAGE: <file>
+# @DESCRIPTION:
+# Portably gets the realpath and prints it to stdout.
+# This was initially inspired by
+#   https://gist.github.com/tvlooy/cbfbdb111a4ebad8b93e
+#   and
+#   https://stackoverflow.com/a/246128
+#
+# If the file does not exist, just prints it appended to the current directory.
+# @STDOUT: realpath of the given file
+posix_realpath() {
+    [ -z "$1" ] && die "Internal error: no argument given to posix_realpath"
+    current_loop=0
+    max_loops=50
+    mysource=$1
+
+    while [ -h "${mysource}" ]; do
+        current_loop=$((current_loop+1))
+        mydir="$( cd -P "$( dirname "${mysource}" )" > /dev/null 2>&1 && pwd )"
+        mysource="$(readlink "${mysource}")"
+        [ "${mysource%${mysource#?}}"x != '/x' ] && mysource="${mydir}/${mysource}"
+
+        if [ ${current_loop} -gt ${max_loops} ] ; then
+            (>&2 echo "${1}: Too many levels of symbolic links")
+			echo "$1"
+            return
+        fi
+    done
+    mydir="$( cd -P "$( dirname "${mysource}" )" > /dev/null 2>&1 && pwd )"
+
+    # TODO: better distinguish between "does not exist" and "permission denied"
+    if [ -z "${mydir}" ] ; then
+        (>&2 echo "${1}: Permission denied")
+		echo "$(pwd)/$1"
+    else
+        echo "${mydir%/}/$(basename "${mysource}")"
+    fi
+
+    unset current_loop max_loops mysource mydir
+}
+
 download_ghcup() {
 
     case "${plat}" in
@@ -237,7 +278,7 @@ download_ghcup() {
 				*) die "Unknown architecture: ${arch}"
 					;;
 			esac
-			_url=${base_url}/${ghver}/x86_64-portbld-freebsd${freebsd_ver}-ghcup-${ghver}
+			_url=${base_url}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
             ;;
         "Darwin"|"darwin")
 			case "${arch}" in
@@ -281,7 +322,20 @@ download_ghcup() {
 
 	# we may overwrite this in adjust_bashrc
 	cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
-		export PATH="\$HOME/.cabal/bin:${GHCUP_BIN}:\$PATH"
+		case ":\$PATH:" in
+		    *:"${GHCUP_BIN}":*)
+		        ;;
+		    *)
+		        export PATH="${GHCUP_BIN}:\$PATH"
+		        ;;
+		esac
+		case ":\$PATH:" in
+		    *:"\$HOME/.cabal/bin":*)
+		        ;;
+		    *)
+		        export PATH="\$HOME/.cabal/bin:\$PATH"
+		        ;;
+		esac
 		EOF
 
 	# shellcheck disable=SC1090
@@ -369,12 +423,38 @@ adjust_bashrc() {
 	case $1 in
 		1)
 			cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
-				export PATH="\$HOME/.cabal/bin:${GHCUP_BIN}:\$PATH"
+				case ":\$PATH:" in
+				    *:"${GHCUP_BIN}":*)
+				        ;;
+				    *)
+				        export PATH="${GHCUP_BIN}:\$PATH"
+				        ;;
+				esac
+				case ":\$PATH:" in
+				    *:"\$HOME/.cabal/bin":*)
+				        ;;
+				    *)
+				        export PATH="\$HOME/.cabal/bin:\$PATH"
+				        ;;
+				esac
 				EOF
 			;;
 		2)
 			cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
-				export PATH="\$PATH:\$HOME/.cabal/bin:${GHCUP_BIN}"
+				case ":\$PATH:" in
+				    *:"\$HOME/.cabal/bin":*)
+				        ;;
+				    *)
+				        export PATH="\$PATH:\$HOME/.cabal/bin"
+				        ;;
+				esac
+				case ":\$PATH:" in
+				    *:"${GHCUP_BIN}":*)
+				        ;;
+				    *)
+				        export PATH="\$PATH:${GHCUP_BIN}"
+				        ;;
+				esac
 				EOF
 			;;
 		*) ;;
@@ -389,23 +469,23 @@ adjust_bashrc() {
 					;;
 				fish)
 					mkdir -p "${GHCUP_PROFILE_FILE%/*}"
-					sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
+					sed -i -e '/# ghcup-env$/ s/^#*/#/' "$(posix_realpath "${GHCUP_PROFILE_FILE}")"
 					case $1 in
 						1)
-							echo "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN \$PATH # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
+							printf "\n%s" "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN \$PATH # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
 							;;
 						2)
-							echo "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin \$PATH $GHCUP_BIN # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
+							printf "\n%s" "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin \$PATH $GHCUP_BIN # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
 							;;
 					esac
 					;;
 				bash)
-					sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
+					sed -i -e '/# ghcup-env$/ s/^#*/#/' "$(posix_realpath "${GHCUP_PROFILE_FILE}")"
-					echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
+					printf "\n%s" "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
 					case "${plat}" in
 						"Darwin"|"darwin")
 							if ! grep -q "ghcup-env" "${HOME}/.bash_profile" ; then
-								echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
+								printf "\n%s" "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
 							fi
 							;;
 						MSYS*|MINGW*)
@@ -419,8 +499,8 @@ adjust_bashrc() {
 					;;
 
 				zsh)
-					sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
+					sed -i -e '/# ghcup-env$/ s/^#*/#/' "$(posix_realpath "${GHCUP_PROFILE_FILE}")"
-					echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
+					printf "\n%s" "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
 					;;
 			esac
 			echo
@@ -487,7 +567,7 @@ ask_cabal_config_init() {
 						esac
 					done
 				else
-					return 1
+					return 0
 				fi
 				;;
 	esac
@@ -505,8 +585,8 @@ do_cabal_config_init() {
 				adjust_cabal_config
 				;;
 			0)
-				echo "Make sure that your global cabal.config references the correct mingw64 paths (extra-prog-path, extra-include-dirs and extra-lib-dirs)."
+				warn "Make sure that your global cabal.config references the correct mingw64 paths (extra-prog-path, extra-include-dirs and extra-lib-dirs)."
-				echo "And set the environment variable GHCUP_MSYS2 to the root path of your msys2 installation."
+				warn "And set the environment variable GHCUP_MSYS2 to the root path of your msys2 installation."
 				sleep 5
 				return ;;
 			*) ;;
@@ -679,7 +759,7 @@ if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
 
 	do_cabal_config_init $ask_cabal_config_init_answer
 
-	edo cabal new-update
+	edo cabal new-update --ignore-project
 else # don't install ghc and cabal
 	case "${plat}" in
 			MSYS*|MINGW*)

scripts/bootstrap/bootstrap-haskell.ps1

@@ -29,11 +29,11 @@ param (
     [switch]$InstallStack,
     # Whether to install hls as well
     [switch]$InstallHLS,
-    # Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
-    [string]$InstallDir,
-    # Instead of installing a new MSys2, use an existing installation
-    [string]$BootstrapUrl,
     # Specify the install root (default: 'C:\')
+    [string]$InstallDir,
+    # Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
+    [string]$BootstrapUrl,
+    # Instead of installing a new MSys2, use an existing installation
     [string]$ExistingMsys2Dir,
     # Specify the cabal root directory (default: '$InstallDir\cabal')
     [string]$CabalDir
@@ -246,6 +246,7 @@ if ($Silent -and !($InstallDir)) {
       $GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix)
     }
   
+    $GhcupBasePrefix = $GhcupBasePrefix.TrimEnd().TrimStart()
     if (!($GhcupBasePrefix)) {
       Print-Msg -color Red -msg "No directory specified!"
     } elseif (!(Test-Path -LiteralPath ('{0}' -f $GhcupBasePrefix))) {
@@ -333,6 +334,7 @@ if ($CabalDir) {
     $CabalDirPrompt = Read-Host
     $CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt]
 
+    $CabDirEnv = $CabDirEnv.TrimEnd().TrimStart()
     if (!($CabDirEnv)) {
       Print-Msg -color Red -msg "No directory specified!"         
     } elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
@@ -401,16 +403,17 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
     # Download the archive
     Print-Msg -msg 'Downloading Msys2 archive...'
     $archive = 'msys2-x86_64-latest.sfx.exe'
+    $archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
     
     if (Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) {
-      Exec "curl.exe" '-o' ('{0}\{1}' -f $env:TEMP, $archive) ('https://repo.msys2.org/distrib/{0}' -f $archive)
+      Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/{0}' -f "$archive")
     } else {
-      Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder "$env:TEMP" -includeStats
+      Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
     }
 
     Print-Msg -msg 'Extracting Msys2 archive...'
-    $null = & "$env:TEMP\$archive" '-y' ('-o{0}' -f $GhcupDir)  # Extract
+    $null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir)  # Extract
-    Remove-Item -Path ('{0}/{1}' -f $env:TEMP, $archive)
+    Remove-Item -Path "$archivePath"
 
     Print-Msg -msg 'Processing MSYS2 bash for first time use...'
     Exec "$Bash" '-lc' 'exit'
@@ -444,6 +447,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
         Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:' 
         $MsysDir = Read-Host
       }
+      $MsysDir = $MsysDir.TrimEnd().TrimStart()
       if (!($MsysDir)) {
         Print-Msg -color Red -msg "No directory specified!"         
       } elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) {

scripts/releasing/pull_release_artifacts.sh

@@ -0,0 +1,49 @@
+
+set -eu
+
+tag=v$1
+ver=$1
+
+dest=$2
+gpg_user=$3
+
+mkdir -p "${dest}"
+
+cd "${dest}"
+
+base_url="https://gitlab.haskell.org/api/v4/projects/618/jobs/artifacts/${tag}/raw"
+
+curl -f -o "x86_64-apple-darwin-ghcup-${ver}" \
+	"${base_url}/out/x86_64-apple-darwin-ghcup-${ver}?job=release:darwin"
+
+curl -f -o "aarch64-apple-darwin-ghcup-${ver}" \
+	"${base_url}/out/aarch64-apple-darwin-ghcup-${ver}?job=release:darwin:aarch64"
+
+curl -f -o "x86_64-freebsd12-ghcup-${ver}" \
+	"${base_url}/out/x86_64-portbld-freebsd-ghcup-${ver}?job=release:freebsd12"
+
+curl -f -o "x86_64-freebsd13-ghcup-${ver}" \
+	"${base_url}/out/x86_64-portbld-freebsd-ghcup-${ver}?job=release:freebsd13"
+
+curl -f -o "i386-linux-ghcup-${ver}" \
+	"${base_url}/out/i386-linux-ghcup-${ver}?job=release:linux:32bit"
+
+curl -f -o "x86_64-linux-ghcup-${ver}" \
+	"${base_url}/out/x86_64-linux-ghcup-${ver}?job=release:linux:64bit"
+
+curl -f -o "aarch64-linux-ghcup-${ver}" \
+	"${base_url}/out/aarch64-linux-ghcup-${ver}?job=release:linux:aarch64"
+
+curl -f -o "armv7-linux-ghcup-${ver}" \
+	"${base_url}/out/armv7-linux-ghcup-${ver}?job=release:linux:armv7"
+
+curl -f -o "x86_64-mingw64-ghcup-${ver}.exe" \
+	"${base_url}/out/x86_64-mingw64-ghcup-${ver}.exe?job=release:windows"
+
+rm -f *.sig
+sha256sum *-ghcup-* > SHA256SUMS
+gpg --detach-sign -u ${gpg_user} SHA256SUMS
+for f in *-ghcup-* ; do gpg --detach-sign -u ${gpg_user} $f ; done
+
+
+

scripts/releasing/sftp-symlink-artifacts.sh

@@ -0,0 +1,39 @@
+#!/bin/bash
+
+url=$1
+ver=$2
+
+die() {
+    (>&2 printf "%s\\n" "$1")
+    exit 2
+}
+
+[ -z $url ] && die "no url set"
+[ -z $ver ] && die "no version set"
+
+sftp $url <<EOF
+cd ghcup
+
+rm aarch64-apple-darwin-ghcup
+rm aarch64-linux-ghcup
+rm armv7-linux-ghcup
+rm i386-linux-ghcup
+rm x86_64-apple-darwin-ghcup
+rm x86_64-linux-ghcup
+rm x86_64-mingw64-ghcup.exe
+rm x86_64-freebsd12-ghcup
+rm x86_64-freebsd13-ghcup
+
+symlink ${ver}/aarch64-apple-darwin-ghcup-${ver} aarch64-apple-darwin-ghcup
+symlink ${ver}/aarch64-linux-ghcup-${ver} aarch64-linux-ghcup
+symlink ${ver}/armv7-linux-ghcup-${ver} armv7-linux-ghcup
+symlink ${ver}/i386-linux-ghcup-${ver} i386-linux-ghcup
+symlink ${ver}/x86_64-apple-darwin-ghcup-${ver} x86_64-apple-darwin-ghcup
+symlink ${ver}/x86_64-freebsd12-ghcup-${ver} x86_64-freebsd12-ghcup
+symlink ${ver}/x86_64-freebsd13-ghcup-${ver} x86_64-freebsd13-ghcup
+symlink ${ver}/x86_64-linux-ghcup-${ver} x86_64-linux-ghcup
+symlink ${ver}/x86_64-mingw64-ghcup-${ver}.exe x86_64-mingw64-ghcup.exe
+EOF
+
+curl -X PURGE https://downloads.haskell.org/~ghcup/
+curl -X PURGE https://downloads.haskell.org/ghcup/

scripts/releasing/sftp-upload-artifacts.sh

@@ -0,0 +1,47 @@
+#!/bin/bash
+
+url=$1
+ver=$2
+artifacts_dir=$3
+
+die() {
+    (>&2 printf "%s\\n" "$1")
+    exit 2
+}
+
+[ -z $url ] && die "no url set"
+[ -z $ver ] && die "no version set"
+[ -z "${artifacts_dir}" ] && die "artifacts_dir not set"
+[ -e "${artifacts_dir}" ] || die "artifacts_dir \"${artifacts_dir}\" does not exist"
+
+cd "${artifacts_dir}"
+
+sftp $url <<EOF
+cd ghcup
+
+mkdir ${ver}
+cd ${ver}
+put SHA256SUMS
+put SHA256SUMS.sig
+put aarch64-apple-darwin-ghcup-${ver}
+put aarch64-apple-darwin-ghcup-${ver}.sig
+put aarch64-linux-ghcup-${ver}
+put aarch64-linux-ghcup-${ver}.sig
+put armv7-linux-ghcup-${ver}
+put armv7-linux-ghcup-${ver}.sig
+put i386-linux-ghcup-${ver}
+put i386-linux-ghcup-${ver}.sig
+put x86_64-apple-darwin-ghcup-${ver}
+put x86_64-apple-darwin-ghcup-${ver}.sig
+put x86_64-freebsd12-ghcup-${ver}
+put x86_64-freebsd12-ghcup-${ver}.sig
+put x86_64-freebsd13-ghcup-${ver}
+put x86_64-freebsd13-ghcup-${ver}.sig
+put x86_64-linux-ghcup-${ver}
+put x86_64-linux-ghcup-${ver}.sig
+put x86_64-mingw64-ghcup-${ver}.exe
+put x86_64-mingw64-ghcup-${ver}.exe.sig
+EOF
+
+curl -X PURGE https://downloads.haskell.org/~ghcup/${ver}/
+curl -X PURGE https://downloads.haskell.org/ghcup/${ver}/

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-18.12
+resolver: lts-18.27
 
 packages:
   - .
@@ -16,7 +16,7 @@ extra-deps:
   - composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
   - haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
   - haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
-  - haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159
+  - haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200
   - heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
   - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
   - hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615

test/GHCup/Types/JSONSpec.hs

@@ -3,7 +3,7 @@
 module GHCup.Types.JSONSpec where
 
 import           GHCup.ArbitraryTypes ()
-import           GHCup.Types
+import           GHCup.Types hiding ( defaultSettings )
 import           GHCup.Types.JSON ()
 
 import           Test.Aeson.GenericSpecs