Disable cabal XDG by default

Fixes #958

.github/scripts/test.sh

@@ -30,32 +30,32 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
 
 ### Haskell test suite
 
-./ghcup-test${ext}
+./"ghcup-test${ext}"
-./ghcup-test-optparse${ext}
+./"ghcup-test-optparse${ext}"
-rm ghcup-test${ext} ghcup-test-optparse${ext}
+rm "ghcup-test${ext}" "ghcup-test-optparse${ext}"
 
 ### manual cli based testing
 
 eghcup --numeric-version
 
-eghcup install ghc ${GHC_VER}
+eghcup install ghc "${GHC_VER}"
-eghcup unset ghc ${GHC_VER}
+eghcup unset ghc "${GHC_VER}"
-ls -lah "$(eghcup whereis -d ghc ${GHC_VER})"
+ls -lah "$(eghcup whereis -d ghc "${GHC_VER}")"
-[ "`$(eghcup whereis ghc ${GHC_VER}) --numeric-version`" = "${GHC_VER}" ]
+[ "$($(eghcup whereis ghc "${GHC_VER}") --numeric-version)" = "${GHC_VER}" ]
-[ "`eghcup run --ghc ${GHC_VER} -- ghc --numeric-version`" = "${GHC_VER}" ]
+[ "$(eghcup run -q --ghc "${GHC_VER}" -- ghc --numeric-version)" = "${GHC_VER}" ]
-[ "`ghcup run --ghc ${GHC_VER} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VER}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
+[ "$(ghcup run -q --ghc "${GHC_VER}" -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" = "$($(ghcup whereis ghc "${GHC_VER}") -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" ]
-eghcup set ghc ${GHC_VER}
+eghcup set ghc "${GHC_VER}"
-eghcup install cabal ${CABAL_VER}
+eghcup install cabal "${CABAL_VER}"
-[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
+[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
 eghcup unset cabal
 "$GHCUP_BIN"/cabal --version && exit 1 || echo yes
 
 # make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
 # https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
-[ "`eghcup run --cabal ${CABAL_VER} -- cabal --numeric-version`" = "${CABAL_VER}" ]
+[ "$(eghcup run -q --cabal "${CABAL_VER}" -- cabal --numeric-version)" = "${CABAL_VER}" ]
-eghcup set cabal ${CABAL_VER}
+eghcup set cabal "${CABAL_VER}"
 
-[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
+[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
 
 if [ "${OS}" != "FreeBSD" ] ; then
 	if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
@@ -85,10 +85,10 @@ eghcup list -t cabal
 
 ghc_ver=$(ghc --numeric-version)
 ghc --version
-ghc-${ghc_ver} --version
+"ghc-${ghc_ver}" --version
 if [ "${OS}" != "Windows" ] ; then
 		ghci --version
-		ghci-${ghc_ver} --version
+		"ghci-${ghc_ver}" --version
 fi
 
 
@@ -132,11 +132,11 @@ else
 	eghcup --offline set 8.10.3
 	eghcup set 8.10.3
 	[ "$(ghc --numeric-version)" = "8.10.3" ]
-	eghcup set ${GHC_VER}
+	eghcup set "${GHC_VER}"
 	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
 	eghcup unset ghc
     "$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes
-	eghcup set ${GHC_VER}
+	eghcup set "${GHC_VER}"
 	eghcup --offline rm 8.10.3
 	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
 
@@ -169,10 +169,10 @@ 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"
-eghcup whereis ghc $(ghc --numeric-version)
+eghcup whereis ghc "$(ghc --numeric-version)"
 mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
 
-eghcup rm $(ghc --numeric-version)
+eghcup rm "$(ghc --numeric-version)"
 
 # https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
 if [ "${OS}" = "Linux" ] ; then
@@ -186,7 +186,7 @@ eghcup gc -c
 
 # test etags
 rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
-raw_eghcup -s https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml list
+raw_eghcup -s "https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml" list
 # snapshot yaml and etags file
 etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
 sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")

.github/workflows/release.yaml

@@ -322,7 +322,7 @@ jobs:
         with:
           name: testfiles
           path: |
-            ./test/golden/unix/GHCupInfo*json
+            ./test/ghcup-test/golden/unix/GHCupInfo*json
 
   test-arm:
     name: Test ARM
@@ -389,7 +389,7 @@ jobs:
         with:
           name: testfiles
           path: |
-            ./test/golden/unix/GHCupInfo*json
+            ./test/ghcup-test/golden/unix/GHCupInfo*json
 
   test-macwin:
     name: Test Mac/Win
@@ -458,7 +458,7 @@ jobs:
         with:
           name: testfiles
           path: |
-            ./test/golden/windows/GHCupInfo*json
+            ./test/ghcup-test/golden/windows/GHCupInfo*json
 
       - if: failure() && runner.os != 'Windows'
         name: Upload artifact
@@ -466,7 +466,7 @@ jobs:
         with:
           name: testfiles
           path: |
-            ./test/golden/unix/GHCupInfo*json
+            ./test/ghcup-test/golden/unix/GHCupInfo*json
   hls:
     name: hls
     needs: build-linux

.gitmodules

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

CHANGELOG.md

@@ -1,8 +1,20 @@
 # Revision history for ghcup
 
-## 0.1.19.5 -- ????-?-??
+## 0.1.20.0 -- 2023-11-10
 
-* support JS cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838)
+### New features
+
+* support TUI on windows thanks to the work from vty and brick maintainers (Chris Hackett, Timofey Zakrevskiy, Jonathan Daugherty, ...), wrt [#912](https://github.com/haskell/ghcup-hs/pull/912)
+* support JS and wasm cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838), thanks to Sylvain Henry and IOG
+* Support stacks installation strategy and metadata wrt [#892](https://github.com/haskell/ghcup-hs/issues/892)
+  - you can now enable stacks installation method via `ghcup config set url-source '["GHCupURL", "StackSetupURL"]'`... for more information, check the [documentation](https://www.haskell.org/ghcup/guide/#using-stacks-setup-info-metadata-to-install-ghc)
+
+### Improvements and bug fixes
+
+* fix segfault in TUI when hitting enter early wrt [#887](https://github.com/haskell/ghcup-hs/issues/887)
+* Improve key handling in TUI, fixes [#875](https://github.com/haskell/ghcup-hs/issues/875)
+* add explicit support for Void Linux and Rocky Linux (this requires a metadata version bump to `ghcup-0.0.8.yaml`)
+* optparse cli interface now has a test suite thanks to Lei Zhu, wrt [#862](https://github.com/haskell/ghcup-hs/pull/862)
 
 ## 0.1.19.4 -- 2023-7-02
 

app/ghcup/Main.hs

@@ -42,7 +42,6 @@ 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
@@ -85,7 +84,7 @@ toSettings options = do
          keepDirs    = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
          downloader  = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
          keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
-         urlSource   = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) (OwnSource . (:[]) . Right) optUrlSource
+         urlSource   = fromMaybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) optUrlSource
          noNetwork   = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
          gpgSetting  = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
          platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
@@ -108,7 +107,6 @@ toSettings options = do
          , bSet = fromMaybe bSet kSet
          , bChangelog = fromMaybe bChangelog kChangelog
          , bShowAllVersions = fromMaybe bShowAllVersions kShowAll
-         , bShowAllTools = fromMaybe bShowAllTools kShowAllTools
          }
 
 
@@ -211,10 +209,9 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
                                             exitWith (ExitFailure 2)
 
                 ghcupInfo <-
-                  ( flip runReaderT leanAppstate
+                  ( flip runReaderT leanAppstate . runE @'[ContentLengthError, DigestError, DistroNotFound, DownloadFailed, FileDoesNotExistError, GPGError, JSONError, NoCompatibleArch, NoCompatiblePlatform, NoDownload, GHCup.Errors.ParseError, ProcessError, UnsupportedSetupCombo, StackPlatformDetectError] $ do
-                    . runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
+                     liftE $ getDownloadsF pfreq
-                    $ liftE getDownloadsF
+                  )
-                    )
                     >>= \case
                           VRight r -> pure r
                           VLeft  e -> do
@@ -263,7 +260,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
                          Just _ -> pure ()
 
                 -- TODO: always run for windows
-                siletRunLogger (flip runReaderT s' $ runE ensureGlobalTools) >>= \case
+                siletRunLogger (flip runReaderT s' $ runE ensureShimGen) >>= \case
                   VRight _ -> pure ()
                   VLeft e -> do
                     runLogger
@@ -341,9 +338,9 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
                           ] 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 (InstallCabal InstallOptions{..})))   (Cabal, ver)    = cmp' Cabal instVer ver
-  alreadyInstalling (Install (Left (InstallHLS InstallOptions{..})))     (HLS, ver)   = cmp' HLS 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 (Install (Left (InstallStack InstallOptions{..})))   (Stack, ver)    = cmp' Stack instVer ver
   alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
     (GHC, ver)   = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
   alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
@@ -378,3 +375,4 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
   cmp' tool instVer ver = do
     (v, _) <- liftE $ fromVersion instVer tool
     pure (v == ver)
+

cabal.project

@@ -8,6 +8,11 @@ package ghcup
 constraints: http-io-streams -brotli,
              any.aeson >= 2.0.1.0
 
+source-repository-package
+  type: git
+  location: https://github.com/fosskers/versions.git
+  tag: 7bc3355348aac3510771d4622aff09ac38c9924d
+
 package libarchive
   flags: -system-libarchive
 
@@ -24,4 +29,4 @@ package streamly
   flags: +use-unliftio
 
 package *
-  test-show-details: direct
+  test-show-details: direct

cabal.project.release

@@ -4,30 +4,26 @@ optional-packages: ./vendored/*/*.cabal
 
 optimization: 2
 
+package ghcup
+  flags: +tui
+
 if os(linux)
-  package ghcup
-    flags: +tui
   if arch(x86_64) || arch(i386)
     package *
       ghc-options: -split-sections -optl-static
 elif os(darwin)
   constraints: zlib +bundled-c-zlib,
                lzma +static
-  package ghcup
-    flags: +tui
 elif os(mingw32)
   constraints: zlib +bundled-c-zlib,
                lzma +static,
-               text -simdutf
+               text -simdutf,
-  package ghcup
+			   vty-windows >=0.1.0.3
-    flags: -tui
 elif os(freebsd)
   constraints: zlib +bundled-c-zlib,
                zip +disable-zstd
   package *
     ghc-options: -split-sections -pgmc clang++14
-  package ghcup
-    flags: +tui
 
 constraints: http-io-streams -brotli,
              any.aeson >= 2.0.1.0,

data/config.yaml

@@ -16,6 +16,11 @@ gpg-setting: GPGNone # GPGStrict | GPGLax | GPGNone
 # TUI key bindings,
 # see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
 # for possible values.
+# It's also possible to define key+modifier, e.g.:
+#   quit:
+#     Key:
+#       KChar: c
+#     Mods: [MCtrl]
 key-bindings:
   up:
     KUp: []
@@ -46,41 +51,45 @@ meta-cache: 300 # in seconds
 #   2. Strict: fail hard
 meta-mode: Lax # Strict | Lax
 
-# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
+# Where to get GHC/cabal/hls download info/versions from. This is a list that performs
-# check the 'URLSource' type in the code.
+# union over tool versions, preferring the later entries.
 url-source:
   ## Use the internal download uri, this is the default
-  GHCupURL: []
+  - GHCupURL
 
-  ## Example 1: Read download info from this location instead
+  ## Prefer stack supplied metadata (will still use GHCup metadata for versions not existing in stack metadata)
-  ## Accepts file/http/https scheme
+  # - StackSetupURL
-  ## 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.
+  ## Add pre-release channel
-  ## Can also be an array of 'Either GHCupInfo URL', also see Example 3.
+  # - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
-  # AddSource:
+  ## Add nightly channel
-    # Left:
+  # - https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
-      # globalTools: {}
+  ## Add cross compiler channel
-      # toolRequirements: {}
+  # - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
-      # ghcupDownloads:
-        # GHC:
-          # 9.10.2:
-            # viTags: []
-            # viArch:
-              # A_64:
-                # Linux_UnknownLinux:
-                  # unknown_versioning:
-                    # dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-deb8-linux.tar.bz2
-                    # dlSubdir: ghc-7.10.3
-                    # dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
 
-  ## Example 3: Add multiple custom download files to the default downloads via right-biased merge (overwriting duplicate
+  ## Use dwarf bindist for 9.4.7 for ghcup metadata
-  ## versions).
+  # - ghcup-info:
-  # AddSource:
+  #     ghcupDownloads:
-    # - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
+  #       GHC:
-    # - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
+  #         9.4.7:
+  #           viTags: []
+  #           viArch:
+  #             A_64:
+  #               Linux_UnknownLinux:
+  #                 unknown_versioning:
+  #                   dlUri: https://downloads.haskell.org/ghc/9.4.7/ghc-9.4.7-x86_64-deb10-linux-dwarf.tar.xz
+  #                   dlSubdir:
+  #                     RegexDir: "ghc-.*"
+  #                   dlHash: b261b3438ba455e3cf757f9c8dc3a06fdc061ea8ec287a65b7809e25fe18bad4
+
+  ## for stack metadata and the linux64-tinfo6 bindists, use static alpine for 9.8.1
+  # - setup-info:
+  #     ghc:
+  #       linux64-tinfo6:
+  #         9.8.1:
+  #           url: "https://downloads.haskell.org/~ghc/9.8.1/ghc-9.8.1-x86_64-alpine3_12-linux-static.tar.xz"
+  #           content-length: 229037440
+  #           sha256: b48f3d3a508d0c140d1c801e04afc65e80c0d25e7e939a8a41edb387b26b81b3
 
 # This is a way to override platform detection, e.g. when you're running
 # a Ubuntu derivate based on 18.04, you could do:

docs/guide.md

@@ -4,7 +4,7 @@ This is a more in-depth guide specific to GHCup. `ghcup --help` is your friend.
 
 ## Basic usage
 
-For the simple, interactive, text-based user interface (TUI) (not available on windows), run:
+For the simple, interactive, text-based user interface (TUI), run:
 
 ```sh
 ghcup tui
@@ -43,6 +43,12 @@ All of the following are valid arguments to `ghcup install ghc`:
 
 If the argument is omitted, the default is `recommended`.
 
+Other tags include:
+
+- `prerelease`: a prerelease version
+- `latest-prerelease`: the latest prerelease version
+
+
 ## Manpages
 
 For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
@@ -61,8 +67,7 @@ and make sure your bashrc sources the startup script
 
 `ghcup` is very portable. There are a few exceptions though:
 
-1. `ghcup tui` is only available on non-windows platforms
+1. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
-2. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
 
 # Configuration
 
@@ -89,7 +94,7 @@ platform-override:
 
 This is the complete list of env variables that change GHCup behavior:
 
-* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) above
+* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) below
 * `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
 * `GHCUP_CURL_OPTS`: additional options that can be passed to curl
 * `GHCUP_WGET_OPTS`: additional options that can be passed to wget
@@ -136,50 +141,29 @@ If you experience problems, consider clearing the cache via `ghcup gc --cache`.
 
 ## Metadata
 
-The metadata are the files that describe tool versions, where to download them etc. and
+Metadata files are also called release or distribution channels. They describe tool versions, where to download them etc. and
-can be viewed here: [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata)
+can be viewed here: [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata).
 
-### Mirrors
+See the [description](https://github.com/haskell/ghcup-metadata#metadata-variants-distribution-channels)
+of metadata files to understand their purpose. These can be combined.
 
-GHCup allows to use custom mirrors/download-info hosted by yourself or 3rd parties.
+For example, if you want access to both prerelease and cross bindists, you'd do:
-
-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://github.com/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)
-2. [https://mirrors.ustc.edu.cn/help/ghcup.html](https://mirrors.ustc.edu.cn/help/ghcup.html)
-
-### (Pre-)Release channels
-
-A release channel is basically just a metadata file location. You can add additional release
-channels that complement the default one, such as the **prerelease channel** like so:
 
 ```sh
 ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
+ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
 ```
 
-This will result in `~/.ghcup/config.yaml` to contain this record:
+This results in the following configuration in `~/.ghcup/config.yaml`:
 
-```yml
+```yaml
 url-source:
-  AddSource:
+# the base url that contains all the release bindists
-  - Right: https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
+- GHCupURL
+# prereleases
+- https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml
+# cross bindists
+- https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
 ```
 
 You can add as many channels as you like. They are combined under *Last*, so versions from the prerelease channel
@@ -189,46 +173,68 @@ To remove the channel, delete the entire `url-source` section or set it back to
 
 ```yml
 url-source:
-  GHCupURL: []
+  - GHCupURL
 ```
 
-If you want to combine your release channel with a mirror, you'd do it like so:
+Also see [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml)
+for more options.
+
+You can also use an alternative metadata via one-shot cli option:
+
+```sh
+ghcup --url-source=https://some-url/ghcup-0.0.8.yaml tui
+```
+
+One main caveat of using URLs is that you might need to check whether there are new versions
+of the file (e.g. `ghcup-0.0.7.yaml` vs `ghcup-0.0.8.yaml`). Although old metadata files
+are supported for some time, they are not so indefinitely.
+
+### Mirrors
+
+Metadata files can also be used to operate 3rd party mirrors, in which case you want to use
+a URL instead of the `GHCupURL` alias. E.g. in `~/.ghcup/config.yaml`, you'd do:
 
 ```yml
 url-source:
-  OwnSource:
+  - https://mirror.sjtu.edu.cn/ghcup/yaml/ghcup/data/ghcup-0.0.6.yaml
-  # base metadata
-  - "https://mirror.sjtu.edu.cn/ghcup/yaml/ghcup/data/ghcup-0.0.6.yaml"
-  # prerelease channel
-  - "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
 ```
 
-### Nightlies
+Note that later versions of GHCup allow more sophisticated mirror support, see [here](./#mirrors-proper).
 
-Nightlies are just another release channel. Currently, only GHC supports nightlies, which are binary releases
+#### Known mirrors
-that are built every night from `master`.
 
-To add the nightly channel, run:
+1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup)
+2. [https://mirrors.ustc.edu.cn/help/ghcup.html](https://mirrors.ustc.edu.cn/help/ghcup.html)
+
+### Git based metadata config
+
+If you don't like the way ghcup updates its metadata with caching and fetching via curl, you can also do as follows:
+
+Clone the metadata git repo:
 
 ```sh
-ghcup config add-release-channel https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
+mkdir -p /home/user/git/
+cd /home/user/git/
+git clone -b master https://github.com/haskell/ghcup-metadata.git
 ```
 
-To list all nightlies from 2023, run:
+Then tell ghcup to use file locations in `~/.ghcup/config.yaml`, e.g.:
 
-```sh
+```yaml
-ghcup list --show-nightly --tool=ghc --since=2023-01-01
+url-source:
+- file:///home/user/git/ghcup-metadata/ghcup-0.0.8.yaml
+- file:///home/user/git/ghcup-metadata/ghcup-cross-0.0.8.yaml
+- file:///home/user/git/ghcup-metadata/ghcup-prereleases-0.0.8.yaml
 ```
 
-Ways to install a nightly:
+Now, if you invoke `ghcup tui`, it will open instantly without any download, since it just
+reads the metadata from local disk.
+
+You'll have to update the metadata manually though, like so:
 
 ```sh
-# by date
+cd /home/user/git/
-ghcup install ghc 2023-06-20
+git pull --ff-only origin master
-# by version
-ghcup install ghc 9.7.20230619
-# by tag
-ghcup install ghc latest-nightly
 ```
 
 ## Stack integration
@@ -236,17 +242,7 @@ ghcup install ghc latest-nightly
 Stack manages GHC versions internally by default. In order to make it use ghcup installed
 GHC versions there are two strategies.
 
-### Strategy 1: System GHC (works on all stack versions)
+### Strategy 1: Stack hooks (new, recommended)
-
-You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
-run the following commands:
-
-```sh
-stack config set install-ghc false --global
-stack config set system-ghc  true  --global
-```
-
-### Strategy 2: Stack hooks (new, recommended)
 
 Since stack 2.9.1 you can customize the installation logic of GHC completely, see [https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation](https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation).
 
@@ -268,6 +264,61 @@ stack config set system-ghc false --global
 By default, when the hook fails for whatever reason, stack will fall back to its own installation logic. To disable
 this, run `stack config set install-ghc false --global`.
 
+### Strategy 2: System GHC (works on all stack versions)
+
+You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
+run the following commands:
+
+```sh
+stack config set install-ghc false --global
+stack config set system-ghc  true  --global
+```
+
+### Using stack's setup-info metadata to install GHC
+
+You can now use stack's [setup-info metadata](https://github.com/commercialhaskell/stackage-content/blob/master/stack/stack-setup-2.yaml)
+to install GHC. For that, you can invoke ghcup like so as a shorthand:
+
+```sh
+# ghcup will only see GHC now
+ghcup -s StackSetupURL install ghc 9.4.7
+# this combines both ghcup and stack metadata
+ghcup -s '["GHCupURL", "StackSetupURL"]' install ghc 9.4.7
+```
+
+To make this permanent and combine it with the GHCup metadata, you can add the following to your `~/.ghcup/config.yaml`:
+
+```yaml
+url-source:
+  - GHCupURL
+  # stack versions take precedence
+  # you'll still have access to GHCup provided versions and tools in case they don't exist in stack metadata
+  - StackSetupURL
+```
+
+You can customize or add sections to the setup-info similar to how the [stack documentation](https://docs.haskellstack.org/en/stable/yaml_configuration/#setup-info) explains it. E.g. to change the 9.4.7 bindist, you might do:
+
+```yaml
+url-source:
+  - GHCupURL
+  - StackSetupURL
+  - setup-info:
+      ghc:
+        linux64-tinfo6:
+          9.4.7:
+            url: "https://downloads.haskell.org/~ghc/9.4.7/ghc-9.4.7-x86_64-fedora27-linux.tar.xz"
+            content-length: 179117892
+            sha256: 216b76b7c6383e6ad9ba82533f323f8550e52893a8b9fa33c7b9dc4201ac766a
+```
+
+#### Caveats
+
+The main caveat with using this method is that there's no guarantee that GHCup will pick a compatible HLS bindist
+when you try to install HLS.
+
+Another potential usability issue is that the `latest` and `recommended` shorthands won't work anymore, since
+Stack metadata doesn't have a concept of those and we don't try to be smart when combining the metadatas.
+
 ### Windows
 
 On windows, you may find the following config options useful too:
@@ -275,6 +326,39 @@ On windows, you may find the following config options useful too:
 
 Also check out: [https://docs.haskellstack.org/en/stable/yaml_configuration](https://docs.haskellstack.org/en/stable/yaml_configuration)
 
+## Mirrors (proper)
+
+Mirrors are now supported via configuration, instead of specifying alternative metadata files.
+
+As an example, this would be a complete mirror configuration in `~/.ghcup/config.yaml`:
+
+```yaml
+mirrors:
+  # yaml download location, would result in:
+  #      https://raw.githubusercontent.com/haskell/ghcup-metadata/develop/ghcup-0.0.8.yaml
+  #   -> https://mirror.sjtu.edu.cn/ghcup/yaml/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml
+  "raw.githubusercontent.com":
+    authority:
+      host: "mirror.sjtu.edu.cn"
+    pathPrefix: "ghcup/yaml"
+  # for stack and some older HLS versions, would result in e.g.
+  #      https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz
+  #   -> https://mirror.sjtu.edu.cn/ghcup/github/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz
+  "github.com":
+    authority:
+      host: "mirror.sjtu.edu.cn"
+    pathPrefix: "ghcup/github"
+  # for all haskell.org hosted bindists, would result in e.g.
+  #      https://downloads.haskell.org/~ghc/9.8.1/ghc-9.8.1-x86_64-deb10-linux.tar.xz
+  #   -> https://mirror.sjtu.edu.cn/ghcup/haskell-downloads/~ghc/9.8.1/ghc-9.8.1-x86_64-deb10-linux.tar.xz
+  "downloads.haskell.org":
+    authority:
+      host: "mirror.sjtu.edu.cn"
+    pathPrefix: "downloads.haskell.org"
+```
+
+The configuration depends on the host of the mirror and they have to provide the correct configuration.
+
 # More on installation
 
 ## Customisation of the installation scripts
@@ -411,9 +495,9 @@ ghcup compile hls --git-ref master --git-describe-version --ghc 8.10.7 --ghc 9.2
 
 This however will create a new HLS version in ghcup, e.g. `1.7.0.0-105-gdc682ba1`, for both 8.10.7 and 9.2.4. If you want to switch back to the official bindists, run `ghcup set hls 1.7.0.0`.
 
-### Cross support
+## Cross support
 
-ghcup can compile and install a cross GHC for any target. However, this
+ghcup can compile a cross GHC for any target. However, this
 requires that the build host has a complete cross toolchain and various
 libraries installed for the target platform.
 
@@ -422,6 +506,76 @@ For distributions with non-standard locations of cross toolchain and
 libraries, this may need some tweaking of `build.mk` or configure args.
 See `ghcup compile ghc --help` for further information.
 
+Since ghcup version 0.1.20.0, we provide cross bindists for GHC JS and WASM. These can be installed conveniently.
+However, these are intended as a developer preview only. By using these GHC variants, you are implicitly signing up to participate in GHC development!
+If you run into bugs or missing behavior, join the dev chat at https://matrix.to/#/#GHC:matrix.org. 
+
+First, add the cross release channel:
+
+```sh
+ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/develop/ghcup-cross-0.0.8.yaml
+```
+
+The next sections explain how to install each cross bindist.
+
+### GHC JS cross bindists (experimental)
+
+You need the required emscripten JS toolchain:
+
+```sh
+git clone https://github.com/emscripten-core/emsdk.git
+cd emsdk
+./emsdk install latest
+./emsdk activate latest
+source ./emsdk_env.sh
+```
+
+Instructions are also here: [Download and install — Emscripten 3.1.43-git (dev) documentation](https://emscripten.org/docs/getting_started/downloads.html).
+
+To install we need to invoke ghcup like so:
+
+```sh
+emconfigure ghcup install ghc --set javascript-unknown-ghcjs-9.6.2
+```
+
+You'll now have the compiler `javascript-unknown-ghcjs-ghc`. To build a hello world, do e.g.:
+
+```sh
+echo 'main = putStrLn "hello world"' > hello.hs
+javascript-unknown-ghcjs-ghc -fforce-recomp hello.hs
+./hello
+```
+
+You can follow the instructions [here](https://gitlab.haskell.org/ghc/ghc/-/wikis/javascript-backend/building#compiling-hello-world).
+
+### GHC WASM cross bindists (experimental)
+
+You need the required wasm toolchain:
+
+```sh
+git clone https://gitlab.haskell.org/ghc/ghc-wasm-meta.git
+cd ghc-wasm-meta/
+export SKIP_GHC=yes
+./setup.sh
+source ~/.ghc-wasm/env
+```
+
+To install, we need to invoke ghcup like so also passing the `--host=<host>` flag (adjust as needed):
+
+```sh
+ghcup install ghc --set wasm32-wasi-9.6.3.20230927 -- --host=x86_64-linux --with-intree-gmp --with-system-libffi
+```
+
+Also check the documentation here: [Glasgow Haskell Compiler / ghc-wasm-meta](https://gitlab.haskell.org/ghc/ghc-wasm-meta).
+
+You'll now have the compiler `wasm32-wasi-ghc`. To build a hello world, do e.g.:
+
+```sh
+echo 'main = putStrLn "hello world"' > hello.hs
+wasm32-wasi-ghc hello.hs -o hello.wasm
+wasmtime ./hello.wasm
+```
+
 ## Isolated installs
 
 **Before using isolated installs, make sure to have at least GHCup version 0.1.17.8!**
@@ -478,8 +632,48 @@ variables and, in the case of Windows, parameters to tweak the script behavior.
 
 ### github workflows
 
-On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/).
+On github workflows GHCup itself is pre-installed on all platforms, but may use non-standard install locations.
-GHCup itself is also pre-installed on all platforms, but may use non-standard install locations.
+Here's an example workflow with a GHC matrix:
+
+```yaml
+jobs:
+  build:
+    runs-on: ${{ matrix.os }}
+    strategy:
+      fail-fast: true
+      matrix:
+        os: [ubuntu-22.04, macOS-latest]
+        ghc: ['9.6', '9.4', '9.2', '9.0', '8.10', '8.8', '8.6']
+    steps:
+    - uses: actions/checkout@v3
+    - name: Setup toolchain
+      run: |
+        ghcup install cabal --set recommended
+        ghcup install ghc --set ${{ matrix.ghc }}
+    - name: Build
+      run: |
+        cabal update
+        cabal test all --test-show-details=direct
+
+  i386:
+    runs-on: ubuntu-latest
+    container:
+      image: i386/ubuntu:bionic
+    steps:
+    - name: Install GHCup in container
+      run: |
+        apt-get update -y
+        apt-get install -y autoconf build-essential zlib1g-dev libgmp-dev curl
+        # we just go with recommended versions of cabal and GHC
+        curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 sh
+    - uses: actions/checkout@v1
+    - name: Test
+      run: |
+        # in containers we need to fix PATH
+        source ~/.ghcup/env
+        cabal update
+        cabal test all --test-show-details=direct
+```
 
 ## GPG verification
 
@@ -489,9 +683,10 @@ this is cryptographically secure.
 First, obtain the gpg keys:
 
 ```sh
-gpg --batch --keyserver keys.openpgp.org     --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
+gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
 gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
 gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
+gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
 ```
 
 Then verify the gpg key in one of these ways:

docs/install.md

@@ -38,49 +38,85 @@ Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information
 
 ### Linux Debian
 
+#### Generic
+
 The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
 
+#### Version >= 11 && <= 12
+
+The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
+
+#### Version >= 12
+
+The following distro packages are required: `build-essential curl libffi-dev libffi8 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
+
 ### Linux Ubuntu
 
+#### Generic
+
 The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
 
+#### Version >= 20.04 && < 20.10
+
+The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
+
+#### Version >= 20.10 && < 23
+
+The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
+
+#### Version >= 23
+
+The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev`
+
 ### Linux Fedora
 
+#### Generic
+
 The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
 
-### Linux Mageia
-
-The following distro packages are required: `curl gcc gcc-c++ gmp libffi-devel libffi7 libgmp-devel libgmp10 make libncurses-devel libncurses5 xz perl`
 
 ### Linux CentOS
 
+#### Generic
+
 The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
 
+#### Version >= 7 && < 8
+
+The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses xz perl`
+
+
 ### Linux Alpine
 
+#### Generic
+
 The following distro packages are required: `binutils-gold curl gcc g++ gmp-dev libc-dev libffi-dev make musl-dev ncurses-dev perl tar xz`
 
-### Linux VoidLinux
-
-The following distro packages are required: `gcc gmp curl coreutils xz ncurses make ncurses-libtinfo-libs perl tar`
 
 ### Linux (generic)
 
+#### Generic
+
 You need the following packages: curl g++ gcc gmp make ncurses realpath xz-utils. Consult your distro documentation on the exact names of those packages.
 
 ### Darwin
 
+#### Generic
+
 On OS X, in the course of running ghcup you will be given a dialog box to install the command line tools. Accept and the requirements will be installed for you. You will then need to run the command again.
 On Darwin M1 you might also need a working llvm installed (e.g. via brew) and have the toolchain exposed in PATH.
 
 ### FreeBSD
 
+#### Generic
+
 The following distro packages are required: `curl gcc gmp gmake ncurses perl5 libffi libiconv`
 
-Notice that only FreeBSD 13.x is supported. If the installation fails, complaining about `libncursesw.8.so`, you will need to install FreeBSD 12 compat package first, for example, `pkg install misc/compat12x`.
 
 ### Windows
 
+#### Generic
+
 On Windows, msys2 should already have been set up during the installation, so most users should just proceed. If you are installing manually, make sure to have a working mingw64 toolchain and shell.
 
 ## Next steps
@@ -104,16 +140,18 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
 <table>
 <thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
 <tbody>
-<tr><td>9.6.2</td><td><span style="color:blue">latest</span>, base-4.18.0.0</td></tr>
+<tr><td>9.8.1</td><td><span style="color:blue">latest</span>, base-4.19.0.0</td></tr>
+<tr><td>9.6.3</td><td>base-4.18.1.0</td></tr>
+<tr><td>9.6.2</td><td>base-4.18.0.0</td></tr>
 <tr><td>9.6.1</td><td>base-4.18.0.0</td></tr>
-<tr><td>9.4.7</td><td>base-4.17.2.0</td></tr>
+<tr><td>9.4.7</td><td><span style="color:green">recommended</span>, base-4.17.2.0</td></tr>
 <tr><td>9.4.6</td><td>base-4.17.2.0</td></tr>
 <tr><td>9.4.5</td><td>base-4.17.1.0</td></tr>
 <tr><td>9.4.4</td><td>base-4.17.0.0</td></tr>
 <tr><td>9.4.3</td><td>base-4.17.0.0</td></tr>
 <tr><td>9.4.2</td><td>base-4.17.0.0</td></tr>
 <tr><td>9.4.1</td><td>base-4.17.0.0</td></tr>
-<tr><td>9.2.8</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
+<tr><td>9.2.8</td><td>base-4.16.4.0</td></tr>
 <tr><td>9.2.7</td><td>base-4.16.4.0</td></tr>
 <tr><td>9.2.6</td><td>base-4.16.4.0</td></tr>
 <tr><td>9.2.5</td><td>base-4.16.4.0</td></tr>
@@ -154,7 +192,8 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
 <table>
 <thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
 <tbody>
-<tr><td>3.10.1.0</td><td><span style="color:blue">latest</span></td></tr>
+<tr><td>3.10.2.0</td><td><span style="color:blue">latest</span></td></tr>
+<tr><td>3.10.1.0</td><td></td></tr>
 <tr><td>3.8.1.0</td><td></td></tr>
 <tr><td>3.6.2.0</td><td><span style="color:green">recommended</span></td></tr>
 <tr><td>3.6.0.0</td><td></td></tr>
@@ -171,7 +210,9 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
 <table>
 <thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
 <tbody>
-<tr><td>2.2.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+<tr><td>2.4.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+<tr><td>2.3.0.0</td><td></td></tr>
+<tr><td>2.2.0.0</td><td></td></tr>
 <tr><td>2.1.0.0</td><td></td></tr>
 <tr><td>2.0.0.1</td><td></td></tr>
 <tr><td>2.0.0.0</td><td></td></tr>
@@ -196,8 +237,9 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
 <table>
 <thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
 <tbody>
-<tr><td>2.11.1</td><td><span style="color:blue">latest</span></td></tr>
+<tr><td>2.13.1</td><td><span style="color:blue">latest</span></td></tr>
-<tr><td>2.9.3</td><td><span style="color:green">recommended</span></td></tr>
+<tr><td>2.11.1</td><td><span style="color:green">recommended</span></td></tr>
+<tr><td>2.9.3</td><td></td></tr>
 <tr><td>2.9.1</td><td></td></tr>
 <tr><td>2.7.5</td><td></td></tr>
 <tr><td>2.7.3</td><td></td></tr>
@@ -213,7 +255,7 @@ This list may not be exhaustive and specifies support for bindists only.
 
 | Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
 | ------ | ------ | ------ | ------ | ------ | ------ | ------ |
-| Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
+| Windows 8.1 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
 | Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
 | Windows Server 2016 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
 | Windows Server 2019 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
@@ -229,12 +271,11 @@ This list may not be exhaustive and specifies support for bindists only.
 | Linux generic | aarch64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
 | Linux generic | armv7 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
 
-### Windows 7
+### Windows <8.1
 
-May or may not work, several issues:
+No longer supported for recent GHCs, according to manual testing of GHC 9.8.1 on Windows 7.
-
+According to [msys2 documentation](https://www.msys2.org/docs/windows_support), the minimum Windows
-* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140)
+version is now 8.1.
-* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197)
 
 ### WSL1
 
@@ -267,7 +308,14 @@ Lower availability of bindists. Stack and HLS binaries are experimental.
 Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
 and place it into your `PATH` anywhere.
 
-If you want to GPG verify the binaries, import the following keys first: `7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C` and `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`.
+If you want to GPG verify the binaries, import the following keys first:
+
+```sh
+gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
+gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
+gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
+gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
+```
 
 Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
 

ghcup.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               ghcup
-version:            0.1.19.5
+version:            0.1.20.0
 license:            LGPL-3.0-only
 license-file:       LICENSE
 copyright:          Julian Ospald 2020
@@ -25,10 +25,10 @@ extra-source-files:
   cbits/dirutils.h
   data/build_mk/cross
   data/build_mk/default
-  test/data/dir/.keep
+  test/ghcup-test/data/dir/.keep
-  test/data/file
+  test/ghcup-test/data/file
-  test/golden/unix/GHCupInfo.json
+  test/ghcup-test/golden/unix/GHCupInfo.json
-  test/golden/windows/GHCupInfo.json
+  test/ghcup-test/golden/windows/GHCupInfo.json
 
 source-repository head
   type:     git
@@ -36,7 +36,7 @@ source-repository head
 
 flag tui
   description:
-    Build the brick powered tui (ghcup tui). This is disabled on windows.
+    Build the brick powered tui (ghcup tui).
 
   default:     False
   manual:      True
@@ -86,8 +86,8 @@ common app-common-depends
     , unordered-containers   ^>=0.2
     , uri-bytestring         ^>=0.3.2.2
     , utf8-string            ^>=1.0
-    , vector                 ^>=0.12
+    , vector                 >=0.12     && <0.14
-    , versions               >=4.0.1    && <5.1
+    , versions               >=6.0.3    && <6.1
     , yaml-streamly          ^>=0.12.0
 
 library
@@ -117,7 +117,9 @@ library
     GHCup.Types
     GHCup.Types.JSON
     GHCup.Types.JSON.Utils
+    GHCup.Types.JSON.Versions
     GHCup.Types.Optics
+    GHCup.Types.Stack
     GHCup.Utils
     GHCup.Utils.Dirs
     GHCup.Version
@@ -188,8 +190,8 @@ library
     , unliftio-core         ^>=0.2.0.1
     , unordered-containers  ^>=0.2.10.0
     , uri-bytestring        ^>=0.3.2.2
-    , vector                ^>=0.12
+    , vector                 >=0.12     && <0.14
-    , versions              >=4.0.1      && <5.1
+    , versions              >=6.0.3      && <6.1
     , word8                 ^>=0.1.3
     , yaml-streamly         ^>=0.12.0
     , zlib                  ^>=0.6.2.2
@@ -234,9 +236,9 @@ library
       , unix             ^>=2.7
       , unix-bytestring  ^>=0.3.7.3
 
-  if (flag(tui) && !os(windows))
+  if flag(tui)
     cpp-options:   -DBRICK
-    build-depends: vty ^>=5.37
+    build-depends: vty ^>=6.0
 
 library ghcup-optparse
   import:             app-common-depends
@@ -261,7 +263,7 @@ library ghcup-optparse
     GHCup.OptParse.Upgrade
     GHCup.OptParse.Whereis
 
-  hs-source-dirs:     app/ghcup
+  hs-source-dirs:     lib-opt
   default-language:   Haskell2010
   default-extensions:
     LambdaCase
@@ -282,14 +284,8 @@ library ghcup-optparse
   if flag(internal-downloader)
     cpp-options: -DINTERNAL_DOWNLOADER
 
-  if (flag(tui) && !os(windows))
+  if flag(tui)
     cpp-options:   -DBRICK
-    other-modules: BrickMain
-    build-depends:
-      , brick         ^>=1.5
-      , transformers  ^>=0.5
-      , unix          ^>=2.7
-      , vty           ^>=5.37
 
   if os(windows)
     cpp-options: -DIS_WINDOWS
@@ -300,26 +296,6 @@ library ghcup-optparse
 executable ghcup
   import:             app-common-depends
   main-is:            Main.hs
-  other-modules:
-    GHCup.OptParse
-    GHCup.OptParse.ChangeLog
-    GHCup.OptParse.Common
-    GHCup.OptParse.Compile
-    GHCup.OptParse.Config
-    GHCup.OptParse.DInfo
-    GHCup.OptParse.GC
-    GHCup.OptParse.Install
-    GHCup.OptParse.List
-    GHCup.OptParse.Nuke
-    GHCup.OptParse.Prefetch
-    GHCup.OptParse.Rm
-    GHCup.OptParse.Run
-    GHCup.OptParse.Set
-    GHCup.OptParse.Test
-    GHCup.OptParse.ToolRequirements
-    GHCup.OptParse.UnSet
-    GHCup.OptParse.Upgrade
-    GHCup.OptParse.Whereis
 
   hs-source-dirs:     app/ghcup
   default-language:   Haskell2010
@@ -344,14 +320,15 @@ executable ghcup
   if flag(internal-downloader)
     cpp-options: -DINTERNAL_DOWNLOADER
 
-  if (flag(tui) && !os(windows))
+  if flag(tui)
     cpp-options:   -DBRICK
     other-modules: BrickMain
     build-depends:
-      , brick         ^>=1.5
+      , brick         ^>=2.1
       , transformers  ^>=0.5
+      , vty           ^>=6.0
       , unix          ^>=2.7
-      , vty           ^>=5.37
+      , optics        ^>=0.4
 
   if os(windows)
     cpp-options: -DIS_WINDOWS
@@ -403,7 +380,7 @@ test-suite ghcup-test
     , text                      ^>=2.0
     , time                      >=1.9.3   && <1.12
     , uri-bytestring            ^>=0.3.2.2
-    , versions                  >=4.0.1   && <5.1
+    , versions                  >=6.0.3   && <6.1
 
   if os(windows)
     cpp-options: -DIS_WINDOWS
@@ -443,6 +420,7 @@ test-suite ghcup-optparse-test
     , optparse-applicative
     , tasty
     , tasty-hunit
+    , template-haskell
     , text
     , uri-bytestring
     , versions

lib-opt/GHCup/OptParse.hs

@@ -57,16 +57,13 @@ import           GHCup.Types
 import           Control.Monad.Fail             ( MonadFail )
 #endif
 import           Control.Monad.Reader
-import           Data.Bifunctor
 import           Data.Either
 import           Data.Functor
 import           Data.Maybe
 import           Options.Applicative     hiding ( style )
 import           Options.Applicative.Help.Pretty ( text )
 import           Prelude                 hiding ( appendFile )
-import           URI.ByteString
 
-import qualified Data.ByteString.UTF8          as UTF8
 
 
 data Options = Options
@@ -77,12 +74,13 @@ data Options = Options
   , optMetaCache   :: Maybe Integer
   , optMetaMode    :: Maybe MetaMode
   , optPlatform    :: Maybe PlatformRequest
-  , optUrlSource   :: Maybe URI
+  , optUrlSource   :: Maybe URLSource
   , optNoVerify    :: Maybe Bool
   , optKeepDirs    :: Maybe KeepDirs
   , optsDownloader :: Maybe Downloader
   , optNoNetwork   :: Maybe Bool
   , optGpg         :: Maybe GPGSetting
+  , optStackSetup  :: Maybe Bool
   -- commands
   , optCommand     :: Command
   }
@@ -134,13 +132,13 @@ opts =
       )
     <*> optional
           (option
-            (eitherReader parseUri)
+            (eitherReader parseUrlSource)
             (  short 's'
             <> long "url-source"
-            <> metavar "URL"
+            <> metavar "URL_SOURCE"
-            <> help "Alternative ghcup download info url"
+            <> help "Alternative ghcup download info"
             <> internal
-            <> completer fileUri
+            <> completer urlSourceCompleter
             )
           )
     <*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
@@ -178,10 +176,9 @@ opts =
           "GPG verification (default: none)"
           <> completer (listCompleter ["strict", "lax", "none"])
           ))
+    <*> invertableSwitch "stack-setup" (Just 's') False (help "Use stack's setup info for discovering and installing GHC versions")
     <*> com
- where
+
-  parseUri s' =
-    first show $ parseURI strictURIParserOptions (UTF8.fromString s')
 
 
 com :: Parser Command

lib-opt/GHCup/OptParse/ChangeLog.hs

@@ -29,6 +29,7 @@ import           Data.Maybe
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
+import           System.Process                 ( system )
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
@@ -128,21 +129,22 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
     Just uri -> do
       pfreq <- runAppState getPlatformReq
       let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
-          cmd = case _rPlatform pfreq of
-                  Darwin  -> "open"
-                  Linux _ -> "xdg-open"
-                  FreeBSD -> "xdg-open"
-                  Windows -> "start"
-
       if clOpen
         then do
           runAppState $
-            exec cmd
+            case _rPlatform pfreq of
-                 [T.unpack $ decUTF8Safe $ serializeURIRef' uri]
+              Darwin  -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
-                 Nothing
+              Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
-                 Nothing
+              FreeBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
+              Windows -> do
+                let args = "start \"\" " ++ (T.unpack $ decUTF8Safe $ serializeURIRef' uri)
+                c <- liftIO $ system $ args
+                case c of
+                   (ExitFailure xi) -> pure $ Left $ NonZeroExit xi "cmd.exe" [args]
+                   ExitSuccess -> pure $ Right ()
               >>= \case
                     Right _ -> pure ExitSuccess
                     Left  e -> logError (T.pack $ prettyHFError e)
                       >> pure (ExitFailure 13)
         else liftIO $ putStrLn uri' >> pure ExitSuccess
+

lib-opt/GHCup/OptParse/Common.hs

@@ -48,7 +48,7 @@ import           Data.Maybe
 import           Data.Text                      ( Text )
 import           Data.Time.Calendar             ( Day )
 import           Data.Time.Format               ( parseTimeM, defaultTimeLocale )
-import           Data.Versions           hiding ( str )
+import           Data.Versions
 import           Data.Void
 import qualified Data.Vector      as V
 import           GHC.IO.Exception
@@ -64,6 +64,8 @@ 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 Data.Text.Lazy.Encoding       as LE
+import qualified Data.Text.Lazy                as LT
 import qualified Text.Megaparsec               as MP
 import qualified System.FilePath.Posix         as FP
 import GHCup.Version
@@ -209,19 +211,7 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
         )
     ]
   distroP :: MP.Parsec Void Text LinuxDistro
-  distroP = choice'
+  distroP = choice' ((\d -> MP.chunk (T.pack $ distroToString d) $> d) <$> allDistros)
-    [ MP.chunk "debian" $> Debian
-    , MP.chunk "deb" $> Debian
-    , MP.chunk "ubuntu" $> Ubuntu
-    , MP.chunk "mint" $> Mint
-    , MP.chunk "fedora" $> Fedora
-    , MP.chunk "centos" $> CentOS
-    , MP.chunk "redhat" $> RedHat
-    , MP.chunk "alpine" $> Alpine
-    , MP.chunk "gentoo" $> Gentoo
-    , MP.chunk "exherbo" $> Exherbo
-    , MP.chunk "unknown" $> UnknownLinux
-    ]
 
 
 uriParser :: String -> Either String URI
@@ -334,6 +324,15 @@ toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
 gitFileUri :: [String] -> Completer
 gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
 
+urlSourceCompleter :: Completer
+urlSourceCompleter = mkCompleter $ urlSourceCompleter' []
+
+urlSourceCompleter' :: [String] -> String -> IO [String]
+urlSourceCompleter' add str' = do
+  let static = ["GHCupURL", "StackSetupURL"]
+  file <- fileUri' add str'
+  pure $ static ++ file
+
 fileUri :: Completer
 fileUri = mkCompleter $ fileUri' []
 
@@ -367,7 +366,7 @@ fileUri' add = \case
   -- 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 =
@@ -462,13 +461,15 @@ tagCompleter tool add = listIOCompleter $ do
         defaultKeyBindings
         loggerConfig
 
-  mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
+  mpFreq <- flip runReaderT appState . runE $ platformRequest
-  case mGhcUpInfo of
+  forFold mpFreq $ \pfreq -> do
-    VRight ghcupInfo -> do
+    mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF pfreq
-      let allTags = filter (/= Old)
+    case mGhcUpInfo of
-            $ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
+      VRight ghcupInfo -> do
-      pure $ nub $ (add ++) $ fmap tagToString allTags
+        let allTags = filter (/= Old)
-    VLeft _ -> pure  (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
+              $ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
+        pure $ nub $ (add ++) $ fmap tagToString allTags
+      VLeft _ -> pure  (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
 
 versionCompleter :: [ListCriteria] -> Tool -> Completer
 versionCompleter criteria tool = versionCompleter' criteria tool (const True)
@@ -489,8 +490,8 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
                    defaultKeyBindings
                    loggerConfig
   mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
-  mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
   forFold mpFreq $ \pfreq -> do
+    mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF pfreq
     forFold mGhcUpInfo $ \ghcupInfo -> do
       let appState = AppState
             settings
@@ -824,8 +825,20 @@ checkForUpdates = do
 
 logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
 logGHCPostRm ghcVer = do
-  cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store")
+  cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store or ~/.local/state/cabal/store")
     (runIdentity . CC.cfgStoreDir <$> CC.readConfig)
   let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
   logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir
 
+parseUrlSource :: String -> Either String URLSource
+parseUrlSource "GHCupURL" = pure GHCupURL
+parseUrlSource "StackSetupURL" = pure StackSetupURL
+parseUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
+            <|> (fmap (OwnSource . (:[]) . Right) . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')
+
+parseNewUrlSource :: String -> Either String NewURLSource
+parseNewUrlSource "GHCupURL" = pure NewGHCupURL
+parseNewUrlSource "StackSetupURL" = pure NewStackSetupURL
+parseNewUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
+            <|> (fmap NewURI . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')
+

lib-opt/GHCup/OptParse/Config.hs

@@ -32,7 +32,6 @@ 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
@@ -51,7 +50,7 @@ data ConfigCommand
   = ShowConfig
   | SetConfig String (Maybe String)
   | InitConfig
-  | AddReleaseChannel Bool URI
+  | AddReleaseChannel Bool NewURLSource
   deriving (Eq, Show)
 
 
@@ -68,15 +67,14 @@ configP = subparser
       <> command "show" showP
       <> command "add-release-channel" addP
       )
-    <|> argsP -- add show for a single option
     <|> pure ShowConfig
  where
   initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
   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 <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing") <*> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
+  addP  = info (AddReleaseChannel <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing") <*> argument (eitherReader parseNewUrlSource) (metavar "URL_SOURCE" <> completer urlSourceCompleter))
-    (progDesc "Add a release channel from a URI")
+    (progDesc "Add a release channel, e.g. from a URI")
 
 
 
@@ -151,7 +149,6 @@ updateSettings usl usr =
          , kSet = kSet kbl <|> kSet kbr
          , kChangelog = kChangelog kbl <|> kChangelog kbr
          , kShowAll = kShowAll kbl <|> kShowAll kbr
-         , kShowAllTools = kShowAllTools kbl <|> kShowAllTools kbr
          }
 
 
@@ -194,10 +191,14 @@ config configCommand settings userConf keybindings runLogger = case configComman
           throwE $ ParseError "Empty values are not allowed"
         Nothing -> do
           usersettings <- decodeSettings k
+          when (usersettings == defaultUserSettings)
+            $ throwE $ ParseError ("Failed to parse setting (maybe typo?): " <> k)
           lift $ doConfig usersettings
           pure ()
         Just v -> do
           usersettings <- decodeSettings (k <> ": " <> v <> "\n")
+          when (usersettings == defaultUserSettings)
+            $ throwE $ ParseError ("Failed to parse key '" <> k <> "' with value '" <> v <> "' as user setting. Maybe typo?")
           lift $ doConfig usersettings
           pure ()
     case r of
@@ -205,29 +206,19 @@ config configCommand settings userConf keybindings runLogger = case configComman
       VLeft (V (JSONDecodeError e)) -> do
         runLogger $ logError $ "Error decoding config: " <> T.pack e
         pure $ ExitFailure 65
-      VLeft _ -> pure $ ExitFailure 65
+      VLeft e -> do
+        runLogger (logError $ T.pack $ prettyHFError e)
+        pure $ ExitFailure 65
 
-  AddReleaseChannel force uri -> do
+  AddReleaseChannel force new -> do
     r <- runE @'[DuplicateReleaseChannel] $ do
-      case urlSource settings of
+      let oldSources = fromURLSource (urlSource settings)
-        AddSource xs -> do
+      let merged = oldSources ++ [new]
-          case checkDuplicate xs (Right uri) of
+      case checkDuplicate oldSources new of
-            Duplicate
+        Duplicate
-              | not force -> throwE (DuplicateReleaseChannel uri)
+          | not force -> throwE (DuplicateReleaseChannel new)
-            DuplicateLast -> pure ()
+        DuplicateLast -> pure ()
-            _ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (appendUnique xs (Right uri)) })
+        _ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ SimpleList merged })
-        GHCupURL -> do
-          lift $ doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
-          pure ()
-        OwnSource xs -> do
-          case checkDuplicate xs (Right uri) of
-            Duplicate
-              | not force -> throwE (DuplicateReleaseChannel uri)
-            DuplicateLast -> pure ()
-            _ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (appendUnique xs (Right uri)) })
-        OwnSpec spec -> do
-          lift $ doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource [Left spec, Right uri] })
-          pure ()
     case r of
       VRight _ -> do
         pure ExitSuccess
@@ -242,15 +233,6 @@ config configCommand settings userConf keybindings runLogger = case configComman
     | a `elem` xs  = Duplicate
     | otherwise    = NoDuplicate
 
-  -- appends the element to the end of the list, but also removes it from the existing list
-  appendUnique :: Eq a => [a] -> a -> [a]
-  appendUnique xs' e = go xs'
-   where
-    go [] = [e]
-    go (x:xs)
-      | x == e    =     go xs -- skip
-      | otherwise = x : go xs
-
   doConfig :: MonadIO m => UserSettings -> m ()
   doConfig usersettings = do
     let settings' = updateSettings usersettings userConf

lib-opt/GHCup/OptParse/Install.hs

@@ -63,7 +63,6 @@ data InstallCommand = InstallGHC InstallOptions
     --[ Options ]--
     ---------------
 
-
 data InstallOptions = InstallOptions
   { instVer      :: Maybe ToolVersion
   , instBindist  :: Maybe URI
@@ -134,7 +133,7 @@ installParser =
            )
       )
     )
-    <|> (Right <$> installOpts Nothing)
+    <|> (Right <$> installOpts (Just GHC))
  where
   installHLSFooter :: String
   installHLSFooter = [s|Discussion:
@@ -291,6 +290,11 @@ type InstallGHCEffects = '[ AlreadyInstalled
                           , UninstallFailed
                           , UnknownArchive
                           , InstallSetError
+                          , NoCompatiblePlatform
+                          , GHCup.Errors.ParseError
+                          , UnsupportedSetupCombo
+                          , DistroNotFound
+                          , NoCompatibleArch
                           ]
 
 runInstGHC :: AppState
@@ -310,13 +314,13 @@ runInstGHC appstate' =
 
 install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
 install installCommand settings getAppState' runLogger = case installCommand of
-  (Right iopts) -> do
+  (Right iGHCopts) -> do
     runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
-    installGHC iopts
+    installGHC iGHCopts
-  (Left (InstallGHC iopts)) -> installGHC iopts
+  (Left (InstallGHC iGHCopts)) -> installGHC iGHCopts
-  (Left (InstallCabal iopts)) -> installCabal iopts
+  (Left (InstallCabal iopts))  -> installCabal iopts
-  (Left (InstallHLS iopts)) -> installHLS iopts
+  (Left (InstallHLS iopts))    -> installHLS iopts
-  (Left (InstallStack iopts)) -> installStack iopts
+  (Left (InstallStack iopts))  -> installStack iopts
  where
   installGHC :: InstallOptions -> IO ExitCode
   installGHC InstallOptions{..} = do

lib-opt/GHCup/OptParse/List.hs

@@ -27,7 +27,7 @@ import           Data.List                      ( intercalate, sort )
 import           Data.Functor
 import           Data.Maybe
 import           Data.Time.Calendar             ( Day )
-import           Data.Versions           hiding ( str )
+import           Data.Versions
 import           Data.Void
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )

lib-opt/GHCup/OptParse/Prefetch.hs

@@ -14,6 +14,7 @@ module GHCup.OptParse.Prefetch where
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
+import           GHCup.Types.Optics
 import           GHCup.Prelude.File
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.String.QQ
@@ -157,7 +158,9 @@ type PrefetchEffects = '[ TagNotFound
                         , GPGError
                         , DownloadFailed
                         , JSONError
-                        , FileDoesNotExistError ]
+                        , FileDoesNotExistError
+                        , StackPlatformDetectError
+                        ]
 
 
 runPrefetch :: MonadUnliftIO m
@@ -196,21 +199,22 @@ prefetch prefetchCommand runAppState runLogger =
           (v, _) <- liftE $ fromVersion mt GHC
           if pfGHCSrc
           then liftE $ fetchGHCSrc v pfCacheDir
-          else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
+          else liftE $ fetchToolBindist v GHC pfCacheDir
       PrefetchCabal PrefetchOptions {pfCacheDir} mt   -> do
         forM_ pfCacheDir (liftIO . createDirRecursive')
         (v, _) <- liftE $ fromVersion mt Cabal
-        liftE $ fetchToolBindist (_tvVersion v) Cabal pfCacheDir
+        liftE $ fetchToolBindist v Cabal pfCacheDir
       PrefetchHLS PrefetchOptions {pfCacheDir} mt   -> do
         forM_ pfCacheDir (liftIO . createDirRecursive')
         (v, _) <- liftE $ fromVersion mt HLS
-        liftE $ fetchToolBindist (_tvVersion v) HLS pfCacheDir
+        liftE $ fetchToolBindist v HLS pfCacheDir
       PrefetchStack PrefetchOptions {pfCacheDir} mt   -> do
         forM_ pfCacheDir (liftIO . createDirRecursive')
         (v, _) <- liftE $ fromVersion mt Stack
-        liftE $ fetchToolBindist (_tvVersion v) Stack pfCacheDir
+        liftE $ fetchToolBindist v Stack pfCacheDir
       PrefetchMetadata -> do
-        _ <- liftE getDownloadsF
+        pfreq <- lift getPlatformReq
+        _ <- liftE $ getDownloadsF pfreq
         pure ""
        ) >>= \case
                 VRight _ -> do

lib-opt/GHCup/OptParse/Rm.hs

@@ -29,7 +29,7 @@ import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
 import           Data.Functor
 import           Data.Maybe
-import           Data.Versions           hiding ( str )
+import           Data.Versions
 import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )

lib-opt/GHCup/OptParse/Run.hs

@@ -187,6 +187,11 @@ type RunEffects = '[ AlreadyInstalled
                    , ProcessError
                    , UninstallFailed
                    , MergeFileTreeError
+                   , NoCompatiblePlatform
+                   , GHCup.Errors.ParseError
+                   , UnsupportedSetupCombo
+                   , DistroNotFound
+                   , NoCompatibleArch
                    ]
 
 runLeanRUN :: (MonadUnliftIO m, MonadIO m)
@@ -226,6 +231,7 @@ run :: forall m .
        , MonadCatch m
        , MonadIO m
        , MonadUnliftIO m
+       , Alternative m
        )
    => RunOptions
    -> IO AppState
@@ -255,7 +261,9 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                liftIO $ putStr tmp
                pure ExitSuccess
              (cmd:args) -> do
-               newEnv <- liftIO $ addToPath tmp runAppendPATH
+               newEnv <- liftIO $ addToPath [tmp] runAppendPATH
+               let pathVar = if isWindows then "Path" else "PATH"
+               forM_ (Map.lookup pathVar . Map.fromList $ newEnv) $ liftIO . setEnv pathVar
 #ifndef IS_WINDOWS
                void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
                pure ExitSuccess
@@ -329,6 +337,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                            , MonadThrow m
                            , MonadIO m
                            , MonadCatch m
+                           , Alternative m
                            )
                         => Toolchain
                         -> FilePath
@@ -354,6 +363,11 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                               , CopyError
                               , UninstallFailed
                               , MergeFileTreeError
+                              , NoCompatiblePlatform
+                              , GHCup.Errors.ParseError
+                              , UnsupportedSetupCombo
+                              , DistroNotFound
+                              , NoCompatibleArch
                               ] (ResourceT (ReaderT AppState m)) ()
    installToolChainFull Toolchain{..} tmp = do
          case ghcVer of

lib-opt/GHCup/OptParse/Set.hs

@@ -28,7 +28,7 @@ import           Control.Monad.Trans.Resource
 import           Data.Either
 import           Data.Functor
 import           Data.Maybe
-import           Data.Versions           hiding ( str )
+import           Data.Versions
 import           GHC.Unicode
 import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )

lib-opt/GHCup/OptParse/Upgrade.hs

@@ -35,7 +35,7 @@ import System.Environment
 import GHCup.Utils
 import System.FilePath
 import GHCup.Types.Optics
-import Data.Versions         hiding (str)
+import Data.Versions
 
 
 

lib/GHCup.hs

@@ -100,7 +100,7 @@ fetchToolBindist :: ( MonadFail m
                     , MonadIO m
                     , MonadUnliftIO m
                     )
-                 => Version
+                 => GHCTargetVersion
                  -> Tool
                  -> Maybe FilePath
                  -> Excepts
@@ -113,7 +113,7 @@ fetchToolBindist :: ( MonadFail m
                       m
                       FilePath
 fetchToolBindist v t mfp = do
-  dlinfo <- liftE $ getDownloadInfo t v
+  dlinfo <- liftE $ getDownloadInfo' t v
   liftE $ downloadCached' dlinfo Nothing mfp
 
 

lib/GHCup/Download.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
 
-
 {-|
 Module      : GHCup.Download
 Description : Downloading
@@ -31,9 +30,11 @@ import           GHCup.Download.Utils
 #endif
 import           GHCup.Errors
 import           GHCup.Types
+import qualified GHCup.Types.Stack                as Stack
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
+import           GHCup.Platform
 import           GHCup.Prelude
 import           GHCup.Prelude.File
 import           GHCup.Prelude.Logger.Internal
@@ -55,6 +56,7 @@ import           Data.ByteString                ( ByteString )
 import           Data.CaseInsensitive           ( mk )
 #endif
 import           Data.Maybe
+import           Data.Either
 import           Data.List
 import           Data.Time.Clock
 import           Data.Time.Clock.POSIX
@@ -112,33 +114,84 @@ getDownloadsF :: ( FromJSONKey Tool
                  , MonadFail m
                  , MonadMask m
                  )
-              => Excepts
+              => PlatformRequest
-                   '[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
+              -> Excepts
+                   '[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
                    m
                    GHCupInfo
-getDownloadsF = do
+getDownloadsF pfreq@(PlatformRequest arch plat _) = do
   Settings { urlSource } <- lift getSettings
-  case urlSource of
+  let newUrlSources = fromURLSource urlSource
-    GHCupURL -> liftE $ getBase ghcupURL
+  infos <- liftE $ mapM dl' newUrlSources
-    (OwnSource exts) -> do
+  keys <- if any isRight infos
-      ext  <- liftE $ mapM (either pure getBase) exts
+          then liftE . reThrowAll @_ @_ @'[StackPlatformDetectError] StackPlatformDetectError $ getStackPlatformKey pfreq
-      mergeGhcupInfo ext
+          else pure []
-    (OwnSpec av) -> pure av
+  ghcupInfos <- fmap catMaybes $ forM infos $ \case
-    (AddSource exts) -> do
+    Left gi  -> pure (Just gi)
-      base <- liftE $ getBase ghcupURL
+    Right si -> pure $ fromStackSetupInfo si keys
-      ext  <- liftE $ mapM (either pure getBase) exts
+  mergeGhcupInfo ghcupInfos
-      mergeGhcupInfo (base:ext)
-
  where
+
+  dl' :: ( FromJSONKey Tool
+         , FromJSONKey Version
+         , FromJSON VersionInfo
+         , MonadReader env m
+         , HasSettings env
+         , HasDirs env
+         , MonadIO m
+         , MonadCatch m
+         , HasLog env
+         , MonadThrow m
+         , MonadFail m
+         , MonadMask m
+         )
+      => NewURLSource
+      -> Excepts
+           '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError]
+           m (Either GHCupInfo Stack.SetupInfo)
+  dl' NewGHCupURL       = fmap Left $ liftE (getBase ghcupURL) >>= liftE . decodeMetadata @GHCupInfo
+  dl' NewStackSetupURL  = fmap Right $ liftE (getBase stackSetupURL) >>= liftE . decodeMetadata @Stack.SetupInfo
+  dl' (NewGHCupInfo gi) = pure (Left gi)
+  dl' (NewSetupInfo si) = pure (Right si)
+  dl' (NewURI uri)      = do
+                            base <- liftE $ getBase uri
+                            catchE @JSONError (\(JSONDecodeError _) -> do
+                                logDebug $ "Couldn't decode " <> T.pack base <> " as GHCupInfo, trying as SetupInfo: "
+                                Right <$> decodeMetadata @Stack.SetupInfo base)
+                              $ fmap Left (decodeMetadata @GHCupInfo base >>= \gI -> warnOnMetadataUpdate uri gI >> pure gI)
+
+  fromStackSetupInfo :: MonadThrow m
+                     => Stack.SetupInfo
+                     -> [String]
+                     -> m GHCupInfo
+  fromStackSetupInfo (Stack.siGHCs -> ghcDli) keys = do
+    let ghcVersionsPerKey = (`M.lookup` ghcDli) <$> (T.pack <$> keys)
+        ghcVersions = fromMaybe mempty . listToMaybe . catMaybes $ ghcVersionsPerKey
+    (ghcupInfo' :: M.Map GHCTargetVersion DownloadInfo) <-
+      M.mapKeys mkTVer <$> M.traverseMaybeWithKey (\_ a -> pure $ fromStackDownloadInfo a) ghcVersions
+    let ghcupDownloads' = M.singleton GHC (M.map fromDownloadInfo ghcupInfo')
+    pure (GHCupInfo mempty ghcupDownloads' Nothing)
+   where
+    fromDownloadInfo :: DownloadInfo -> VersionInfo
+    fromDownloadInfo dli = let aspec = M.singleton arch (M.singleton plat (M.singleton Nothing dli))
+                           in VersionInfo [] Nothing Nothing Nothing Nothing aspec Nothing Nothing Nothing
+
+    fromStackDownloadInfo :: MonadThrow m => Stack.GHCDownloadInfo -> m DownloadInfo
+    fromStackDownloadInfo (Stack.GHCDownloadInfo { gdiDownloadInfo = Stack.DownloadInfo{..} }) = do
+      url <- either (\e -> throwM $ ParseError (show e)) pure $ parseURI strictURIParserOptions . E.encodeUtf8 $ downloadInfoUrl
+      sha256 <- maybe (throwM $ DigestMissing url) (pure . E.decodeUtf8) downloadInfoSha256
+      pure $ DownloadInfo url (Just $ RegexDir "ghc-.*") sha256 Nothing Nothing
+
+
   mergeGhcupInfo :: MonadFail m
                  => [GHCupInfo]
                  -> m GHCupInfo
   mergeGhcupInfo [] = fail "mergeGhcupInfo: internal error: need at least one GHCupInfo"
   mergeGhcupInfo xs@(GHCupInfo{}: _) =
     let newDownloads   = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_ghcupDownloads   <$> xs)
-        newGlobalTools = M.unionsWith (\_ a2 -> a2              ) (_globalTools      <$> xs)
         newToolReqs    = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_toolRequirements <$> xs)
-    in pure $ GHCupInfo newToolReqs newDownloads newGlobalTools
+    in pure $ GHCupInfo newToolReqs newDownloads Nothing
+
 
 
 yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
@@ -151,7 +204,7 @@ etagsFile :: FilePath -> FilePath
 etagsFile = (<.> "etags")
 
 
-getBase :: ( MonadReader env m
+getBase :: forall m env . ( MonadReader env m
            , HasDirs env
            , HasSettings env
            , MonadFail m
@@ -161,7 +214,7 @@ getBase :: ( MonadReader env m
            , MonadMask m
            )
         => URI
-        -> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m GHCupInfo
+        -> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError] m FilePath
 getBase uri = do
   Settings { noNetwork, downloader, metaMode } <- lift getSettings
 
@@ -181,25 +234,8 @@ getBase uri = do
                $ uri
 
   -- if we didn't get a filepath from the download, use the cached yaml
-  actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
+  maybe (lift $ yamlFromCache uri) pure mYaml
-  lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
-
-  liftE
-    . onE_ (onError actualYaml)
-    . lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
-    . liftIO
-    . Y.decodeFileEither
-    $ actualYaml
  where
-  -- On error, remove the etags file and set access time to 0. This should ensure the next invocation
-  -- may re-download and succeed.
-  onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
-  onError fp = do
-    let efp = etagsFile fp
-    handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
-      (hideError doesNotExistErrorType $ rmFile efp)
-    liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
-
   warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
   warnCache s downloader' = do
     let tryDownloder = case downloader' of
@@ -246,7 +282,7 @@ getBase uri = do
     Settings { metaCache } <- lift getSettings
 
        -- for local files, let's short-circuit and ignore access time
-    if | scheme == "file" -> liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing Nothing (fromGHCupPath cacheDir) Nothing True
+    if | scheme == "file" -> liftE $ download uri' Nothing Nothing Nothing (fromGHCupPath cacheDir) Nothing True
        | e -> do
           accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file
           let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime
@@ -271,6 +307,69 @@ getBase uri = do
 
       pure f
 
+warnOnMetadataUpdate ::
+           ( MonadReader env m
+           , MonadIO m
+           , HasLog env
+           , HasDirs env
+           )
+        => URI
+        -> GHCupInfo
+        -> m ()
+warnOnMetadataUpdate uri (GHCupInfo { _metadataUpdate = Just newUri })
+  | scheme' uri == "file"
+  , urlBase' uri /= urlBase' newUri = do
+      confFile <- getConfigFilePath'
+      logWarn $ "New metadata version detected"
+                           <> "\n    old URI: " <> (decUTF8Safe . serializeURIRef') uri
+                           <> "\n    new URI: " <> (decUTF8Safe . serializeURIRef') newUri
+                           <> "\nYou might need to update your " <> T.pack confFile
+  | scheme' uri /= "file"
+  , uri /= newUri = do
+      confFile <- getConfigFilePath'
+      logWarn $ "New metadata version detected"
+                           <> "\n    old URI: " <> (decUTF8Safe . serializeURIRef') uri
+                           <> "\n    new URI: " <> (decUTF8Safe . serializeURIRef') newUri
+                           <> "\nYou might need to update your " <> T.pack confFile
+ where
+  scheme' = view (uriSchemeL' % schemeBSL')
+  urlBase' = T.unpack . decUTF8Safe . urlBaseName . view pathL'
+warnOnMetadataUpdate _ _ = pure ()
+
+
+decodeMetadata :: forall j m env .
+               ( MonadReader env m
+               , HasDirs env
+               , HasSettings env
+               , MonadFail m
+               , MonadIO m
+               , MonadCatch m
+               , HasLog env
+               , MonadMask m
+               , FromJSON j
+               )
+               => FilePath
+               -> Excepts '[JSONError, FileDoesNotExistError] m j
+decodeMetadata actualYaml = do
+  lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
+
+  liftE
+    . onE_ (onError actualYaml)
+    . lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
+    . liftIO
+    . Y.decodeFileEither
+    $ actualYaml
+ where
+  -- On error, remove the etags file and set access time to 0. This should ensure the next invocation
+  -- may re-download and succeed.
+  onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
+  onError fp = do
+    let efp = etagsFile fp
+    handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
+      (hideError doesNotExistErrorType $ rmFile efp)
+    liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
+
+
 getDownloadInfo :: ( MonadReader env m
                    , HasPlatformReq env
                    , HasGHCupInfo env
@@ -326,6 +425,7 @@ getDownloadInfo' t v = do
     )
 
 
+
 -- | Tries to download from the given http or https url
 -- and saves the result in continuous memory into a file.
 -- If the filename is not provided, then we:
@@ -352,20 +452,15 @@ download :: ( MonadReader env m
 download rawUri gpgUri eDigest eCSize dest mfn etags
   | scheme == "https" = liftE dl
   | scheme == "http"  = liftE dl
-  | scheme == "file"
-  , Just s <- gpgScheme
-  , s /= "file" = throwIO $ userError $ "gpg scheme does not match base file scheme: " <> (T.unpack . decUTF8Safe $ s)
   | scheme == "file"  = do
-      Settings{ gpgSetting } <- lift getSettings
       let destFile' = T.unpack . decUTF8Safe $ view pathL' rawUri
       lift $ logDebug $ "using local file: " <> T.pack destFile'
-      liftE $ verify gpgSetting destFile' (pure . T.unpack . decUTF8Safe . view pathL')
+      forM_ eDigest (liftE . flip checkDigest destFile')
       pure destFile'
   | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
 
  where
-  scheme    = view (uriSchemeL' % schemeBSL') rawUri
+  scheme = view (uriSchemeL' % schemeBSL') rawUri
-  gpgScheme = view (uriSchemeL' % schemeBSL') <$> gpgUri
   dl = do
     Settings{ mirrors } <- lift getSettings
     let uri = applyMirrors mirrors rawUri
@@ -407,14 +502,30 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
                         else pure (\fp -> liftE . internalDL fp)
 #endif
               liftE $ downloadAction baseDestFile uri
-              liftE $ verify gpgSetting baseDestFile
+              case (gpgUri, gpgSetting) of
-                (\uri' -> do
+                (_, GPGNone) -> pure ()
-                  gpgDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri' Nothing
+                (Just gpgUri', _) -> do
-                  lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri' <> " as file " <> T.pack gpgDestFile
+                  gpgDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile gpgUri' Nothing
-                  flip onException (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile)) $
+                  liftE $ flip onException
-                    downloadAction gpgDestFile uri'
+                       (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile))
-                  pure gpgDestFile
+                   $ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
-                )
+                        (\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyHFError (GPGError e))
+                        ) $ do
+                      o' <- liftIO getGpgOpts
+                      lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') gpgUri' <> " as file " <> T.pack gpgDestFile
+                      liftE $ downloadAction gpgDestFile gpgUri'
+                      lift $ logInfo $ "verifying signature of: " <> T.pack baseDestFile
+                      let args = o' ++ ["--batch", "--verify", "--quiet", "--no-tty", gpgDestFile, baseDestFile]
+                      cp <- lift $ executeOut "gpg" args Nothing
+                      case cp of
+                        CapturedProcess { _exitCode = ExitFailure i, _stdErr } -> do
+                          lift $ logDebug $ decUTF8Safe' _stdErr
+                          throwE (GPGError @'[ProcessError] (V (NonZeroExit i "gpg" args)))
+                        CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
+                _ -> pure ()
+
+              forM_ eCSize  (liftE . flip checkCSize  baseDestFile)
+              forM_ eDigest (liftE . flip checkDigest baseDestFile)
     pure baseDestFile
 
   curlDL :: ( MonadCatch m
@@ -612,41 +723,6 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
       liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp)
       pure Nothing
 
-  verify :: ( MonadReader env m
-            , HasLog env
-            , HasDirs env
-            , HasSettings env
-            , MonadCatch m
-            , MonadMask m
-            , MonadIO m
-            )
-            => GPGSetting
-            -> FilePath
-            -> (URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m FilePath)
-            -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
-  verify gpgSetting destFile' downloadAction' = do
-    case (gpgUri, gpgSetting) of
-      (_, GPGNone) -> pure ()
-      (Just gpgUri', _) -> do
-        liftE $ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
-              (\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyHFError (GPGError e))
-              ) $ do
-            o' <- liftIO getGpgOpts
-            gpgDestFile <- liftE $ downloadAction' gpgUri'
-            lift $ logInfo $ "verifying signature of: " <> T.pack destFile'
-            let args = o' ++ ["--batch", "--verify", "--quiet", "--no-tty", gpgDestFile, destFile']
-            cp <- lift $ executeOut "gpg" args Nothing
-            case cp of
-              CapturedProcess { _exitCode = ExitFailure i, _stdErr } -> do
-                lift $ logDebug $ decUTF8Safe' _stdErr
-                throwE (GPGError @'[ProcessError] (V (NonZeroExit i "gpg" args)))
-              CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
-      _ -> pure ()
-
-    forM_ eCSize  (liftE . flip checkCSize  destFile')
-    forM_ eDigest (liftE . flip checkDigest destFile')
-
-
 
 -- | Download into tmpdir or use cached version, if it exists. If filename
 -- is omitted, infers the filename from the url.
@@ -666,7 +742,7 @@ downloadCached :: ( MonadReader env m
 downloadCached dli mfn = do
   Settings{ cache } <- lift getSettings
   case cache of
-    True -> liftE $ downloadCached' dli mfn Nothing
+    True -> downloadCached' dli mfn Nothing
     False -> do
       tmp <- lift withGHCupTmpDir
       liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False

lib/GHCup/Errors.hs

@@ -87,6 +87,7 @@ allHFError = unlines allErrors
     , let proxy = Proxy :: Proxy ToolShadowed in format proxy
     , let proxy = Proxy :: Proxy ContentLengthError in format proxy
     , let proxy = Proxy :: Proxy DuplicateReleaseChannel in format proxy
+    , let proxy = Proxy :: Proxy UnsupportedSetupCombo in format proxy
     , ""
     , "# high level errors (4000+)"
     , let proxy = Proxy :: Proxy DownloadFailed in format proxy
@@ -99,6 +100,7 @@ allHFError = unlines allErrors
     , let proxy = Proxy :: Proxy ParseError in format proxy
     , let proxy = Proxy :: Proxy UnexpectedListLength in format proxy
     , let proxy = Proxy :: Proxy NoUrlBase in format proxy
+    , let proxy = Proxy :: Proxy DigestMissing in format proxy
     , ""
     , "# orphans (800+)"
     , let proxy = Proxy :: Proxy URIParseError in format proxy
@@ -207,7 +209,6 @@ instance HFErrorProject NoCompatiblePlatform where
 
 -- | Unable to find a download for the requested version/distro.
 data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
-                | NoDownload' GlobalTool
   deriving Show
 
 instance Pretty NoDownload where
@@ -225,7 +226,6 @@ instance Pretty NoDownload where
              <> T.unpack (prettyVer vv)
              <> "'"
     | otherwise = text $ "Unable to find a download for " <> T.unpack (tVerToText tver)
-  pPrint (NoDownload' globalTool) = text $ "Unable to find a download for " <> prettyShow globalTool
 
 instance HFErrorProject NoDownload where
   eBase _ = 10
@@ -674,18 +674,29 @@ instance HFErrorProject ContentLengthError where
   eBase _ = 340
   eDesc _ = "File content length verification failed"
 
-data DuplicateReleaseChannel = DuplicateReleaseChannel URI
+data DuplicateReleaseChannel = DuplicateReleaseChannel NewURLSource
   deriving Show
 
 instance HFErrorProject DuplicateReleaseChannel where
   eBase _ = 350
-  eDesc _ = "Duplicate release channel detected when adding URI.\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
+  eDesc _ = "Duplicate release channel detected when adding new source.\nGiving up. You can use '--force' to remove and append the duplicate source (this may change order/semantics)."
 
 instance Pretty DuplicateReleaseChannel where
-  pPrint (DuplicateReleaseChannel uri) =
+  pPrint (DuplicateReleaseChannel source) =
     text $ "Duplicate release channel detected when adding: \n  "
-      <> (T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
+      <> show source
-      <> "\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
+      <> "\nGiving up. You can use '--force' to remove and append the duplicate source (this may change order/semantics)."
+
+data UnsupportedSetupCombo = UnsupportedSetupCombo Architecture Platform
+  deriving Show
+
+instance Pretty UnsupportedSetupCombo where
+  pPrint (UnsupportedSetupCombo arch plat) =
+    text "Could not find a compatible setup combo for:" <+> pPrint arch <+> pPrint plat
+
+instance HFErrorProject UnsupportedSetupCombo where
+  eBase _ = 360
+  eDesc _ = "Could not find a compatible setup combo"
 
     -------------------------
     --[ High-level errors ]--
@@ -711,7 +722,7 @@ data InstallSetError = forall xs1 xs2 . (Show (V xs1), Pretty (V xs1), HFErrorPr
 
 instance Pretty InstallSetError where
   pPrint (InstallSetError reason1 reason2) =
-     text "Both installation and setting the tool failed. Install error was:"
+     text "Both installation and setting the tool failed.\nInstall error was:"
       <+> pPrint reason1
       <+> text "\nSet error was:"
       <+> pPrint reason2
@@ -774,6 +785,22 @@ instance HFErrorProject GHCupSetError where
   eNum (GHCupSetError xs) = 9000 + eNum xs
   eDesc _ = "Setting the current version failed."
 
+-- | Executing stacks platform detection failed.
+data StackPlatformDetectError = forall es . (ToVariantMaybe StackPlatformDetectError es, PopVariant StackPlatformDetectError es, Show (V es), Pretty (V es), HFErrorProject (V es)) => StackPlatformDetectError (V es)
+
+instance Pretty StackPlatformDetectError where
+  pPrint (StackPlatformDetectError reason) =
+    case reason of
+      VMaybe (_ :: StackPlatformDetectError) -> pPrint reason
+      _ -> text "Running stack platform detection logic failed:" <+> pPrint reason
+
+deriving instance Show StackPlatformDetectError
+
+instance HFErrorProject StackPlatformDetectError where
+  eBase _ = 6000
+  eNum (StackPlatformDetectError xs) = 6000 + eNum xs
+  eDesc _ = "Running stack platform detection logic failed."
+
 
     ---------------------------------------------
     --[ True Exceptions (e.g. for MonadThrow) ]--
@@ -821,6 +848,18 @@ instance HFErrorProject NoUrlBase where
   eBase _ = 520
   eDesc _ = "URL does not have a base filename."
 
+data DigestMissing = DigestMissing URI
+  deriving Show
+
+instance Pretty DigestMissing where
+  pPrint (DigestMissing uri) =
+    text "Digest missing for:" <+> (text . T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
+
+instance Exception DigestMissing
+
+instance HFErrorProject DigestMissing where
+  eBase _ = 530
+  eDesc _ = "An expected digest is missing."
 
 
     ------------------------

lib/GHCup/GHC.hs

@@ -74,6 +74,7 @@ import qualified Crypto.Hash.SHA256            as SHA256
 import qualified Data.ByteString.Base16        as B16
 import qualified Data.ByteString               as B
 import qualified Data.ByteString.Lazy          as BL
+import qualified Data.Map.Strict               as Map
 import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
 import qualified Data.Text.Encoding            as E
@@ -216,7 +217,9 @@ testUnpackedGHC path tver addMakeArgs = do
   lift $ logInfo $ "Testing GHC version " <> tVerToText tver <> "!"
   ghcDir <- lift $ ghcupGHCDir tver
   let ghcBinDir = fromGHCupPath ghcDir </> "bin"
-  env <- liftIO $ addToPath ghcBinDir False
+  env <- liftIO $ addToPath [ghcBinDir] False
+  let pathVar = if isWindows then "Path" else "PATH"
+  forM_ (Map.lookup pathVar . Map.fromList $ env) $ liftIO . setEnv pathVar
 
   lEM $ make' (fmap T.unpack addMakeArgs)
               (Just $ fromGHCupPath path)
@@ -512,6 +515,7 @@ installGHCBin :: ( MonadFail m
                  , MonadResource m
                  , MonadIO m
                  , MonadUnliftIO m
+                 , Alternative m
                  )
               => GHCTargetVersion -- ^ the version to install
               -> InstallDir
@@ -533,6 +537,11 @@ installGHCBin :: ( MonadFail m
                     , ProcessError
                     , UninstallFailed
                     , MergeFileTreeError
+                    , NoCompatiblePlatform
+                    , ParseError
+                    , UnsupportedSetupCombo
+                    , DistroNotFound
+                    , NoCompatibleArch
                     ]
                    m
                    ()
@@ -754,7 +763,8 @@ rmGHCVer ver = do
 
   Dirs {..} <- lift getDirs
 
-  lift $ hideError doesNotExistErrorType $ rmDirectoryLink (fromGHCupPath baseDir </> "share")
+  when isSetGHC $ do
+    lift $ hideError doesNotExistErrorType $ rmDirectoryLink (fromGHCupPath baseDir </> "share")
 
 
 

lib/GHCup/HLS.hs

@@ -717,8 +717,10 @@ getCabalVersion fp = do
   gpd <- case parseGenericPackageDescriptionMaybe contents of
            Nothing -> fail $ "could not parse cabal file: " <> fp
            Just r -> pure r
-  let tver = (\c -> Version Nothing c [] Nothing)
+  let tver = (\c -> Version Nothing c Nothing Nothing)
-           . NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
+           . Chunks
+           . NE.fromList
+           . fmap (Numeric . fromIntegral)
            . versionNumbers
            . pkgVersion
            . package

lib/GHCup/Platform.hs

@@ -28,6 +28,8 @@ import           GHCup.Prelude
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.Process
 import           GHCup.Prelude.String.QQ
+import           GHCup.Prelude.Version.QQ
+import           GHCup.Prelude.MegaParsec
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -48,11 +50,18 @@ import           Prelude                 hiding ( abs
                                                 )
 import           System.Info
 import           System.OsRelease
+import           System.Exit
+import           System.FilePath
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           Text.Regex.Posix
 
+import qualified Text.Megaparsec               as MP
+
 import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
+import           Data.Void
+import qualified Data.List                     as L
+
 
 
 
@@ -143,6 +152,9 @@ getLinuxDistro = do
         | hasWord name ["exherbo"] -> Exherbo
         | hasWord name ["gentoo"]  -> Gentoo
         | hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
+        | hasWord name ["rocky", "Rocky Linux"] -> Rocky
+        -- https://github.com/void-linux/void-packages/blob/master/srcpkgs/base-files/files/os-release
+        | hasWord name ["void", "Void Linux"] -> Void
         | otherwise                -> UnknownLinux
   pure (distro, parsedVer)
  where
@@ -197,3 +209,155 @@ getLinuxDistro = do
   try_debian_version = do
     ver <- T.readFile debian_version
     pure (T.pack "debian", Just ver)
+
+
+getStackGhcBuilds :: (MonadReader env m, HasLog env, MonadIO m)
+                  => PlatformResult
+                  -> Excepts '[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError] m [String]
+getStackGhcBuilds PlatformResult{..} = do
+    case _platform of
+      Linux _ -> do
+        -- Some systems don't have ldconfig in the PATH, so make sure to look in
+        -- /sbin and /usr/sbin as well
+        sbinEnv <- liftIO $ addToPath sbinDirs False
+        ldConfig <- lift $ executeOut' "ldconfig" ["-p"] Nothing (Just sbinEnv)
+        firstWords <- case ldConfig of
+                        CapturedProcess ExitSuccess so _ ->
+                          pure . mapMaybe (listToMaybe . T.words) . T.lines . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ so
+                        CapturedProcess (ExitFailure _) _ _ ->
+                          -- throwE $ NonZeroExit c "ldconfig" ["-p" ]
+                          pure []
+        let checkLib :: (MonadReader env m, HasLog env, MonadIO m) => String -> m Bool
+            checkLib lib
+              | libT `elem` firstWords = do
+                  logDebug $ "Found shared library " <> libT <> " in 'ldconfig -p' output"
+                  pure True
+              | isWindows =
+                  -- Cannot parse /usr/lib on Windows
+                  pure False
+              | otherwise = hasMatches lib usrLibDirs
+              -- This is a workaround for the fact that libtinfo.so.x doesn't
+              -- appear in the 'ldconfig -p' output on Arch or Slackware even
+              -- when it exists. There doesn't seem to be an easy way to get the
+              -- true list of directories to scan for shared libs, but this
+              -- works for our particular cases.
+             where
+              libT = T.pack lib
+
+            hasMatches :: (MonadReader env m, HasLog env, MonadIO m) => String -> [FilePath] -> m Bool
+            hasMatches lib dirs = do
+              matches <- filterM (liftIO . doesFileExist . (</> lib)) dirs
+              case matches of
+                [] -> logDebug ("Did not find shared library " <> libT) >> pure False
+                (path:_) -> logDebug ("Found shared library " <> libT <> " in " <> T.pack path) >> pure True
+             where
+              libT = T.pack lib
+
+            getLibc6Version :: MonadIO m
+                            => Excepts '[ParseError, ProcessError] m Version
+            getLibc6Version = do
+              CapturedProcess{..} <- lift $ executeOut "ldd" ["--version"] Nothing
+              case _exitCode of
+                ExitSuccess -> either (throwE . ParseError . show) pure
+                                 . MP.parse lddVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
+                ExitFailure c -> throwE $ NonZeroExit c "ldd" ["--version" ]
+
+            -- Assumes the first line of ldd has the format:
+            --
+            -- ldd (...) nn.nn
+            --
+            -- where nn.nn corresponds to the version of libc6.
+            lddVersion :: MP.Parsec Void Text Version
+            lddVersion = do
+              skipWhile (/= ')')
+              skip (== ')')
+              skipSpace
+              version'
+
+        hasMusl <- hasMatches relFileLibcMuslx86_64So1 libDirs
+        mLibc6Version <- veitherToEither <$> runE getLibc6Version
+        case mLibc6Version of
+          Right libc6Version -> logDebug $ "Found shared library libc6 in version: " <> prettyVer libc6Version
+          Left _ -> logDebug "Did not find a version of shared library libc6."
+        let hasLibc6_2_32 = either (const False) (>= [vver|2.32|]) mLibc6Version
+        hastinfo5 <- checkLib relFileLibtinfoSo5
+        hastinfo6 <- checkLib relFileLibtinfoSo6
+        hasncurses6 <- checkLib relFileLibncurseswSo6
+        hasgmp5 <- checkLib relFileLibgmpSo10
+        hasgmp4 <- checkLib relFileLibgmpSo3
+        let libComponents = if hasMusl
+              then
+                [ ["musl"] ]
+              else
+                concat
+                  [ if hastinfo6 && hasgmp5
+                    then
+                      if hasLibc6_2_32
+                      then [["tinfo6"]]
+                      else [["tinfo6-libc6-pre232"]]
+                    else [[]]
+                  , [ [] | hastinfo5 && hasgmp5 ]
+                  , [ ["ncurses6"] | hasncurses6 && hasgmp5 ]
+                  , [ ["gmp4"] | hasgmp4 ]
+                  ]
+        pure $ map
+          (\c -> case c of
+            [] -> []
+            _ -> L.intercalate "-" c)
+          libComponents
+      FreeBSD ->
+        case _distroVersion of
+          Just fVer
+            | fVer >= [vers|12|] -> pure []
+          _ -> pure ["ino64"]
+      Darwin  -> pure []
+      Windows -> pure []
+ where
+
+  relFileLibcMuslx86_64So1 :: FilePath
+  relFileLibcMuslx86_64So1 = "libc.musl-x86_64.so.1"
+  libDirs :: [FilePath]
+  libDirs = ["/lib", "/lib64"]
+  usrLibDirs :: [FilePath]
+  usrLibDirs = ["/usr/lib", "/usr/lib64"]
+  sbinDirs :: [FilePath]
+  sbinDirs = ["/sbin", "/usr/sbin"]
+  relFileLibtinfoSo5 :: FilePath
+  relFileLibtinfoSo5 = "libtinfo.so.5"
+  relFileLibtinfoSo6 :: FilePath
+  relFileLibtinfoSo6 = "libtinfo.so.6"
+  relFileLibncurseswSo6 :: FilePath
+  relFileLibncurseswSo6 = "libncursesw.so.6"
+  relFileLibgmpSo10 :: FilePath
+  relFileLibgmpSo10 = "libgmp.so.10"
+  relFileLibgmpSo3 :: FilePath
+  relFileLibgmpSo3 = "libgmp.so.3"
+
+getStackOSKey :: Monad m => PlatformRequest -> Excepts '[UnsupportedSetupCombo] m String
+getStackOSKey PlatformRequest { .. } =
+  case (_rArch, _rPlatform) of
+    (A_32   , Linux _) -> pure "linux32"
+    (A_64   , Linux _) -> pure "linux64"
+    (A_32   , Darwin ) -> pure "macosx"
+    (A_64   , Darwin ) -> pure "macosx"
+    (A_32   , FreeBSD) -> pure "freebsd32"
+    (A_64   , FreeBSD) -> pure "freebsd64"
+    (A_32   , Windows) -> pure "windows32"
+    (A_64   , Windows) -> pure "windows64"
+    (A_ARM  , Linux _) -> pure "linux-armv7"
+    (A_ARM64, Linux _) -> pure "linux-aarch64"
+    (A_Sparc, Linux _) -> pure "linux-sparc"
+    (A_ARM64, Darwin ) -> pure "macosx-aarch64"
+    (A_ARM64, FreeBSD) -> pure "freebsd-aarch64"
+    (arch', os') -> throwE $ UnsupportedSetupCombo arch' os'
+
+getStackPlatformKey :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
+                    => PlatformRequest
+                    -> Excepts '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform, NoCompatibleArch, DistroNotFound, ProcessError] m [String]
+getStackPlatformKey pfreq@PlatformRequest{..} = do
+  osKey <- liftE  $ getStackOSKey pfreq
+  builds <- liftE $ getStackGhcBuilds (PlatformResult _rPlatform _rVersion)
+  let builds' = (\build -> if null build then osKey else osKey <> "-" <> build) <$> builds
+  logDebug $ "Potential GHC builds: " <> mconcat (L.intersperse ", " $ fmap T.pack builds')
+  pure builds'
+

lib/GHCup/Prelude.hs

@@ -43,6 +43,10 @@ import           Control.Monad.Reader
 import           Haskus.Utils.Variant.Excepts
 import           Text.PrettyPrint.HughesPJClass ( Pretty )
 import qualified Data.Text                     as T
+import System.Environment (getEnvironment)
+import qualified Data.Map.Strict               as Map
+import System.FilePath
+import Data.List (intercalate)
 
 
 
@@ -88,3 +92,25 @@ throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excep
 {-# INLINABLE throwSomeE #-}
 throwSomeE = Excepts . pure . VLeft . liftVariant
 #endif
+
+addToPath :: [FilePath]
+          -> Bool         -- ^ if False will prepend
+          -> IO [(String, String)]
+addToPath paths append = do
+ cEnv <- getEnvironment
+ return $ addToPath' cEnv paths append
+
+addToPath' :: [(String, String)]
+          -> [FilePath]
+          -> Bool         -- ^ if False will prepend
+          -> [(String, String)]
+addToPath' cEnv' newPaths append =
+  let cEnv           = Map.fromList cEnv'
+      paths          = ["PATH", "Path"]
+      curPaths       = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
+      {- HLINT ignore "Redundant bracket" -}
+      newPath        = intercalate [searchPathSeparator] (if append then (curPaths ++ newPaths) else (newPaths ++ 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
+  in envWithNewPath

lib/GHCup/Prelude/File.hs

@@ -387,7 +387,7 @@ rmLink fp
 --
 -- This overwrites previously existing files.
 --
--- On windows, this requires that 'ensureGlobalTools' was run beforehand.
+-- On windows, this requires that 'ensureShimGen' was run beforehand.
 createLink :: ( MonadMask m
               , MonadThrow m
               , HasLog env

lib/GHCup/Prelude/Logger/Internal.hs

@@ -80,7 +80,7 @@ logInternal logLevel msg = do
         Info    -> style' "[ Info  ]"
         Warn    -> style' "[ Warn  ]"
         Error   -> style' "[ Error ]"
-  let strs = T.split (== '\n') msg
+  let strs = T.split (== '\n') . T.dropWhileEnd (`elem` ("\n\r" :: String)) $ msg
   let out = case strs of
               [] -> T.empty
               (x:xs) ->

lib/GHCup/Prelude/MegaParsec.hs

@@ -91,18 +91,16 @@ ghcTargetVerP =
   verP' :: MP.Parsec Void Text Text
   verP' = do
     v <- version'
-    let startsWithDigists =
+    let startsWithDigits =
           and
             . take 3
-            . concatMap
+            . map (\case
-              (map
+                      Numeric  _ -> True
-                (\case
+                      Alphanum _ -> False)
-                  (Digits _) -> True
-                  (Str    _) -> False
-                ) . NE.toList)
             . NE.toList
+            . (\(Chunks nec) -> nec)
             $ _vChunks v
-    if startsWithDigists && isNothing (_vEpoch v)
+    if startsWithDigits && isNothing (_vEpoch v)
       then pure $ prettyVer v
       else fail "Oh"
 
@@ -122,3 +120,17 @@ verP suffix = do
 
 pathSep :: MP.Parsec Void Text Char
 pathSep = MP.oneOf pathSeparators
+
+skipWhile :: (Char -> Bool) -> MP.Parsec Void Text ()
+skipWhile f = void $ MP.takeWhileP Nothing f
+
+skip :: (Char -> Bool) -> MP.Parsec Void Text ()
+skip f = void $ MP.satisfy f
+
+skipSpace :: MP.Parsec Void Text ()
+skipSpace = void $ MP.satisfy isSpace
+
+isSpace :: Char -> Bool
+isSpace c = (c == ' ') || ('\t' <= c && c <= '\r')
+{-# INLINE isSpace #-}
+

lib/GHCup/Prelude/Process.hs

@@ -11,6 +11,7 @@ Portability : portable
 -}
 module GHCup.Prelude.Process (
   executeOut,
+  executeOut',
   execLogged,
   exec,
   toProcessError,

lib/GHCup/Prelude/Process/Posix.hs

@@ -70,6 +70,16 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
   maybe (pure ()) changeWorkingDirectory chdir
   SPP.executeFile path True args Nothing
 
+executeOut' :: MonadIO m
+            => FilePath          -- ^ command as filename, e.g. 'ls'
+            -> [String]          -- ^ arguments to the command
+            -> Maybe FilePath    -- ^ chdir to this path
+            -> Maybe [(String, String)]
+            -> m CapturedProcess
+executeOut' path args chdir env = liftIO $ captureOutStreams $ do
+  maybe (pure ()) changeWorkingDirectory chdir
+  SPP.executeFile path True args env
+
 
 execLogged :: ( MonadReader env m
               , HasSettings env
@@ -169,7 +179,7 @@ execLogged exe args chdir lfile env = do
     overwriteNthLine n str = pos1 <> moveLineUp n <> clearLine <> str <> moveLineDown n <> pos1
 
     blue :: ByteString -> ByteString
-    blue bs 
+    blue bs
       | no_color = bs
       | otherwise = "\x1b[0;34m" <> bs <> "\x1b[0m"
 

lib/GHCup/Prelude/Process/Windows.hs

@@ -140,8 +140,16 @@ executeOut :: MonadIO m
            -> [String]          -- ^ arguments to the command
            -> Maybe FilePath    -- ^ chdir to this path
            -> m CapturedProcess
-executeOut path args chdir = do
+executeOut path args chdir = executeOut' path args chdir Nothing
-  cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir })
+
+executeOut' :: MonadIO m
+            => FilePath          -- ^ command as filename, e.g. 'ls'
+            -> [String]          -- ^ arguments to the command
+            -> Maybe FilePath    -- ^ chdir to this path
+            -> Maybe [(String, String)]
+            -> m CapturedProcess
+executeOut' path args chdir env' = do
+  cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir, env = env' })
   (exit, out, err) <- liftIO $ readCreateProcessWithExitCodeBS cp ""
   pure $ CapturedProcess exit out err
 

lib/GHCup/Prelude/Version/QQ.hs

@@ -26,36 +26,14 @@ import           GHC.Base
 #endif
 import           Language.Haskell.TH
 import           Language.Haskell.TH.Quote      ( QuasiQuoter(..) )
-import           Language.Haskell.TH.Syntax     ( Lift
+import           Language.Haskell.TH.Syntax     ( dataToExpQ )
-                                                , dataToExpQ
-                                                )
 import qualified Data.Text                     as T
 import qualified Language.Haskell.TH.Syntax    as TH
 
 
-
-deriving instance Data Versioning
-deriving instance Lift Versioning
-deriving instance Data Version
-deriving instance Lift Version
-deriving instance Data SemVer
-deriving instance Lift SemVer
-deriving instance Data Mess
-deriving instance Lift Mess
-deriving instance Data MChunk
-deriving instance Lift MChunk
-deriving instance Data PVP
-deriving instance Lift PVP
-deriving instance Lift VSep
-deriving instance Data VSep
-deriving instance Lift VUnit
-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/Stack.hs

@@ -234,7 +234,7 @@ setStack ver = do
 
   liftIO (isShadowed stackbin) >>= \case
     Nothing -> pure ()
-    Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Cabal pa stackbin ver)
+    Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Stack pa stackbin ver)
 
   pure ()
 

lib/GHCup/Types.hs

@@ -22,10 +22,12 @@ module GHCup.Types
   ( module GHCup.Types
 #if defined(BRICK)
   , Key(..)
+  , Modifier(..)
 #endif
   )
   where
 
+import           GHCup.Types.Stack              ( SetupInfo )
 import {-# SOURCE #-} GHCup.Utils.Dirs          ( fromGHCupPath, GHCupPath )
 
 import           Control.DeepSeq                ( NFData, rnf )
@@ -39,14 +41,13 @@ import           Optics                         ( makeLenses )
 import           Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
 import           URI.ByteString
 #if defined(BRICK)
-import           Graphics.Vty                   ( Key(..) )
+import           Graphics.Vty                   ( Key(..), Modifier(..) )
 #endif
 
 import qualified Data.ByteString.Lazy          as BL
 import qualified Data.Text                     as T
 import qualified GHC.Generics                  as GHC
 import qualified Data.List.NonEmpty            as NE
-import           Data.Foldable                  (foldMap)
 
 #if !defined(BRICK)
 data Key = KEsc  | KChar Char | KBS | KEnter
@@ -55,8 +56,15 @@ data Key = KEsc  | KChar Char | KBS | KEnter
          | KFun Int | KBackTab | KPrtScr | KPause | KIns
          | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
     deriving (Eq,Show,Read,Ord,GHC.Generic)
+
+data Modifier = MShift | MCtrl | MMeta | MAlt
+    deriving (Eq,Show,Read,Ord,GHC.Generic)
 #endif
 
+data KeyCombination = KeyCombination { key :: Key, mods :: [Modifier] }
+    deriving (Eq,Show,Read,Ord,GHC.Generic)
+
+
 
     --------------------
     --[ GHCInfo Tree ]--
@@ -66,7 +74,7 @@ data Key = KEsc  | KChar Char | KBS | KEnter
 data GHCupInfo = GHCupInfo
   { _toolRequirements :: ToolRequirements
   , _ghcupDownloads   :: GHCupDownloads
-  , _globalTools      :: Map GlobalTool DownloadInfo
+  , _metadataUpdate   :: Maybe URI
   }
   deriving (Show, GHC.Generic, Eq)
 
@@ -128,14 +136,6 @@ instance Pretty Tool where
 
 instance NFData Tool
 
-data GlobalTool = ShimGen
-  deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
-
-instance NFData GlobalTool
-
-instance Pretty GlobalTool where
-  pPrint ShimGen = text "shimgen"
-
 
 -- | All necessary information of a tool version, including
 -- source download and per-architecture downloads.
@@ -157,13 +157,17 @@ instance NFData VersionInfo
 
 
 -- | A tag. These are currently attached to a version of a tool.
-data Tag = Latest
+data Tag = Latest             -- ^ the latest version of a tool (unique per tool)
-         | Recommended
+         | Recommended        -- ^ the recommended version of a tool (unique per tool)
-         | Prerelease
+         | Prerelease         -- ^ denotes a prerelease version
-         | LatestPrerelease
+                              --   (a version should either be 'Prerelease' or
-         | Nightly
+                              --   'LatestPrerelease', but not both)
-         | LatestNightly
+         | LatestPrerelease   -- ^ the latest prerelease (unique per tool)
-         | Base PVP
+         | Nightly            -- ^ denotes a nightly version
+                              --   (a version should either be 'Nightly' or
+                              --   'LatestNightly', but not both)
+         | LatestNightly      -- ^ the latest nightly (unique per tool)
+         | Base PVP           -- ^ the base version shipped with GHC
          | Old                -- ^ old versions are hidden by default in TUI
          | UnknownTag String  -- ^ used for upwardscompat
          deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
@@ -189,7 +193,7 @@ instance Pretty Tag where
   pPrint (Base       pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
   pPrint (UnknownTag t    ) = text t
   pPrint LatestPrerelease   = text "latest-prerelease"
-  pPrint LatestNightly   = text "latest-prerelease"
+  pPrint LatestNightly      = text "latest-prerelease"
   pPrint Old                = mempty
 
 data Architecture = A_64
@@ -245,13 +249,18 @@ data LinuxDistro = Debian
                  | RedHat
                  | Alpine
                  | AmazonLinux
+                 | Rocky
+                 | Void
                  -- rolling
                  | Gentoo
                  | Exherbo
                  -- not known
                  | UnknownLinux
                  -- ^ must exit
-  deriving (Eq, GHC.Generic, Ord, Show)
+  deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
+
+allDistros :: [LinuxDistro]
+allDistros = enumFromTo minBound maxBound
 
 instance NFData LinuxDistro
 
@@ -264,6 +273,8 @@ distroToString CentOS = "centos"
 distroToString RedHat = "redhat"
 distroToString Alpine = "alpine"
 distroToString AmazonLinux = "amazon"
+distroToString Rocky = "rocky"
+distroToString Void = "void"
 distroToString Gentoo = "gentoo"
 distroToString Exherbo = "exherbo"
 distroToString UnknownLinux = "unknown"
@@ -323,15 +334,41 @@ instance Pretty TarDir where
 
 -- | Where to fetch GHCupDownloads from.
 data URLSource = GHCupURL
-               | OwnSource [Either GHCupInfo URI] -- ^ complete source list
+               | StackSetupURL
-               | OwnSpec GHCupInfo
+               | OwnSource     [Either (Either GHCupInfo SetupInfo) URI] -- ^ complete source list
-               | AddSource [Either GHCupInfo URI] -- ^ merge with GHCupURL
+               | OwnSpec               (Either GHCupInfo SetupInfo)
-               deriving (GHC.Generic, Show)
+               | AddSource     [Either (Either GHCupInfo SetupInfo) URI] -- ^ merge with GHCupURL
+               | SimpleList    [NewURLSource]
+               deriving (Eq, GHC.Generic, Show)
+
+data NewURLSource = NewGHCupURL
+                  | NewStackSetupURL
+                  | NewGHCupInfo     GHCupInfo
+                  | NewSetupInfo     SetupInfo
+                  | NewURI           URI
+               deriving (Eq, GHC.Generic, Show)
+
+instance NFData NewURLSource
+
+fromURLSource :: URLSource -> [NewURLSource]
+fromURLSource GHCupURL              = [NewGHCupURL]
+fromURLSource StackSetupURL         = [NewStackSetupURL]
+fromURLSource (OwnSource arr)       = convert' <$> arr
+fromURLSource (AddSource arr)       = NewGHCupURL:(convert' <$> arr)
+fromURLSource (SimpleList arr)      = arr
+fromURLSource (OwnSpec (Left gi))   = [NewGHCupInfo gi]
+fromURLSource (OwnSpec (Right si)) = [NewSetupInfo si]
+
+convert' :: Either (Either GHCupInfo SetupInfo) URI -> NewURLSource
+convert' (Left (Left gi))  = NewGHCupInfo gi
+convert' (Left (Right si)) = NewSetupInfo si
+convert' (Right uri)       = NewURI uri
 
 instance NFData URLSource
 instance NFData (URIRef Absolute) where
   rnf (URI !_ !_ !_ !_ !_) = ()
 
+
 data MetaMode = Strict
               | Lax
   deriving (Show, Read, Eq, GHC.Generic)
@@ -353,7 +390,7 @@ data UserSettings = UserSettings
   , uPlatformOverride :: Maybe PlatformRequest
   , uMirrors     :: Maybe DownloadMirrors
   }
-  deriving (Show, GHC.Generic)
+  deriving (Show, GHC.Generic, Eq)
 
 defaultUserSettings :: UserSettings
 defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
@@ -385,7 +422,6 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
             , kSet          = Just bSet
             , kChangelog    = Just bChangelog
             , kShowAll      = Just bShowAllVersions
-            , kShowAllTools = Just bShowAllTools
             }
   in UserSettings {
       uCache = Just cache
@@ -404,47 +440,48 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
   }
 
 data UserKeyBindings = UserKeyBindings
-  { kUp        :: Maybe Key
+  { kUp           :: Maybe KeyCombination
-  , kDown      :: Maybe Key
+  , kDown         :: Maybe KeyCombination
-  , kQuit      :: Maybe Key
+  , kQuit         :: Maybe KeyCombination
-  , kInstall   :: Maybe Key
+  , kInstall      :: Maybe KeyCombination
-  , kUninstall :: Maybe Key
+  , kUninstall    :: Maybe KeyCombination
-  , kSet       :: Maybe Key
+  , kSet          :: Maybe KeyCombination
-  , kChangelog :: Maybe Key
+  , kChangelog    :: Maybe KeyCombination
-  , kShowAll   :: Maybe Key
+  , kShowAll      :: Maybe KeyCombination
-  , kShowAllTools :: Maybe Key
   }
-  deriving (Show, GHC.Generic)
+  deriving (Show, GHC.Generic, Eq)
 
 data KeyBindings = KeyBindings
-  { bUp        :: Key
+  { bUp              :: KeyCombination
-  , bDown      :: Key
+  , bDown            :: KeyCombination
-  , bQuit      :: Key
+  , bQuit            :: KeyCombination
-  , bInstall   :: Key
+  , bInstall         :: KeyCombination
-  , bUninstall :: Key
+  , bUninstall       :: KeyCombination
-  , bSet       :: Key
+  , bSet             :: KeyCombination
-  , bChangelog :: Key
+  , bChangelog       :: KeyCombination
-  , bShowAllVersions :: Key
+  , bShowAllVersions :: KeyCombination
-  , bShowAllTools :: Key
   }
   deriving (Show, GHC.Generic)
 
 instance NFData KeyBindings
-#if defined(IS_WINDOWS) || !defined(BRICK)
+#if !defined(BRICK)
 instance NFData Key
+
+instance NFData Modifier
+
 #endif
+instance NFData KeyCombination
 
 defaultKeyBindings :: KeyBindings
 defaultKeyBindings = KeyBindings
-  { bUp = KUp
+  { bUp              = KeyCombination { key = KUp      , mods = [] }
-  , bDown = KDown
+  , bDown            = KeyCombination { key = KDown    , mods = [] }
-  , bQuit = KChar 'q'
+  , bQuit            = KeyCombination { key = KChar 'q', mods = [] }
-  , bInstall = KChar 'i'
+  , bInstall         = KeyCombination { key = KChar 'i', mods = [] }
-  , bUninstall = KChar 'u'
+  , bUninstall       = KeyCombination { key = KChar 'u', mods = [] }
-  , bSet = KChar 's'
+  , bSet             = KeyCombination { key = KChar 's', mods = [] }
-  , bChangelog = KChar 'c'
+  , bChangelog       = KeyCombination { key = KChar 'c', mods = [] }
-  , bShowAllVersions = KChar 'a'
+  , bShowAllVersions = KeyCombination { key = KChar 'a', mods = [] }
-  , bShowAllTools = KChar 't'
   }
 
 data AppState = AppState
@@ -738,3 +775,4 @@ instance Pretty ToolVersion where
 data BuildSystem = Hadrian
                  | Make
   deriving (Show, Eq)
+

lib/GHCup/Types/JSON.hs

@@ -22,7 +22,9 @@ Portability : portable
 module GHCup.Types.JSON where
 
 import           GHCup.Types
+import           GHCup.Types.Stack (SetupInfo)
 import           GHCup.Types.JSON.Utils
+import           GHCup.Types.JSON.Versions ()
 import           GHCup.Prelude.MegaParsec
 
 import           Control.Applicative            ( (<|>) )
@@ -31,7 +33,9 @@ import           Data.Aeson.TH
 import           Data.Aeson.Types        hiding (Key)
 import           Data.ByteString                ( ByteString )
 import           Data.List.NonEmpty             ( NonEmpty(..) )
+import           Data.Maybe
 import           Data.Text.Encoding            as E
+import           Data.Foldable
 import           Data.Versions
 import           Data.Void
 import           URI.ByteString
@@ -48,13 +52,13 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Chunk
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Release
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GPGSetting
@@ -111,34 +115,6 @@ instance FromJSONKey GHCTargetVersion where
     Right x -> pure x
     Left  e -> fail $ "Failure in GHCTargetVersion (FromJSONKey)" <> show e
 
-instance ToJSON Versioning where
-  toJSON = toJSON . prettyV
-
-instance FromJSON Versioning where
-  parseJSON = withText "Versioning" $ \t -> case versioning t of
-    Right x -> pure x
-    Left  e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
-
-instance ToJSONKey Versioning where
-  toJSONKey = toJSONKeyText $ \x -> prettyV x
-
-instance FromJSONKey Versioning where
-  fromJSONKey = FromJSONKeyTextParser $ \t -> case versioning t of
-    Right x -> pure x
-    Left  e -> fail $ "Failure in Versioning (FromJSONKey)" <> show e
-
-instance ToJSONKey (Maybe Versioning) where
-  toJSONKey = toJSONKeyText $ \case
-    Just x  -> prettyV x
-    Nothing -> T.pack "unknown_versioning"
-
-instance FromJSONKey (Maybe Versioning) where
-  fromJSONKey = FromJSONKeyTextParser $ \t ->
-    if t == T.pack "unknown_versioning" then pure Nothing else just t
-   where
-    just t = case versioning t of
-      Right x -> pure $ Just x
-      Left  e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
 
 instance ToJSONKey Platform where
   toJSONKey = toJSONKeyText $ \case
@@ -175,55 +151,12 @@ instance ToJSONKey Architecture where
 instance FromJSONKey Architecture where
   fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
 
-instance ToJSONKey (Maybe Version) where
-  toJSONKey = toJSONKeyText $ \case
-    Just x  -> prettyVer x
-    Nothing -> T.pack "unknown_version"
-
-instance FromJSONKey (Maybe Version) where
-  fromJSONKey = FromJSONKeyTextParser $ \t ->
-    if t == T.pack "unknown_version" then pure Nothing else just t
-   where
-    just t = case version t of
-      Right x -> pure $ Just x
-      Left  e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
-
-instance ToJSON Version where
-  toJSON = toJSON . prettyVer
-
-instance FromJSON Version where
-  parseJSON = withText "Version" $ \t -> case version t of
-    Right x -> pure x
-    Left  e -> fail $ "Failure in Version (FromJSON)" <> show e
-
-instance ToJSONKey Version where
-  toJSONKey = toJSONKeyText $ \x -> prettyVer x
-
-instance FromJSONKey Version where
-  fromJSONKey = FromJSONKeyTextParser $ \t -> case version t of
-    Right x -> pure x
-    Left  e -> fail $ "Failure in Version (FromJSONKey)" <> show e
-
-instance ToJSON PVP where
-  toJSON = toJSON . prettyPVP
-
-instance FromJSON PVP where
-  parseJSON = withText "PVP" $ \t -> case pvp t of
-    Right x -> pure x
-    Left  e -> fail $ "Failure in PVP (FromJSON)" <> show e
-
 instance ToJSONKey Tool where
   toJSONKey = genericToJSONKey defaultJSONKeyOptions
 
 instance FromJSONKey Tool where
   fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
 
-instance ToJSONKey GlobalTool where
-  toJSONKey = genericToJSONKey defaultJSONKeyOptions
-
-instance FromJSONKey GlobalTool where
-  fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
-
 instance ToJSON TarDir where
   toJSON (RealDir  p) = toJSON p
   toJSON (RegexDir r) = object ["RegexDir" .= r]
@@ -341,33 +274,64 @@ instance FromJSONKey (Maybe VersionRange)  where
       Left  e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
 
 
-
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
+
-deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
+instance FromJSON GHCupInfo where
+  parseJSON = withObject "GHCupInfo" $ \o -> do
+    toolRequirements' <- o .:? "toolRequirements"
+    metadataUpdate    <- o .:? "metadataUpdate"
+    ghcupDownloads'   <- o .:  "ghcupDownloads"
+    pure (GHCupInfo (fromMaybe mempty toolRequirements') ghcupDownloads' metadataUpdate)
+
+deriveToJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
+
+instance ToJSON NewURLSource where
+  toJSON NewGHCupURL       = String "GHCupURL"
+  toJSON NewStackSetupURL  = String "StackSetupURL"
+  toJSON (NewGHCupInfo gi) = object [ "ghcup-info" .= gi ]
+  toJSON (NewSetupInfo si) = object [ "setup-info" .= si ]
+  toJSON (NewURI uri)      = toJSON uri
+
+instance ToJSON URLSource where
+  toJSON = toJSON . fromURLSource
+
 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 { sumEncoding = ObjectWithSingleField } ''Modifier
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Port
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Host
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''UserInfo
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' (T.unpack . T.toLower) . T.stripPrefix (T.pack "authority") . T.pack $ str' } ''Authority
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirror
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirrors
-deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
-deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
 
 instance FromJSON URLSource where
   parseJSON v =
         parseGHCupURL v
+    <|> parseStackURL v
     <|> parseOwnSourceLegacy v
     <|> parseOwnSourceNew1 v
     <|> parseOwnSourceNew2 v
     <|> parseOwnSpec v
     <|> legacyParseAddSource v
     <|> newParseAddSource v
+    -- new since Stack SetupInfo
+    <|> parseOwnSpecNew v
+    <|> parseOwnSourceNew3 v
+    <|> newParseAddSource2 v
+    -- more lenient versions
+    <|> parseOwnSpecLenient v
+    <|> parseOwnSourceLenient v
+    <|> parseAddSourceLenient v
+    -- simplified list
+    <|> parseNewUrlSource v
+    <|> parseNewUrlSource' v
    where
+    convert'' :: Either GHCupInfo URI -> Either (Either GHCupInfo SetupInfo) URI
+    convert'' (Left gi)  = Left (Left gi)
+    convert'' (Right uri) = Right uri
+
     parseOwnSourceLegacy = withObject "URLSource" $ \o -> do
       r :: URI <- o .: "OwnSource"
       pure (OwnSource [Right r])
@@ -376,18 +340,100 @@ instance FromJSON URLSource where
       pure (OwnSource (fmap Right r))
     parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
       r :: [Either GHCupInfo URI] <- o .: "OwnSource"
-      pure (OwnSource r)
+      pure (OwnSource (convert'' <$> r))
     parseOwnSpec = withObject "URLSource" $ \o -> do
       r :: GHCupInfo <- o .: "OwnSpec"
-      pure (OwnSpec r)
+      pure (OwnSpec $ Left r)
     parseGHCupURL = withObject "URLSource" $ \o -> do
       _ :: [Value] <- o .: "GHCupURL"
       pure GHCupURL
+    parseStackURL = withObject "URLSource" $ \o -> do
+      _ :: [Value] <- o .: "StackSetupURL"
+      pure StackSetupURL
     legacyParseAddSource = withObject "URLSource" $ \o -> do
       r :: Either GHCupInfo URI <- o .: "AddSource"
-      pure (AddSource [r])
+      pure (AddSource [convert'' r])
     newParseAddSource = withObject "URLSource" $ \o -> do
       r :: [Either GHCupInfo URI] <- o .: "AddSource"
+      pure (AddSource (convert'' <$> r))
+
+    -- new since Stack SetupInfo
+    parseOwnSpecNew = withObject "URLSource" $ \o -> do
+      r :: Either GHCupInfo SetupInfo <- o .: "OwnSpec"
+      pure (OwnSpec r)
+    parseOwnSourceNew3 = withObject "URLSource" $ \o -> do
+      r :: [Either (Either GHCupInfo SetupInfo) URI] <- o .: "OwnSource"
+      pure (OwnSource r)
+    newParseAddSource2 = withObject "URLSource" $ \o -> do
+      r :: [Either (Either GHCupInfo SetupInfo) URI] <- o .: "AddSource"
       pure (AddSource r)
 
+    -- more lenient versions
+    parseOwnSpecLenient = withObject "URLSource" $ \o -> do
+      spec :: Object <- o .: "OwnSpec"
+      OwnSpec <$> lenientInfoParser spec
+    parseOwnSourceLenient = withObject "URLSource" $ \o -> do
+      mown :: Array <- o .: "OwnSource"
+      OwnSource . toList <$> mapM lenientInfoUriParser mown
+    parseAddSourceLenient = withObject "URLSource" $ \o -> do
+      madd :: Array <- o .: "AddSource"
+      AddSource . toList <$> mapM lenientInfoUriParser madd
+
+    -- simplified
+    parseNewUrlSource = withArray "URLSource" $ \a -> do
+      SimpleList . toList <$> mapM parseJSON a
+    parseNewUrlSource' v' = SimpleList .(:[]) <$> parseJSON v'
+
+
+lenientInfoUriParser :: Value -> Parser (Either (Either GHCupInfo SetupInfo) URI)
+lenientInfoUriParser (Object o) = Left <$> lenientInfoParser o
+lenientInfoUriParser v@(String _) = Right <$> parseJSON v
+lenientInfoUriParser _ = fail "Unexpected json in lenientInfoUriParser"
+
+
+lenientInfoParser :: Object -> Parser (Either GHCupInfo SetupInfo)
+lenientInfoParser o = do
+  setup_info :: Maybe Object <- o .:? "setup-info"
+  case setup_info of
+    Nothing -> do
+      r <- parseJSON (Object o)
+      pure $ Left r
+    Just setup_info' -> do
+      r <- parseJSON (Object setup_info')
+      pure $ Right r
+
+instance FromJSON NewURLSource where
+  parseJSON v = uri v <|> url v <|> gi v <|> si v
+   where
+    uri = withText "NewURLSource" $ \t -> NewURI <$> parseJSON (String t)
+    url = withText "NewURLSource" $ \t -> case T.unpack t of
+                                            "GHCupURL" -> pure NewGHCupURL
+                                            "StackSetupURL" -> pure NewStackSetupURL
+                                            t' -> fail $ "Unexpected text value in NewURLSource: " <> t'
+    gi = withObject "NewURLSource" $ \o -> do
+       ginfo :: GHCupInfo <- o .: "ghcup-info"
+       pure $ NewGHCupInfo ginfo
+
+    si = withObject "NewURLSource" $ \o -> do
+       sinfo :: SetupInfo <- o .: "setup-info"
+       pure $ NewSetupInfo sinfo
+
+
+instance FromJSON KeyCombination where
+  parseJSON v = proper v <|> simple v
+   where
+    simple = withObject "KeyCombination" $ \o -> do
+      k <- parseJSON (Object o)
+      pure (KeyCombination k [])
+    proper = withObject "KeyCombination" $ \o -> do
+      k <- o .: "Key"
+      m <- o .: "Mods"
+      pure $ KeyCombination k m
+
+instance ToJSON KeyCombination where
+  toJSON (KeyCombination k m) = object ["Key" .= k, "Mods" .= m]
+
+deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings 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
+deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings

lib/GHCup/Types/JSON/Versions.hs

@@ -0,0 +1,90 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies          #-}
+
+{-|
+Module      : GHCup.Types.JSON.Versions
+Description : GHCup Version JSON types/instances
+Copyright   : (c) Julian Ospald, 2020
+License     : LGPL-3.0
+Maintainer  : hasufell@hasufell.de
+Stability   : experimental
+Portability : portable
+-}
+module GHCup.Types.JSON.Versions where
+
+import           Data.Aeson              hiding (Key)
+import           Data.Aeson.Types        hiding (Key)
+import           Data.Versions
+
+import qualified Data.Text                     as T
+
+instance ToJSON Versioning where
+  toJSON = toJSON . prettyV
+
+instance FromJSON Versioning where
+  parseJSON = withText "Versioning" $ \t -> case versioning t of
+    Right x -> pure x
+    Left  e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
+
+instance ToJSONKey Versioning where
+  toJSONKey = toJSONKeyText $ \x -> prettyV x
+
+instance FromJSONKey Versioning where
+  fromJSONKey = FromJSONKeyTextParser $ \t -> case versioning t of
+    Right x -> pure x
+    Left  e -> fail $ "Failure in Versioning (FromJSONKey)" <> show e
+
+instance ToJSONKey (Maybe Versioning) where
+  toJSONKey = toJSONKeyText $ \case
+    Just x  -> prettyV x
+    Nothing -> T.pack "unknown_versioning"
+
+instance FromJSONKey (Maybe Versioning) where
+  fromJSONKey = FromJSONKeyTextParser $ \t ->
+    if t == T.pack "unknown_versioning" then pure Nothing else just t
+   where
+    just t = case versioning t of
+      Right x -> pure $ Just x
+      Left  e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
+
+instance ToJSONKey (Maybe Version) where
+  toJSONKey = toJSONKeyText $ \case
+    Just x  -> prettyVer x
+    Nothing -> T.pack "unknown_version"
+
+instance FromJSONKey (Maybe Version) where
+  fromJSONKey = FromJSONKeyTextParser $ \t ->
+    if t == T.pack "unknown_version" then pure Nothing else just t
+   where
+    just t = case version t of
+      Right x -> pure $ Just x
+      Left  e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
+
+instance ToJSON Version where
+  toJSON = toJSON . prettyVer
+
+instance FromJSON Version where
+  parseJSON = withText "Version" $ \t -> case version t of
+    Right x -> pure x
+    Left  e -> fail $ "Failure in Version (FromJSON)" <> show e
+
+instance ToJSONKey Version where
+  toJSONKey = toJSONKeyText $ \x -> prettyVer x
+
+instance FromJSONKey Version where
+  fromJSONKey = FromJSONKeyTextParser $ \t -> case version t of
+    Right x -> pure x
+    Left  e -> fail $ "Failure in Version (FromJSONKey)" <> show e
+
+instance ToJSON PVP where
+  toJSON = toJSON . prettyPVP
+
+instance FromJSON PVP where
+  parseJSON = withText "PVP" $ \t -> case pvp t of
+    Right x -> pure x
+    Left  e -> fail $ "Failure in PVP (FromJSON)" <> show e

lib/GHCup/Types/Stack.hs

@@ -0,0 +1,180 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+{-|
+Module      : GHCup.Types.Stack
+Description : GHCup types.Stack
+Copyright   : (c) Julian Ospald, 2023
+License     : LGPL-3.0
+Maintainer  : hasufell@hasufell.de
+Stability   : experimental
+Portability : portable
+-}
+module GHCup.Types.Stack where
+
+import           GHCup.Types.JSON.Versions ()
+
+import           Control.Applicative
+import           Control.DeepSeq                ( NFData )
+import           Data.ByteString
+import           Data.Aeson
+import           Data.Aeson.Types
+import           Data.Map.Strict                ( Map )
+import           Data.Text                      ( Text )
+import           Data.Text.Encoding
+import           Data.Versions
+
+import qualified Data.Map as Map
+import qualified GHC.Generics                  as GHC
+
+
+    --------------------------------------
+    --[ Stack download info copy pasta ]--
+    --------------------------------------
+
+data SetupInfo = SetupInfo
+  { siSevenzExe :: Maybe DownloadInfo
+  , siSevenzDll :: Maybe DownloadInfo
+  , siMsys2     :: Map Text VersionedDownloadInfo
+  , siGHCs      :: Map Text (Map Version GHCDownloadInfo)
+  , siStack     :: Map Text (Map Version DownloadInfo)
+  }
+  deriving (Show, Eq, GHC.Generic)
+
+instance NFData SetupInfo
+
+instance FromJSON SetupInfo where
+  parseJSON = withObject "SetupInfo" $ \o -> do
+    siSevenzExe <- o .:? "sevenzexe-info"
+    siSevenzDll <- o .:? "sevenzdll-info"
+    siMsys2     <- o .:? "msys2"          .!= mempty
+    siGHCs      <- o .: "ghc"
+    siStack     <- o .:? "stack"          .!= mempty
+    pure SetupInfo {..}
+
+instance ToJSON SetupInfo where
+  toJSON (SetupInfo {..}) = object [ "sevenzexe-info" .= siSevenzExe
+                                   , "sevenzdll-info" .= siSevenzDll
+                                   , "msys2"          .= siMsys2
+                                   , "ghc"            .= siGHCs
+                                   , "stack"          .= siStack
+                                   ]
+
+-- | For the @siGHCs@ field maps are deeply merged. For all fields the values
+-- from the first @SetupInfo@ win.
+instance Semigroup SetupInfo where
+  l <> r =
+    SetupInfo
+    { siSevenzExe = siSevenzExe l <|> siSevenzExe r
+    , siSevenzDll = siSevenzDll l <|> siSevenzDll r
+    , siMsys2     = siMsys2 l <> siMsys2 r
+    , siGHCs      = Map.unionWith (<>) (siGHCs l) (siGHCs r)
+    , siStack     = Map.unionWith (<>) (siStack l) (siStack r) }
+
+instance Monoid SetupInfo where
+  mempty =
+    SetupInfo
+    { siSevenzExe = Nothing
+    , siSevenzDll = Nothing
+    , siMsys2     = Map.empty
+    , siGHCs      = Map.empty
+    , siStack     = Map.empty
+    }
+  mappend = (<>)
+
+-- | Build of the compiler distribution (e.g. standard, gmp4, tinfo6)
+-- | Information for a file to download.
+data DownloadInfo = DownloadInfo
+  { downloadInfoUrl           :: Text
+    -- ^ URL or absolute file path
+  , downloadInfoContentLength :: Maybe Int
+  , downloadInfoSha1          :: Maybe ByteString
+  , downloadInfoSha256        :: Maybe ByteString
+  }
+  deriving (Show, Eq, GHC.Generic)
+
+instance ToJSON DownloadInfo where
+  toJSON (DownloadInfo {..}) = object [ "url"            .= downloadInfoUrl
+                                      , "content-length" .= downloadInfoContentLength
+                                      , "sha1"           .= (decodeUtf8 <$> downloadInfoSha1)
+                                      , "sha256"         .= (decodeUtf8 <$> downloadInfoSha256)
+                                      ]
+
+instance NFData DownloadInfo
+
+instance FromJSON DownloadInfo where
+  parseJSON = withObject "DownloadInfo" parseDownloadInfoFromObject
+
+-- | Parse JSON in existing object for 'DownloadInfo'
+parseDownloadInfoFromObject :: Object -> Parser DownloadInfo
+parseDownloadInfoFromObject o = do
+  url           <- o .: "url"
+  contentLength <- o .:? "content-length"
+  sha1TextMay   <- o .:? "sha1"
+  sha256TextMay <- o .:? "sha256"
+  pure
+    DownloadInfo
+    { downloadInfoUrl           = url
+    , downloadInfoContentLength = contentLength
+    , downloadInfoSha1          = fmap encodeUtf8 sha1TextMay
+    , downloadInfoSha256        = fmap encodeUtf8 sha256TextMay
+    }
+
+data VersionedDownloadInfo = VersionedDownloadInfo
+  { vdiVersion      :: Version
+  , vdiDownloadInfo :: DownloadInfo
+  }
+  deriving (Show, Eq, GHC.Generic)
+
+instance ToJSON VersionedDownloadInfo where
+  toJSON (VersionedDownloadInfo {vdiDownloadInfo = DownloadInfo{..}, ..})
+    = object [ "version"        .= vdiVersion
+             , "url"            .= downloadInfoUrl
+             , "content-length" .= downloadInfoContentLength
+             , "sha1"           .= (decodeUtf8 <$> downloadInfoSha1)
+             , "sha256"         .= (decodeUtf8 <$> downloadInfoSha256)
+             ]
+
+instance NFData VersionedDownloadInfo
+
+instance FromJSON VersionedDownloadInfo where
+  parseJSON = withObject "VersionedDownloadInfo" $ \o -> do
+    ver'         <- o .: "version"
+    downloadInfo <- parseDownloadInfoFromObject o
+    pure VersionedDownloadInfo
+      { vdiVersion      = ver'
+      , vdiDownloadInfo = downloadInfo
+      }
+
+data GHCDownloadInfo = GHCDownloadInfo
+  { gdiConfigureOpts :: [Text]
+  , gdiConfigureEnv  :: Map Text Text
+  , gdiDownloadInfo  :: DownloadInfo
+  }
+  deriving (Show, Eq, GHC.Generic)
+
+instance NFData GHCDownloadInfo
+
+instance ToJSON GHCDownloadInfo where
+  toJSON (GHCDownloadInfo {gdiDownloadInfo = DownloadInfo {..}, ..})
+    = object [ "configure-opts" .= gdiConfigureOpts
+             , "configure-env"  .= gdiConfigureEnv
+             , "url"            .= downloadInfoUrl
+             , "content-length" .= downloadInfoContentLength
+             , "sha1"           .= (decodeUtf8 <$> downloadInfoSha1)
+             , "sha256"         .= (decodeUtf8 <$> downloadInfoSha256)
+             ]
+
+instance FromJSON GHCDownloadInfo where
+  parseJSON = withObject "GHCDownloadInfo" $ \o -> do
+    configureOpts <- o .:? "configure-opts" .!= mempty
+    configureEnv  <- o .:? "configure-env"  .!= mempty
+    downloadInfo  <- parseDownloadInfoFromObject o
+    pure GHCDownloadInfo
+      { gdiConfigureOpts = configureOpts
+      , gdiConfigureEnv  = configureEnv
+      , gdiDownloadInfo  = downloadInfo
+      }
+

lib/GHCup/Utils.hs

@@ -49,7 +49,6 @@ import           GHCup.Prelude.Logger.Internal
 import           GHCup.Prelude.MegaParsec
 import           GHCup.Prelude.Process
 import           GHCup.Prelude.String.QQ
-
 import           Codec.Archive           hiding ( Directory )
 import           Control.Applicative
 import           Control.Exception.Safe
@@ -90,9 +89,9 @@ import qualified Data.Text.Encoding            as E
 import qualified Text.Megaparsec               as MP
 import qualified Data.List.NonEmpty            as NE
 import qualified Streamly.Prelude              as S
+
 import Control.DeepSeq (force)
 import GHC.IO (evaluate)
-import System.Environment (getEnvironment, setEnv)
 import Data.Time (Day(..), diffDays, addDays)
 
 
@@ -119,11 +118,11 @@ import Data.Time (Day(..), diffDays, addDays)
 -- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
 -- >>> dirs' <- getAllDirs
 -- >>> 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 0 False Never Curl False GHCupURL True GPGNone False
+-- >>> let settings = defaultSettings { cache = True, metaCache = 0, noNetwork = True }
 -- >>> 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)
--- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError] $ liftE $ getBase ref
+-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE $ getBase ref
 
 
 
@@ -369,7 +368,9 @@ cabalSet = do
   handleIO' NoSuchThing (\_ -> pure Nothing) $ do
     broken <- liftIO $ isBrokenSymlink cabalbin
     if broken
-      then pure Nothing
+      then do
+        logWarn $ "Broken symlink at " <> T.pack cabalbin
+        pure Nothing
       else do
         link <- liftIO
           $ handleIO' InvalidArgument
@@ -466,7 +467,9 @@ stackSet = do
   handleIO' NoSuchThing (\_ -> pure Nothing) $ do
     broken <- liftIO $ isBrokenSymlink stackBin
     if broken
-      then pure Nothing
+      then do
+        logWarn $ "Broken symlink at " <> T.pack stackBin
+        pure Nothing
       else do
         link <- liftIO
           $ handleIO' InvalidArgument
@@ -520,15 +523,17 @@ isLegacyHLS ver = do
 
 
 -- Return the currently set hls version, if any.
-hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
+hlsSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
 hlsSet = do
   Dirs {..}  <- getDirs
   let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
 
-  liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
+  handleIO' NoSuchThing (\_ -> pure Nothing) $ do
-    broken <- isBrokenSymlink hlsBin
+    broken <- liftIO $ isBrokenSymlink hlsBin
     if broken
-      then pure Nothing
+      then do
+        logWarn $ "Broken symlink at " <> T.pack hlsBin
+        pure Nothing
       else do
         link <- liftIO $ getLinkTarget hlsBin
         Just <$> linkVersion link
@@ -556,6 +561,7 @@ hlsSet = do
 -- | Return the GHC versions the currently selected HLS supports.
 hlsGHCVersions :: ( MonadReader env m
                   , HasDirs env
+                  , HasLog env
                   , MonadIO m
                   , MonadThrow m
                   , MonadCatch m
@@ -687,10 +693,8 @@ hlsAllBinaries ver = do
 
 -- | Extract (major, minor) from any version.
 getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
-getMajorMinorV Version {..} = case _vChunks of
+getMajorMinorV (Version _ (Chunks (Numeric x :| Numeric y : _)) _ _) = pure (fromIntegral x, fromIntegral y)
-  ((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y)
+getMajorMinorV _ = throwM $ ParseError "Could not parse X.Y from version"
-  _ -> throwM $ ParseError "Could not parse X.Y from version"
-
 
 matchMajor :: Version -> Int -> Int -> Bool
 matchMajor v' major' minor' = case getMajorMinorV v' of
@@ -732,7 +736,7 @@ getGHCForPVP pvpIn mt = do
 -- | Like 'getGHCForPVP', except with explicit input parameter.
 --
 -- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
--- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = (Digits 8 :| []) :| [Digits 10 :| [],Digits 7 :| []], _vRel = [Str "debug" :| []], _vMeta = Just "lol"}})
+-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = Chunks (Numeric 8 :| [Numeric 10,Numeric 7]), _vRel = Just (Release (Alphanum "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
@@ -758,11 +762,11 @@ getGHCForPVP' pvpIn ghcs' mt = do
 -- | Get the latest available ghc for the given PVP version, which
 -- may only contain parts.
 --
--- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8|] r
+-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8|] r
 -- Just (PVP {_pComponents = 8 :| [10,7]})
--- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8|] r
+-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8|] r
 -- Just (PVP {_pComponents = 8 :| [8,4]})
--- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8.4|] r
+-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8.4|] r
 -- Just (PVP {_pComponents = 8 :| [8,4]})
 getLatestToolFor :: MonadThrow m
                  => Tool
@@ -1081,7 +1085,7 @@ darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
                    -> FilePath
                    -> m (Either ProcessError ())
 darwinNotarization Darwin path = exec
-  "xattr"
+  "/usr/bin/xattr"
   ["-r", "-d", "com.apple.quarantine", path]
   Nothing
   Nothing
@@ -1195,24 +1199,22 @@ getVersionInfo v' tool =
     )
 
 
-ensureGlobalTools :: ( MonadMask m
+ensureShimGen :: ( MonadMask m
-                     , MonadThrow m
+                 , MonadThrow m
-                     , HasLog env
+                 , HasLog env
-                     , MonadIO m
+                 , MonadIO m
-                     , MonadReader env m
+                 , MonadReader env m
-                     , HasDirs env
+                 , HasDirs env
-                     , HasSettings env
+                 , HasSettings env
-                     , HasGHCupInfo env
+                 , HasGHCupInfo env
-                     , MonadUnliftIO m
+                 , MonadUnliftIO m
-                     , MonadFail m
+                 , MonadFail m
-                     )
+                 )
-                  => Excepts '[GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()
+              => Excepts '[GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()
-ensureGlobalTools
+ensureShimGen
   | isWindows = do
-      (GHCupInfo _ _ gTools) <- lift getGHCupInfo
       dirs <- lift getDirs
-      shimDownload <- liftE $ lE @_ @'[NoDownload]
+      let shimDownload = DownloadInfo shimGenURL Nothing shimGenSHA Nothing Nothing
-        $ maybe (Left (NoDownload' ShimGen)) Right $ Map.lookup ShimGen gTools
       let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
       void $ (\DigestError{} -> do
           lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
@@ -1316,22 +1318,6 @@ warnAboutHlsCompatibility = do
 
 
 
-addToPath :: FilePath
-          -> Bool         -- ^ if False will prepend
-          -> IO [(String, String)]
-addToPath path append = do
- cEnv <- Map.fromList <$> getEnvironment
- let paths          = ["PATH", "Path"]
-     curPaths       = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
-     {- HLINT ignore "Redundant bracket" -}
-     newPath        = intercalate [searchPathSeparator] (if append 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
-
-
     -----------
     --[ Git ]--
     -----------

lib/GHCup/Utils/Dirs.hs

@@ -29,6 +29,7 @@ module GHCup.Utils.Dirs
   , relativeSymlink
   , withGHCupTmpDir
   , getConfigFilePath
+  , getConfigFilePath'
   , useXDG
   , cleanupTrash
 
@@ -360,6 +361,12 @@ getConfigFilePath = do
   confDir <- liftIO ghcupConfigDir
   pure $ fromGHCupPath confDir </> "config.yaml"
 
+getConfigFilePath' :: (MonadReader env m, HasDirs env) => m FilePath
+getConfigFilePath' = do
+  Dirs {..} <- getDirs
+  pure $ fromGHCupPath confDir </> "config.yaml"
+
+
 ghcupConfigFile :: (MonadIO m)
                 => Excepts '[JSONError] m UserSettings
 ghcupConfigFile = do

lib/GHCup/Version.hs

@@ -24,17 +24,26 @@ import qualified Data.Text                     as T
 import qualified Data.Versions as V
 import Control.Exception.Safe (MonadThrow)
 import Data.Text (Text)
-import Data.List.NonEmpty (NonEmpty((:|)))
-import Data.List (intersperse)
 import Control.Monad.Catch (throwM)
 import GHCup.Errors (ParseError(..))
+import Text.Megaparsec
+import Data.Void (Void)
 
 -- | This reflects the API version of the YAML.
 --
 -- 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.7.yaml|]
+ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml|]
+
+stackSetupURL :: URI
+stackSetupURL = [uri|https://raw.githubusercontent.com/commercialhaskell/stackage-content/master/stack/stack-setup-2.yaml|]
+
+shimGenURL :: URI
+shimGenURL = [uri|https://downloads.haskell.org/~ghcup/shimgen/shim-2.exe|]
+
+shimGenSHA :: T.Text
+shimGenSHA = T.pack "7c55e201f71860c5babea886007c8fa44b861abf50d1c07e5677eb0bda387a70"
 
 -- | The current ghcup version.
 ghcUpVer :: V.PVP
@@ -53,7 +62,7 @@ versionCmp ver1 (VR_eq ver2)   = ver1 == ver2
 
 versionRange :: V.Versioning -> VersionRange -> Bool
 versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps
-versionRange ver' (OrRange cmps range) = 
+versionRange ver' (OrRange cmps range) =
   versionRange ver' (SimpleRange cmps) || versionRange ver' range
 
 pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version
@@ -65,44 +74,15 @@ pvpToVersion pvp_ rest =
 -- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
 versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text)
 versionToPVP (V.Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
-versionToPVP v = either (\_ -> (, rest v) <$> alternative v) (pure . (, mempty)) . V.pvp . V.prettyVer $ v
+versionToPVP v = case parse pvp'' "Version->PVP" $ V.prettyVer v of
+  Left _  -> throwM $ ParseError "Couldn't convert Version to PVP"
+  Right r -> pure r
  where
-  alternative :: MonadThrow m => V.Version -> m V.PVP
+   pvp'' :: Parsec Void T.Text (V.PVP, T.Text)
-  alternative v' = case NE.takeWhile isDigit (V._vChunks v') of
+   pvp'' = do
-    [] -> throwM $ ParseError "Couldn't convert Version to PVP"
+     p <- V.pvp'
-    xs -> pure $ pvpFromList (unsafeDigit <$> xs)
+     s <- getParserState
-
+     pure (p, stateInput s)
-  rest :: V.Version -> Text
-  rest (V.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 V.VChunk -> t Text
-    chunksAsT = fmap (foldMap f)
-      where
-        f :: V.VUnit -> Text
-        f (V.Digits i) = T.pack $ show i
-        f (V.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 :: V.VChunk -> Bool
-  isDigit (V.Digits _ :| []) = True
-  isDigit _                = False
-
-  unsafeDigit :: V.VChunk -> Int
-  unsafeDigit (V.Digits x :| []) = fromIntegral x
-  unsafeDigit _ = error "unsafeDigit: wrong input"
 
 pvpFromList :: [Int] -> V.PVP
 pvpFromList = V.PVP . NE.fromList . fmap fromIntegral

scripts/bootstrap/bootstrap-haskell

@@ -12,6 +12,7 @@
 #   * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation
 #   * BOOTSTRAP_HASKELL_GHC_VERSION - the ghc version to install
 #   * BOOTSTRAP_HASKELL_CABAL_VERSION - the cabal version to install
+#   * BOOTSTRAP_HASKELL_CABAL_XDG - don't disable the XDG logic (this doesn't force XDG though, because cabal is confusing)
 #   * BOOTSTRAP_HASKELL_INSTALL_NO_STACK - disable installation of stack
 #   * BOOTSTRAP_HASKELL_INSTALL_NO_STACK_HOOK - disable installation stack ghcup hook
 #   * BOOTSTRAP_HASKELL_INSTALL_HLS - whether to install latest hls
@@ -28,14 +29,14 @@
 
 plat="$(uname -s)"
 arch=$(uname -m)
-ghver="0.1.19.4"
+ghver="0.1.20.0"
 : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
 
 export GHCUP_SKIP_UPDATE_CHECK=yes
 : "${BOOTSTRAP_HASKELL_DOWNLOADER:=curl}"
 
 case "${plat}" in
-        MSYS*|MINGW*)
+        MSYS*|MINGW*|CYGWIN*)
 			: "${GHCUP_INSTALL_BASE_PREFIX:=/c}"
 			GHCUP_DIR=$(cygpath -u "${GHCUP_INSTALL_BASE_PREFIX}/ghcup")
 			GHCUP_BIN=$(cygpath -u "${GHCUP_INSTALL_BASE_PREFIX}/ghcup/bin")
@@ -72,7 +73,7 @@ warn() {
         printf "%s\\n" "$1"
     else
         case "${plat}" in
-                MSYS*|MINGW*)
+                MSYS*|MINGW*|CYGWIN*)
                     # shellcheck disable=SC3037
                     echo -e "\\033[0;35m$1\\033[0m"
                     ;;
@@ -88,7 +89,7 @@ yellow() {
         printf "%s\\n" "$1"
     else
         case "${plat}" in
-                MSYS*|MINGW*)
+                MSYS*|MINGW*|CYGWIN*)
                     # shellcheck disable=SC3037
                     echo -e "\\033[0;33m$1\\033[0m"
                     ;;
@@ -104,7 +105,7 @@ green() {
         printf "%s\\n" "$1"
     else
         case "${plat}" in
-                MSYS*|MINGW*)
+                MSYS*|MINGW*|CYGWIN*)
                     # shellcheck disable=SC3037
                     echo -e "\\033[0;32m$1\\033[0m"
                     ;;
@@ -160,7 +161,7 @@ _done() {
 	echo
 	echo "==============================================================================="
 	case "${plat}" in
-			MSYS*|MINGW*)
+   			MSYS*|MINGW*|CYGWIN*)
 				green
 				green "All done!"
 				green
@@ -172,9 +173,8 @@ _done() {
 				green "Start a new haskell project in the current directory via:"
 				green "  cabal init --interactive"
 				green
-				green "Install other GHC versions and tools via:"
+				green "To install other GHC versions and tools, run:"
-				green "  ghcup list"
+				green "  ghcup tui"
-				green "  ghcup install <tool> <version>"
 				green
 				green "To install system libraries and update msys2/mingw64,"
 				green "open the \"Mingw haskell shell\""
@@ -314,7 +314,7 @@ download_ghcup() {
 					;;
 			esac
 			;;
-        MSYS*|MINGW*)
+        MSYS*|MINGW*|CYGWIN*)
 			case "${arch}" in
 				x86_64|amd64)
 					_url=${GHCUP_BASE_URL}/${ghver}/x86_64-mingw64-ghcup-${ghver}.exe
@@ -327,7 +327,7 @@ download_ghcup() {
 			;;
     esac
     case "${plat}" in
-        MSYS*|MINGW*)
+        MSYS*|MINGW*|CYGWIN*)
             case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
                 "curl")
 	                # shellcheck disable=SC2086
@@ -546,7 +546,7 @@ adjust_bashrc() {
 								printf "\n%s" "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
 							fi
 							;;
-						MSYS*|MINGW*)
+   						MSYS*|MINGW*|CYGWIN*)
 							if [ ! -e "${HOME}/.bash_profile" ] ; then
 								echo '# generated by ghcup' > "${HOME}/.bash_profile"
 								echo 'test -f ~/.profile && . ~/.profile' >> "${HOME}/.bash_profile"
@@ -596,7 +596,7 @@ adjust_cabal_config() {
 
 ask_cabal_config_init() {
 	case "${plat}" in
-			MSYS*|MINGW*)
+   			MSYS*|MINGW*|CYGWIN*)
 				if [ -n "${BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG}" ] ; then
 					return 1
 				fi
@@ -637,7 +637,7 @@ ask_cabal_config_init() {
 
 do_cabal_config_init() {
 	case "${plat}" in
-			MSYS*|MINGW*)
+   			MSYS*|MINGW*|CYGWIN*)
 		case $1 in
 			1)
 				adjust_cabal_config
@@ -757,7 +757,7 @@ if [ -z "${GHCUP_USE_XDG_DIRS}" ] ; then
 	echo "ghcup installs only into the following directory,"
     echo "which can be removed anytime:"
 	case "${plat}" in
-			MSYS*|MINGW*)
+   			MSYS*|MINGW*|CYGWIN*)
 				echo "  $(cygpath -w "$GHCUP_DIR")"
 				;;
 			*)
@@ -821,10 +821,19 @@ if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
 
 	do_cabal_config_init $ask_cabal_config_init_answer
 
+    if [ -z "${BOOTSTRAP_HASKELL_CABAL_XDG}" ] ; then
+        # disable XDG if we can
+        if [ -e "${XDG_CONFIG_HOME:-"$HOME/.config"}/cabal" ] || [ -n "${CABAL_DIR}" ] || [ -n "${CABAL_CONFIG}" ] ; then
+            :
+        else
+            edo mkdir -p "${HOME}/.cabal"
+        fi
+    fi
+
 	edo cabal update --ignore-project
 else # don't install ghc and cabal
 	case "${plat}" in
-			MSYS*|MINGW*)
+   			MSYS*|MINGW*|CYGWIN*)
 				# need to bootstrap cabal to initialize config on windows
 				# we'll remove it afterwards
 				tmp_dir="$(mktemp -d)"

scripts/bootstrap/bootstrap-haskell.ps1

@@ -11,7 +11,7 @@
     * cabal - The Cabal build tool for managing Haskell software"
     * stack - (optional) A cross-platform program for developing Haskell projects"
     * hls   - (optional) A language server for developers to integrate with their editor/IDE"
-    
+
 	By default, the installation is non-interactive, unless you run it with 'Interactive $true'.
 #>
 param (
@@ -42,7 +42,9 @@ param (
     # The Msys2 version to download (e.g. 20221216)
     [string]$Msys2Version,
     # The Msys2 sha256sum hash
-    [string]$Msys2Hash
+    [string]$Msys2Hash,
+    # Whether to disable creation of several desktop shortcuts
+    [switch]$DontWriteDesktopShortcuts
 )
 
 $DefaultMsys2Version = "20221216"
@@ -139,7 +141,7 @@ filter Get-FileSize {
 function Get-FileWCSynchronous{
     param(
         [Parameter(Mandatory=$true)]
-        [string]$url, 
+        [string]$url,
         [string]$destinationFolder="$env:USERPROFILE\Downloads",
         [switch]$includeStats
     )
@@ -229,7 +231,7 @@ if ($GhcupBasePrefixEnv) {
     Print-Msg -color Green -msg ("Picked {0} as default Install prefix!" -f $defaultGhcupBasePrefix)
   } else {
     Print-Msg -color Red -msg "Couldn't find a writable partition with at least 5GB free disk space!"
-    Exit 1    
+    Exit 1
   }
 }
 
@@ -274,7 +276,7 @@ Press enter to accept the default [{0}]:
     if (!($GhcupBasePrefix.EndsWith('\'))) {
       $GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix)
     }
-  
+
     $GhcupBasePrefix = $GhcupBasePrefix.TrimEnd().TrimStart()
     if (!($GhcupBasePrefix)) {
       Print-Msg -color Red -msg "No directory specified!"
@@ -350,7 +352,7 @@ if ($CabalDir) {
   $CabDirEnv = $CabalDir
   if (!($CabDirEnv)) {
     Print-Msg -color Red -msg "No directory specified!"
-    Exit 1        
+    Exit 1
   } elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
     Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
     Exit 1
@@ -365,7 +367,7 @@ if ($CabalDir) {
 
     $CabDirEnv = $CabDirEnv.TrimEnd().TrimStart()
     if (!($CabDirEnv)) {
-      Print-Msg -color Red -msg "No directory specified!"         
+      Print-Msg -color Red -msg "No directory specified!"
     } elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
       Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
     } else {
@@ -410,6 +412,26 @@ if (!($InstallStack)) {
   }
 }
 
+if ($Interactive) {
+	$DesktopDecision = $Host.UI.PromptForChoice('Create Desktop shortcuts'
+                                        , 'Do you want to create convenience desktop shortcuts (e.g. for uninstallation and msys2 shell)?'
+                                        , [System.Management.Automation.Host.ChoiceDescription[]] @('&Yes'
+                                            '&No'
+                                            '&Abort'), 0)
+	if ($DesktopDecision -eq 0) {
+      $InstallDesktopShortcuts = $true
+    } elseif ($DesktopDecision -eq 2) {
+      Exit 0
+    }
+} else {
+	if ($Minimal) {
+      $InstallDesktopShortcuts = $false
+	} elseif ($DontWriteDesktopShortcuts) {
+      $InstallDesktopShortcuts = $false
+	} else {
+      $InstallDesktopShortcuts = $true
+	}
+}
 
 # mingw foo
 Print-Msg -msg 'First checking for Msys2...'
@@ -454,7 +476,9 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
 
     Print-Msg -msg 'Extracting Msys2 archive...'
     $null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir)  # Extract
-    Remove-Item -Path "$archivePath"
+    # We ignore errors because we don't want the installation script to fail just because a temporary file can't be removed.
+    # Relevant issue: https://github.com/haskell/ghcup-hs/issues/952
+    Remove-Item -Path "$archivePath" -ErrorAction Continue
 
     Print-Msg -msg 'Processing MSYS2 bash for first time use...'
     Exec "$Bash" '-lc' 'exit'
@@ -485,12 +509,12 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
         $MsysDirPrompt = Read-Host
         $MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt]
       } else {
-        Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:' 
+        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!"         
+        Print-Msg -color Red -msg "No directory specified!"
       } elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) {
         Print-Msg -color Red -msg ('MSys2 installation at ''{0}'' could not be found!' -f $MsysDir)
       } elseif (!(Split-Path -IsAbsolute -Path "$MsysDir")) {
@@ -510,8 +534,11 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
 	Start-Sleep -s 5
 }
 
-Print-Msg -msg 'Creating shortcuts...'
+
-$uninstallShortCut = @'
+if ($InstallDesktopShortcuts) {
+
+	Print-Msg -msg 'Creating shortcuts...'
+	$uninstallShortCut = @'
 $decision = $Host.UI.PromptForChoice('Uninstall Haskell'
 , 'Do you want to uninstall all of the haskell toolchain, including GHC, Cabal, Stack and GHCup itself?'
 , [System.Management.Automation.Host.ChoiceDescription[]] @('&Uninstall'
@@ -573,12 +600,13 @@ if ($Host.Name -eq "ConsoleHost")
 }
 '@
 
-$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
+	$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
-Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath 'Install GHC dev dependencies.lnk' -TempPath $GhcupDir
+	Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath 'Install GHC dev dependencies.lnk' -TempPath $GhcupDir
-Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath 'Mingw haskell shell.lnk' -TempPath $GhcupDir
+	Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath 'Mingw haskell shell.lnk' -TempPath $GhcupDir
-Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
+	Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
-$DesktopDir = [Environment]::GetFolderPath("Desktop")
+	$DesktopDir = [Environment]::GetFolderPath("Desktop")
-$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
+	$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
+}
 
 Print-Msg -msg ('Adding {0}\bin to Users Path...' -f $GhcupDir)
 Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'

scripts/dev/update-shell-completions.sh

@@ -0,0 +1,8 @@
+#!/bin/sh
+
+set -xue
+
+cabal --verbose=0 run ghcup:exe:ghcup -- --bash-completion-script ghcup > scripts/shell-completions/bash
+cabal --verbose=0 run ghcup:exe:ghcup -- --zsh-completion-script ghcup > scripts/shell-completions/zsh
+cabal --verbose=0 run ghcup:exe:ghcup -- --fish-completion-script ghcup > scripts/shell-completions/fish
+

scripts/hooks/stack/ghc-install.sh

@@ -9,8 +9,8 @@ set -eu
 
 case $HOOK_GHC_TYPE in
     bindist)
-        ghcdir=$(ghcup whereis --directory ghc "$HOOK_GHC_VERSION" || ghcup run --ghc "$HOOK_GHC_VERSION" --install) || exit 3
+        ghc_path=$(ghcup whereis ghc "$HOOK_GHC_VERSION" || { ghcup install ghc "$HOOK_GHC_VERSION" >/dev/null && ghcup whereis ghc "$HOOK_GHC_VERSION" ; }) || { >&2 echo "Installing $HOOK_GHC_VERSION via ghcup failed" exit 3 ;}
-        printf "%s/ghc" "${ghcdir}"
+        printf "%s" "${ghc_path}"
         ;;
     git)
         # TODO: should be somewhat possible

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-20.20
+resolver: lts-20.26
 
 packages:
   - .
@@ -24,6 +24,8 @@ extra-deps:
   - strict-base-0.4.0.0
   - text-2.0.2
   - yaml-streamly-0.12.2
+  - github: fosskers/versions
+    commit: 7bc3355348aac3510771d4622aff09ac38c9924d
 
 flags:
   http-io-streams:

test/ghcup-test/GHCup/ArbitraryTypes.hs

@@ -175,10 +175,6 @@ instance Arbitrary Tool where
   arbitrary = genericArbitrary
   shrink    = genericShrink
 
-instance Arbitrary GlobalTool where
-  arbitrary = genericArbitrary
-  shrink    = genericShrink
-
 instance Arbitrary GHCupInfo where
   arbitrary = genericArbitrary
   shrink    = genericShrink

test/optparse-test/ChangeLogTest.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module ChangeLogTest where
 
 import Test.Tasty
@@ -6,8 +9,7 @@ import Utils
 import Test.Tasty.HUnit
 import Control.Monad.IO.Class
 import GHCup.Types
-import Data.Versions
+import Data.Versions (versionQ)
-import Data.List.NonEmpty (NonEmpty ((:|)))
 
 changeLogTests :: TestTree
 changeLogTests = testGroup "changelog" $ map (uncurry check) checkList
@@ -30,7 +32,7 @@ checkList =
       (Just $ GHCVersion
         $ GHCTargetVersion
           Nothing
-          (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]))
+          $(versionQ "9.2"))
     )
   , ("changelog recommended", ChangeLogOptions False Nothing (Just $ ToolTag Recommended))
   , ("changelog -t cabal recommended", ChangeLogOptions False (Just Cabal) (Just $ ToolTag Recommended))
@@ -38,7 +40,7 @@ checkList =
       (Just $ GHCVersion
         $ GHCTargetVersion
           Nothing
-          (mkVersion $ (Digits 3 :| []) :| [Digits 10 :| [],Digits 1 :| [],Digits 0 :| []]))
+          $(versionQ "3.10.1.0"))
     )
   , ("changelog 2023-07-22", ChangeLogOptions False Nothing (Just (ToolDay (read "2023-07-22"))))
   ]

test/optparse-test/CompileTest.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module CompileTest where
 
@@ -59,12 +60,12 @@ compileGhcCheckList = mapSecond CompileGHC
   [ ("compile ghc -v 9.4.5 -b 9.2.8", baseOptions)
   , ("compile ghc -g a32db0b -b 9.2.8", mkDefaultGHCCompileOptions
         (GHC.GitDist $ GitBranch "a32db0b" Nothing)
-        (Left $ mkVersion' "9.2.8")
+        (Left $(versionQ "9.2.8"))
     )
   , ("compile ghc -g a32db0b -b 9.2.8 -r https://gitlab.haskell.org/ghc/ghc.git",
         mkDefaultGHCCompileOptions
           (GHC.GitDist $ GitBranch "a32db0b" (Just "https://gitlab.haskell.org/ghc/ghc.git"))
-          (Left $ mkVersion' "9.2.8")
+          (Left $(versionQ "9.2.8"))
     )
   , ("compile ghc -g a32db0b -r https://gitlab.haskell.org/ghc/ghc.git -b /usr/bin/ghc-9.2.2",
         mkDefaultGHCCompileOptions
@@ -73,7 +74,7 @@ compileGhcCheckList = mapSecond CompileGHC
     )
   , ("compile ghc --remote-source-dist https://gitlab.haskell.org/ghc/ghc.git -b 9.2.8", mkDefaultGHCCompileOptions
         (GHC.RemoteDist [uri|https://gitlab.haskell.org/ghc/ghc.git|])
-        (Left $ mkVersion' "9.2.8")
+        (Left $(versionQ "9.2.8"))
     )
   , (baseCmd <> "-j20", baseOptions{GHC.jobs = Just 20})
   , (baseCmd <> "--jobs 10", baseOptions{GHC.jobs = Just 10})
@@ -86,8 +87,8 @@ compileGhcCheckList = mapSecond CompileGHC
   , (baseCmd <> "--cross-target armv7-unknown-linux-gnueabihf", baseOptions{GHC.crossTarget = Just "armv7-unknown-linux-gnueabihf"})
   , (baseCmd <> "-- --enable-unregisterised", baseOptions{GHC.addConfArgs = ["--enable-unregisterised"]})
   , (baseCmd <> "--set", baseOptions{GHC.setCompile = True})
-  , (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $ mkVersion' "9.4.5-p1"})
+  , (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
-  , (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $ mkVersion' "9.4.5-p1"})
+  , (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
   , (baseCmd <> "-f make", baseOptions{GHC.buildFlavour = Just "make"})
   , (baseCmd <> "--flavour make", baseOptions{GHC.buildFlavour = Just "make"})
   , (baseCmd <> "--hadrian", baseOptions{GHC.buildSystem = Just Hadrian})
@@ -107,8 +108,8 @@ compileGhcCheckList = mapSecond CompileGHC
     baseOptions :: GHCCompileOptions
     baseOptions =
       mkDefaultGHCCompileOptions
-        (GHC.SourceDist $ mkVersion' "9.4.5")
+        (GHC.SourceDist $(versionQ "9.4.5"))
-        (Left $ mkVersion' "9.2.8")
+        (Left $(versionQ "9.2.8"))
 
 compileHlsCheckList :: [(String, CompileCommand)]
 compileHlsCheckList = mapSecond CompileHLS
@@ -136,7 +137,7 @@ compileHlsCheckList = mapSecond CompileHLS
     )
   , ("compile hls --source-dist 2.0.0.0 --ghc 9.2.8",
         mkDefaultHLSCompileOptions
-          (HLS.SourceDist $ mkVersion' "2.0.0.0")
+          (HLS.SourceDist $(versionQ "2.0.0.0"))
           [ghc928]
     )
   , ("compile hls --remote-source-dist https://github.com/haskell/haskell-language-server/archive/refs/tags/2.0.0.1.tar.gz --ghc 9.2.8",
@@ -146,15 +147,15 @@ compileHlsCheckList = mapSecond CompileHLS
     )
   , ("compile hls -v 2.0.0.0 --ghc latest",
         mkDefaultHLSCompileOptions
-          (HLS.HackageDist $ mkVersion' "2.0.0.0")
+          (HLS.HackageDist $(versionQ "2.0.0.0"))
           [ToolTag Latest]
     )
   , (baseCmd <> "-j20", baseOptions{HLS.jobs = Just 20})
   , (baseCmd <> "--jobs 10", baseOptions{HLS.jobs = Just 10})
   , (baseCmd <> "--no-set", baseOptions{HLS.setCompile = False})
   , (baseCmd <> "--cabal-update", baseOptions{HLS.updateCabal = True})
-  , (baseCmd <> "-o 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $ mkVersion' "2.0.0.0-p1"})
+  , (baseCmd <> "-o 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
-  , (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $ mkVersion' "2.0.0.0-p1"})
+  , (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
   , (baseCmd <> "--git-describe-version", baseOptions{HLS.ovewrwiteVer = Left True})
 #ifdef IS_WINDOWS
   , (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
@@ -178,11 +179,11 @@ compileHlsCheckList = mapSecond CompileHLS
     baseOptions :: HLSCompileOptions
     baseOptions =
       mkDefaultHLSCompileOptions
-        (HLS.HackageDist $ mkVersion' "2.0.0.0")
+        (HLS.HackageDist $(versionQ "2.0.0.0"))
         [ghc928]
 
     ghc928 :: ToolVersion
-    ghc928 = GHCVersion $ GHCTargetVersion Nothing (mkVersion' "9.2.8")
+    ghc928 = GHCVersion $ GHCTargetVersion Nothing $(versionQ "9.2.8")
 
 compileParseWith :: [String] -> IO CompileCommand
 compileParseWith args = do

test/optparse-test/ConfigTest.hs

@@ -5,6 +5,7 @@ module ConfigTest where
 import Test.Tasty
 import Test.Tasty.HUnit
 import GHCup.OptParse
+import GHCup.Types (NewURLSource(..))
 import Utils
 import Control.Monad.IO.Class
 import URI.ByteString.QQ
@@ -23,7 +24,13 @@ checkList =
   , ("config init", InitConfig)
   , ("config show", ShowConfig)
   , ("config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
-    , AddReleaseChannel False [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml|]
+    , AddReleaseChannel False (NewURI [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml|])
+    )
+  , ("config add-release-channel GHCupURL"
+    , AddReleaseChannel False NewGHCupURL
+    )
+  , ("config add-release-channel StackSetupURL"
+    , AddReleaseChannel False NewStackSetupURL
     )
   , ("config set cache true", SetConfig "cache" (Just "true"))
   ]

test/optparse-test/InstallTest.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE TemplateHaskell   #-}
 
 module InstallTest where
 
@@ -54,7 +55,7 @@ oldStyleCheckList =
     : ("install -u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz head"
     , Right defaultOptions
         { instBindist = Just [uri|https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz|]
-        , instVer = Just $ GHCVersion $ GHCTargetVersion Nothing (mkVersion $ (Str "head" :| []) :| [])
+        , instVer = Just $ GHCVersion $ GHCTargetVersion Nothing  $(versionQ "head")
         }
     )
     : mapSecond
@@ -62,48 +63,48 @@ oldStyleCheckList =
         [ ("install ghc-9.2", GHCVersion
               $ GHCTargetVersion
                 (Just "ghc")
-                (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
+                $(versionQ "9.2")
           )
           -- invalid
         , ("install next", GHCVersion
               $ GHCTargetVersion
                 Nothing
-                (mkVersion $ (Str "next" :| []) :| [])
+                $(versionQ "next")
           )
         , ("install latest", ToolTag Latest)
         , ("install nightly", GHCVersion
               $ GHCTargetVersion
                 Nothing
-                (mkVersion $ (Str "nightly" :| []) :| [])
+                $(versionQ "nightly")
           )
         , ("install recommended", ToolTag Recommended)
         , ("install prerelease", GHCVersion
               $ GHCTargetVersion
                 Nothing
-                (mkVersion $ (Str "prerelease" :| []) :| [])
+                $(versionQ "prerelease")
           )
         , ("install latest-prerelease", ToolTag LatestPrerelease)
         , ("install latest-nightly", ToolTag LatestNightly)
         , ("install ghc-javascript-unknown-ghcjs-9.6", GHCVersion
               $ GHCTargetVersion
                 (Just "ghc-javascript-unknown-ghcjs")
-                (mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
+                $(versionQ "9.6")
           )
         , ("install base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
         , ("install cabal-3.10", GHCVersion
               $ GHCTargetVersion
                 (Just "cabal")
-                (mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
+                $(versionQ "3.10")
           )
         , ("install hls-2.0.0.0", GHCVersion
               $ GHCTargetVersion
                 (Just "hls")
-                (mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []])
+                $(versionQ "2.0.0.0")
           )
         , ("install stack-2.9.3", GHCVersion
               $ GHCTargetVersion
                 (Just "stack")
-                (mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []])
+                $(versionQ "2.9.3")
           )
         ]
 
@@ -114,37 +115,37 @@ installGhcCheckList =
     [ ("install ghc 9.2", GHCVersion
           $ GHCTargetVersion
             Nothing
-            (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
+            $(versionQ "9.2")
       )
     , ("install ghc next", GHCVersion
           $ GHCTargetVersion
             Nothing
-            (mkVersion $ (Str "next" :| []) :| [])
+            $(versionQ "next")
       )
     , ("install ghc latest", ToolTag Latest)
     , ("install ghc nightly", GHCVersion
           $ GHCTargetVersion
             Nothing
-            (mkVersion $ (Str "nightly" :| []) :| [])
+            $(versionQ "nightly")
       )
     , ("install ghc recommended", ToolTag Recommended)
     , ("install ghc prerelease", GHCVersion
           $ GHCTargetVersion
             Nothing
-            (mkVersion $ (Str "prerelease" :| []) :| [])
+            $(versionQ "prerelease")
       )
     , ("install ghc latest-prerelease", ToolTag LatestPrerelease)
     , ("install ghc latest-nightly", ToolTag LatestNightly)
     , ("install ghc javascript-unknown-ghcjs-9.6", GHCVersion
           $ GHCTargetVersion
             (Just "javascript-unknown-ghcjs")
-            (mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
+            $(versionQ "9.6")
       )
     , ("install ghc base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
     , ("install ghc ghc-9.2", GHCVersion
           $ GHCTargetVersion
             (Just "ghc")
-            (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
+            $(versionQ "9.2")
       )
     ]
 
@@ -152,69 +153,48 @@ installCabalCheckList :: [(String, Either InstallCommand InstallOptions)]
 installCabalCheckList =
   ("install cabal", Left $ InstallCabal defaultOptions{instSet = True})
   : mapSecond (Left . InstallCabal . mkInstallOptions')
-    [ ("install cabal 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
+    [ ("install cabal 3.10", ToolVersion $(versionQ "3.10"))
-    , ("install cabal next", ToolVersion $ mkVersion $ (Str "next" :| []) :| [])
+    , ("install cabal next", ToolVersion $(versionQ "next"))
     , ("install cabal latest", ToolTag Latest)
-    , ("install cabal nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
+    , ("install cabal nightly", ToolVersion $(versionQ "nightly"))
     , ("install cabal recommended", ToolTag Recommended)
-    , ("install cabal prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
+    , ("install cabal prerelease", ToolVersion $(versionQ "prerelease"))
     , ("install cabal latest-prerelease", ToolTag LatestPrerelease)
     , ("install cabal latest-nightly", ToolTag LatestNightly)
     , ("install cabal base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
-    , ("install cabal cabal-3.10", ToolVersion
+    , ("install cabal cabal-3.10", ToolVersion $(versionQ "cabal-3.10"))
-          $ Version
-            { _vEpoch = Nothing
-            , _vChunks = (Str "cabal" :| []) :| []
-            , _vRel = [Digits 3 :| [], Digits 10 :| []]
-            , _vMeta = Nothing
-            }
-      )
     ]
 
 installHlsCheckList :: [(String, Either InstallCommand InstallOptions)]
 installHlsCheckList =
   ("install hls", Left $ InstallHLS defaultOptions{instSet = True})
   : mapSecond (Left . InstallHLS . mkInstallOptions')
-    [ ("install hls 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
+    [ ("install hls 3.10", ToolVersion $(versionQ "3.10"))
-    , ("install hls next", ToolVersion $ mkVersion $ (Str "next" :| []) :| [])
+    , ("install hls next", ToolVersion $(versionQ "next"))
     , ("install hls latest", ToolTag Latest)
-    , ("install hls nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
+    , ("install hls nightly", ToolVersion $(versionQ "nightly"))
     , ("install hls recommended", ToolTag Recommended)
-    , ("install hls prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
+    , ("install hls prerelease", ToolVersion $(versionQ "prerelease"))
     , ("install hls latest-prerelease", ToolTag LatestPrerelease)
     , ("install hls latest-nightly", ToolTag LatestNightly)
     , ("install hls base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
-    , ("install hls hls-2.0", ToolVersion
+    , ("install hls hls-2.0", ToolVersion $(versionQ "hls-2.0"))
-          $ Version
-            { _vEpoch = Nothing
-            , _vChunks = (Str "hls" :| []) :| []
-            , _vRel = [Digits 2 :| [], Digits 0 :| []]
-            , _vMeta = Nothing
-            }
-      )
     ]
 
 installStackCheckList :: [(String, Either InstallCommand InstallOptions)]
 installStackCheckList =
   ("install stack", Left $ InstallStack defaultOptions{instSet = True})
   : mapSecond (Left . InstallStack . mkInstallOptions')
-    [ ("install stack 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
+    [ ("install stack 3.10", ToolVersion $(versionQ "3.10"))
-    , ("install stack next", ToolVersion $ mkVersion $ (Str "next" :| []) :| [])
+    , ("install stack next", ToolVersion $(versionQ "next"))
     , ("install stack latest", ToolTag Latest)
-    , ("install stack nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
+    , ("install stack nightly", ToolVersion $(versionQ "nightly"))
     , ("install stack recommended", ToolTag Recommended)
-    , ("install stack prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
+    , ("install stack prerelease", ToolVersion $(versionQ "prerelease"))
     , ("install stack latest-prerelease", ToolTag LatestPrerelease)
     , ("install stack latest-nightly", ToolTag LatestNightly)
     , ("install stack base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
-    , ("install stack stack-2.9", ToolVersion
+    , ("install stack stack-2.9", ToolVersion $(versionQ "stack-2.9"))
-          $ Version
-            { _vEpoch = Nothing
-            , _vChunks = (Str "stack" :| []) :| []
-            , _vRel = [Digits 2 :| [], Digits 9 :| []]
-            , _vMeta = Nothing
-            }
-      )
     ]
 
 installParseWith :: [String] -> IO (Either InstallCommand InstallOptions)

test/optparse-test/RmTest.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
 
 module RmTest where
 
@@ -6,7 +7,6 @@ import Test.Tasty
 import GHCup.OptParse
 import Utils
 import GHCup.Types
-import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Versions
 
 
@@ -24,54 +24,36 @@ rmTests =
 oldStyleCheckList :: [(String, Either RmCommand RmOptions)]
 oldStyleCheckList = mapSecond (Right . RmOptions)
   [ -- failed with ("rm", xxx)
-    ("rm 9.2.8", mkTVer (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
+    ("rm 9.2.8", mkTVer $(versionQ "9.2.8"))
-  , ("rm ghc-9.2.8",  GHCTargetVersion (Just "ghc") (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
+  , ("rm ghc-9.2.8",  GHCTargetVersion (Just "ghc") $(versionQ "9.2.8"))
   ]
 
 rmGhcCheckList :: [(String, Either RmCommand RmOptions)]
 rmGhcCheckList = mapSecond (Left . RmGHC . RmOptions)
   [ -- failed with ("rm ghc", xxx)
-    ("rm ghc 9.2.8", mkTVer (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
+    ("rm ghc 9.2.8", mkTVer $(versionQ "9.2.8"))
-  , ("rm ghc ghc-9.2.8",  GHCTargetVersion (Just "ghc") (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
+  , ("rm ghc ghc-9.2.8",  GHCTargetVersion (Just "ghc") $(versionQ "9.2.8"))
   ]
 
 rmCabalCheckList :: [(String, Either RmCommand RmOptions)]
 rmCabalCheckList = mapSecond (Left . RmCabal)
   [ -- failed with ("rm cabal", xxx)
-    ("rm cabal 3.10", mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
+    ("rm cabal 3.10", $(versionQ "3.10"))
-  , ("rm cabal cabal-3.10", Version
+  , ("rm cabal cabal-3.10", $(versionQ "cabal-3.10"))
-        { _vEpoch = Nothing
-        , _vChunks = (Str "cabal" :| []) :| []
-        , _vRel = [Digits 3 :| [], Digits 10 :| []]
-        , _vMeta = Nothing
-        }
-    )
   ]
 
 rmHlsCheckList :: [(String, Either RmCommand RmOptions)]
 rmHlsCheckList = mapSecond (Left . RmHLS)
   [ -- failed with ("rm hls", xxx)
-    ("rm hls 2.0", mkVersion $ (Digits 2 :| []) :| [Digits 0 :| []])
+    ("rm hls 2.0", $(versionQ "2.0"))
-  , ("rm hls hls-2.0", Version
+  , ("rm hls hls-2.0", $(versionQ "hls-2.0"))
-        { _vEpoch = Nothing
-        , _vChunks = (Str "hls" :| []) :| []
-        , _vRel = [Digits 2 :| [], Digits 0 :| []]
-        , _vMeta = Nothing
-        }
-    )
   ]
 
 rmStackCheckList :: [(String, Either RmCommand RmOptions)]
 rmStackCheckList = mapSecond (Left . RmStack)
   [ -- failed with ("rm stack", xxx)
-    ("rm stack 2.9.1", mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 1 :| []])
+    ("rm stack 2.9.1", $(versionQ "2.9.1"))
-  , ("rm stack stack-2.9.1", Version
+  , ("rm stack stack-2.9.1", $(versionQ "stack-2.9.1"))
-        { _vEpoch = Nothing
-        , _vChunks = (Str "stack" :| []) :| []
-        , _vRel = [Digits 2 :| [], Digits 9 :| [], Digits 1 :| []]
-        , _vMeta = Nothing
-        }
-    )
   ]
 
 rmParseWith :: [String] -> IO (Either RmCommand RmOptions)

test/optparse-test/RunTest.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE CPP               #-}
+{-# LANGUAGE TemplateHaskell   #-}
 
 module RunTest where
 
@@ -7,6 +8,7 @@ import Test.Tasty
 import GHCup.OptParse
 import Utils
 import GHCup.Types
+import Data.Versions (versionQ)
 
 
 runTests :: TestTree
@@ -35,11 +37,11 @@ runCheckList =
   , ("run --install", defaultOptions{runInstTool' = True})
   , ("run -m", defaultOptions{runMinGWPath = True})
   , ("run --mingw-path", defaultOptions{runMinGWPath = True})
-  , ("run --ghc 9.2.8", defaultOptions{runGHCVer = Just $ GHCVersion $ mkTVer $ mkVersion' "9.2.8"})
+  , ("run --ghc 9.2.8", defaultOptions{runGHCVer = Just $ GHCVersion $ mkTVer $(versionQ "9.2.8")})
   , ("run --ghc latest", defaultOptions{runGHCVer = Just $ ToolTag Latest})
-  , ("run --cabal 3.10", defaultOptions{runCabalVer = Just $ ToolVersion $ mkVersion' "3.10"})
+  , ("run --cabal 3.10", defaultOptions{runCabalVer = Just $ ToolVersion $(versionQ "3.10")})
-  , ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $ mkVersion' "2.0"})
+  , ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $(versionQ "2.0")})
-  , ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $ mkVersion' "2.9"})
+  , ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $(versionQ "2.9") })
 #ifdef IS_WINDOWS
   , ("run -b C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
   , ("run --bindir C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
@@ -52,9 +54,9 @@ runCheckList =
   , ("run --ghc latest --cabal 3.10 --stack 2.9 --hls 2.0 --install",
         defaultOptions
           { runGHCVer = Just $ ToolTag Latest
-          , runCabalVer = Just $ ToolVersion $ mkVersion' "3.10"
+          , runCabalVer = Just $ ToolVersion $(versionQ "3.10")
-          , runHLSVer = Just $ ToolVersion $ mkVersion' "2.0"
+          , runHLSVer = Just $ ToolVersion $(versionQ "2.0")
-          , runStackVer = Just $ ToolVersion $ mkVersion' "2.9"
+          , runStackVer = Just $ ToolVersion $(versionQ "2.9")
           , runInstTool' = True
           }
     )

test/optparse-test/SetTest.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module SetTest where
 
@@ -27,44 +28,44 @@ oldStyleCheckList = mapSecond (Right . SetOptions)
   , ("set ghc-9.2", SetGHCVersion
           $ GHCTargetVersion
             (Just "ghc")
-            (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
+            $(versionQ "9.2")
     )
   , ("set next", SetNext)
   , ("set latest", SetToolTag Latest)
   , ("set nightly", SetGHCVersion
           $ GHCTargetVersion
             Nothing
-            (mkVersion $ (Str "nightly" :| []) :| [])
+            $(versionQ "nightly")
     )
     -- different from `set`
   , ("set recommended", SetToolTag Recommended)
   , ("set prerelease", SetGHCVersion
           $ GHCTargetVersion
             Nothing
-            (mkVersion $ (Str "prerelease" :| []) :| [])
+            $(versionQ "prerelease")
     )
   , ("set latest-prerelease", SetToolTag LatestPrerelease)
   , ("set latest-nightly", SetToolTag LatestNightly)
   , ("set ghc-javascript-unknown-ghcjs-9.6", SetGHCVersion
           $ GHCTargetVersion
             (Just "ghc-javascript-unknown-ghcjs")
-            (mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
+            $(versionQ "9.6")
     )
   , ("set base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
   , ("set cabal-3.10", SetGHCVersion
           $ GHCTargetVersion
             (Just "cabal")
-            (mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
+            $(versionQ "3.10")
     )
   , ("set hls-2.0.0.0", SetGHCVersion
         $ GHCTargetVersion
             (Just "hls")
-            (mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []])
+            $(versionQ "2.0.0.0")
     )
   , ("set stack-2.9.3", SetGHCVersion
         $ GHCTargetVersion
             (Just "stack")
-            (mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []])
+            $(versionQ "2.9.3")
     )
   ]
 
@@ -74,100 +75,79 @@ setGhcCheckList = mapSecond (Left . SetGHC . SetOptions)
   , ("set ghc 9.2", SetGHCVersion
         $ GHCTargetVersion
           Nothing
-          (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
+          $(versionQ "9.2")
     )
   , ("set ghc next", SetNext)
   , ("set ghc latest", SetToolTag Latest)
   , ("set ghc nightly", SetGHCVersion
         $ GHCTargetVersion
           Nothing
-          (mkVersion $ (Str "nightly" :| []) :| [])
+          $(versionQ "nightly")
     )
   , ("set ghc recommended", SetToolTag Recommended)
   , ("set ghc prerelease", SetGHCVersion
         $ GHCTargetVersion
           Nothing
-          (mkVersion $ (Str "prerelease" :| []) :| [])
+          $(versionQ "prerelease")
     )
   , ("set ghc latest-prerelease", SetToolTag LatestPrerelease)
   , ("set ghc latest-nightly", SetToolTag LatestNightly)
   , ("set ghc javascript-unknown-ghcjs-9.6", SetGHCVersion
         $ GHCTargetVersion
           (Just "javascript-unknown-ghcjs")
-          (mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
+          $(versionQ "9.6")
     )
   , ("set ghc base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
   , ("set ghc ghc-9.2", SetGHCVersion
         $ GHCTargetVersion
           (Just "ghc")
-          (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
+          $(versionQ "9.2")
     )
   ]
 
 setCabalCheckList :: [(String, Either SetCommand SetOptions)]
 setCabalCheckList = mapSecond (Left . SetCabal . SetOptions)
   [ ("set cabal", SetRecommended)
-  , ("set cabal 3.10", SetToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
+  , ("set cabal 3.10", SetToolVersion $(versionQ "3.10"))
   , ("set cabal next", SetNext)
   , ("set cabal latest", SetToolTag Latest)
-  , ("set cabal nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
+  , ("set cabal nightly", SetToolVersion $(versionQ "nightly"))
   , ("set cabal recommended", SetToolTag Recommended)
-  , ("set cabal prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
+  , ("set cabal prerelease", SetToolVersion $(versionQ "prerelease"))
   , ("set cabal latest-prerelease", SetToolTag LatestPrerelease)
   , ("set cabal latest-nightly", SetToolTag LatestNightly)
   , ("set cabal base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
-  , ("set cabal cabal-3.10", SetToolVersion
+  , ("set cabal cabal-3.10", SetToolVersion $(versionQ "cabal-3.10"))
-      $ Version
-        { _vEpoch = Nothing
-        , _vChunks = (Str "cabal" :| []) :| []
-        , _vRel = [Digits 3 :| [], Digits 10 :| []]
-        , _vMeta = Nothing
-        }
-    )
   ]
 
 setHlsCheckList :: [(String, Either SetCommand SetOptions)]
 setHlsCheckList = mapSecond (Left . SetHLS . SetOptions)
   [ ("set hls", SetRecommended)
-  , ("set hls 2.0", SetToolVersion $ mkVersion $ (Digits 2 :| []) :| [Digits 0 :| []])
+  , ("set hls 2.0", SetToolVersion $(versionQ "2.0"))
   , ("set hls next", SetNext)
   , ("set hls latest", SetToolTag Latest)
-  , ("set hls nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
+  , ("set hls nightly", SetToolVersion $(versionQ "nightly"))
   , ("set hls recommended", SetToolTag Recommended)
-  , ("set hls prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
+  , ("set hls prerelease", SetToolVersion $(versionQ "prerelease"))
   , ("set hls latest-prerelease", SetToolTag LatestPrerelease)
   , ("set hls latest-nightly", SetToolTag LatestNightly)
   , ("set hls base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
-  , ("set hls hls-2.0", SetToolVersion
+  , ("set hls hls-2.0", SetToolVersion $(versionQ "hls-2.0"))
-      $ Version
-        { _vEpoch = Nothing
-        , _vChunks = (Str "hls" :| []) :| []
-        , _vRel = [Digits 2 :| [], Digits 0 :| []]
-        , _vMeta = Nothing
-        }
-    )
   ]
 
 setStackCheckList :: [(String, Either SetCommand SetOptions)]
 setStackCheckList = mapSecond (Left . SetStack . SetOptions)
   [ ("set stack", SetRecommended)
-  , ("set stack 2.9", SetToolVersion $ mkVersion $ (Digits 2 :| []) :| [Digits 9 :| []])
+  , ("set stack 2.9", SetToolVersion $(versionQ "2.9"))
   , ("set stack next", SetNext)
   , ("set stack latest", SetToolTag Latest)
-  , ("set stack nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
+  , ("set stack nightly", SetToolVersion $(versionQ "nightly"))
   , ("set stack recommended", SetToolTag Recommended)
-  , ("set stack prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
+  , ("set stack prerelease", SetToolVersion $(versionQ "prerelease"))
   , ("set stack latest-prerelease", SetToolTag LatestPrerelease)
   , ("set stack latest-nightly", SetToolTag LatestNightly)
   , ("set stack base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
-  , ("set stack stack-2.9", SetToolVersion
+  , ("set stack stack-2.9", SetToolVersion $(versionQ "stack-2.9"))
-      $ Version
-        { _vEpoch = Nothing
-        , _vChunks = (Str "stack" :| []) :| []
-        , _vRel = [Digits 2 :| [], Digits 9 :| []]
-        , _vMeta = Nothing
-        }
-    )
   ]
 
 setParseWith :: [String] -> IO (Either SetCommand SetOptions)

test/optparse-test/Utils.hs

@@ -4,12 +4,9 @@ module Utils where
 import GHCup.OptParse as GHCup
 import Options.Applicative
 import Data.Bifunctor
-import Data.Versions
-import Data.List.NonEmpty (NonEmpty)
 import Test.Tasty
 import Test.Tasty.HUnit
 import Control.Monad.IO.Class
-import qualified Data.Text as T
 
 parseWith :: [String] -> IO Command
 parseWith args =
@@ -23,14 +20,6 @@ padLeft desiredLength s = padding ++ s
 mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)]
 mapSecond = map . second
 
-mkVersion :: NonEmpty VChunk -> Version
-mkVersion chunks = Version Nothing chunks [] Nothing
-
-mkVersion' :: T.Text -> Version
-mkVersion' txt =
-  let Right ver = version txt
-  in ver
-
 buildTestTree
   :: (Eq a, Show a)
   => ([String] -> IO a) -- ^ The parse function

test/optparse-test/WhereisTest.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module WhereisTest where
 
@@ -6,6 +7,7 @@ import Test.Tasty
 import GHCup.OptParse
 import Utils
 import GHCup.Types
+import Data.Versions (versionQ)
 
 whereisTests :: TestTree
 whereisTests = buildTestTree whereisParseWith ("whereis", whereisCheckList)
@@ -13,8 +15,8 @@ whereisTests = buildTestTree whereisParseWith ("whereis", whereisCheckList)
 whereisCheckList :: [(String, (WhereisOptions, WhereisCommand))]
 whereisCheckList = concatMap mk
   [ ("whereis ghc", WhereisTool GHC Nothing)
-  , ("whereis ghc 9.2.8", WhereisTool GHC (Just $ GHCVersion $ mkTVer $ mkVersion' "9.2.8"))
+  , ("whereis ghc 9.2.8", WhereisTool GHC (Just $ GHCVersion $ mkTVer $(versionQ "9.2.8")))
-  , ("whereis ghc ghc-9.2.8", WhereisTool GHC (Just $ GHCVersion $ GHCTargetVersion (Just "ghc") (mkVersion' "9.2.8")))
+  , ("whereis ghc ghc-9.2.8", WhereisTool GHC (Just $ GHCVersion $ GHCTargetVersion (Just "ghc") $(versionQ "9.2.8")))
   , ("whereis ghc latest", WhereisTool GHC (Just $ ToolTag Latest))
   , ("whereis cabal", WhereisTool Cabal Nothing)
   , ("whereis hls", WhereisTool HLS Nothing)