Support stacks installation strategy and metadata wrt #892

On macOS systems with Homebrew installed, the latter will install its
own copy of `xattr` in `/opt/homebrew/bin/xattr` which will often
take precedence over the system `xattr` at `/usr/bin/xattr`, and does
not support the `-r` flag to act recursively over a directory.

This commit changes the invocation of `xattr` to use the absolute path
to the system version of `xattr` at `/usr/bin/xattr`.

.github/scripts/test.sh

@@ -30,32 +30,32 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
 
 ### Haskell test suite
 
-./ghcup-test${ext}
-./ghcup-test-optparse${ext}
-rm ghcup-test${ext} ghcup-test-optparse${ext}
+./"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 unset ghc ${GHC_VER}
-ls -lah "$(eghcup whereis -d ghc ${GHC_VER})"
-[ "`$(eghcup whereis ghc ${GHC_VER}) --numeric-version`" = "${GHC_VER}" ]
-[ "`eghcup run --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)'`" ]
-eghcup set ghc ${GHC_VER}
-eghcup install cabal ${CABAL_VER}
-[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
+eghcup install ghc "${GHC_VER}"
+eghcup unset ghc "${GHC_VER}"
+ls -lah "$(eghcup whereis -d ghc "${GHC_VER}")"
+[ "$($(eghcup whereis ghc "${GHC_VER}") --numeric-version)" = "${GHC_VER}" ]
+[ "$(eghcup run -q --ghc "${GHC_VER}" -- ghc --numeric-version)" = "${GHC_VER}" ]
+[ "$(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 install cabal "${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 set cabal ${CABAL_VER}
+[ "$(eghcup run -q --cabal "${CABAL_VER}" -- cabal --numeric-version)" = "${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")

.gitmodules

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

app/ghcup/BrickMain.hs

@@ -30,6 +30,7 @@ import           Brick.Widgets.List             ( listSelectedFocusedAttr
                                                 , listAttr
                                                 )
 import           Codec.Archive
+import           Control.Applicative
 import           Control.Exception.Safe
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -432,7 +433,7 @@ filterVisible v t e | lInstalled e = True
                                   (lTool e `notElem` hiddenTools)
 
 
-install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
+install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
          => BrickState
          -> (Int, ListResult)
          -> m (Either String ())
@@ -463,6 +464,11 @@ install' _ (_, ListResult {..}) = do
               , ToolShadowed
               , UninstallFailed
               , MergeFileTreeError
+              , NoCompatiblePlatform
+              , GHCup.Errors.ParseError
+              , UnsupportedSetupCombo
+              , DistroNotFound
+              , NoCompatibleArch
               ]
 
   run (do
@@ -509,7 +515,7 @@ install' _ (_, ListResult {..}) = do
             <> "Also check the logs in ~/.ghcup/logs"
 
 
-set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
+set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
      => BrickState
      -> (Int, ListResult)
      -> m (Either String ())

app/ghcup/Main.hs

@@ -90,6 +90,8 @@ toSettings options = do
          gpgSetting  = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
          platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
          mirrors  = fromMaybe (Types.mirrors defaultSettings) uMirrors
+         stackSetupSource  = fromMaybe (Types.stackSetupSource defaultSettings) uStackSetupSource
+         stackSetup = fromMaybe (Types.stackSetup defaultSettings) uStackSetup
      in (Settings {..}, keyBindings)
 #if defined(INTERNAL_DOWNLOADER)
    defaultDownloader = Internal
@@ -339,11 +341,11 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
                           , NextVerNotFound
                           , NoToolVersionSet
                           ] m Bool
-  alreadyInstalling (Install (Right InstallOptions{..}))                 (GHC, ver)   = cmp' GHC instVer ver
-  alreadyInstalling (Install (Left (InstallGHC InstallOptions{..})))     (GHC, ver)   = cmp' GHC instVer ver
-  alreadyInstalling (Install (Left (InstallCabal InstallOptions{..})))   (Cabal, ver) = cmp' Cabal instVer ver
-  alreadyInstalling (Install (Left (InstallHLS InstallOptions{..})))     (HLS, ver)   = cmp' HLS instVer ver
-  alreadyInstalling (Install (Left (InstallStack InstallOptions{..})))   (Stack, ver) = cmp' Stack instVer ver
+  alreadyInstalling (Install (Right InstallGHCOptions{..}))                 (GHC, ver)   = cmp' GHC instVer ver
+  alreadyInstalling (Install (Left (InstallGHC InstallGHCOptions{..})))     (GHC, ver)   = cmp' GHC instVer ver
+  alreadyInstalling (Install (Left (InstallCabal InstallOptions{..})))   (Cabal, ver)    = cmp' Cabal instVer ver
+  alreadyInstalling (Install (Left (InstallHLS InstallOptions{..})))     (HLS, ver)      = cmp' HLS instVer ver
+  alreadyInstalling (Install (Left (InstallStack InstallOptions{..})))   (Stack, ver)    = cmp' Stack instVer ver
   alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
     (GHC, ver)   = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
   alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))

data/config.yaml

@@ -82,6 +82,18 @@ url-source:
     # - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
     # - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
 
+  # For stack's setup-info, this works similar, e.g.:
+  # stack-setup-source:
+  #   AddSource:
+  #   - Left:
+  #       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
+
+
 # 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

@@ -214,17 +214,7 @@ url-source:
 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)
-
-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)
+### Strategy 1: 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).
 
@@ -246,6 +236,48 @@ 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:
+
+```sh
+ghcup install ghc --stack-setup 9.4.7
+```
+
+To make this permanent, you can add the following to you `~/.ghcup/config.yaml`:
+
+```yaml
+stack-setup: true
+```
+
+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
+stack-setup-source:
+  AddSource:
+  - Left:
+      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
+```
+
+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.
+
 ### Windows
 
 On windows, you may find the following config options useful too:
@@ -456,8 +488,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/).
-GHCup itself is also pre-installed on all platforms, but may use non-standard install locations.
+On github workflows GHCup itself is 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
 

docs/install.md

@@ -42,10 +42,14 @@ Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information
 
 The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
 
-#### Version >= 11
+#### 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
@@ -56,10 +60,13 @@ The following distro packages are required: `build-essential curl libffi-dev lib
 
 The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
 
-#### Version >= 20.10
+#### 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
 
@@ -200,7 +207,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>

ghcup.cabal

@@ -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

lib-opt/GHCup/OptParse.hs

@@ -88,7 +88,7 @@ data Options = Options
   }
 
 data Command
-  = Install (Either InstallCommand InstallOptions)
+  = Install (Either InstallCommand InstallGHCOptions)
   | Test TestCommand
   | InstallCabalLegacy InstallOptions
   | Set (Either SetCommand SetOptions)

lib-opt/GHCup/OptParse/Common.hs

@@ -209,19 +209,7 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
         )
     ]
   distroP :: MP.Parsec Void Text LinuxDistro
-  distroP = choice'
-    [ 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
-    ]
+  distroP = choice' ((\d -> MP.chunk (T.pack $ distroToString d) $> d) <$> allDistros)
 
 
 uriParser :: String -> Either String URI
@@ -367,7 +355,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 =

lib-opt/GHCup/OptParse/Config.hs

@@ -135,7 +135,9 @@ updateSettings usl usr =
        gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
        platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
        mirrors' = uMirrors usl <|> uMirrors usr
-   in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors'
+       stackSetupSource' = uStackSetupSource usl <|> uStackSetupSource usr
+       stackSetup' = uStackSetup usl <|> uStackSetup usr
+   in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors' stackSetupSource' stackSetup'
  where
   updateKeyBindings :: Maybe UserKeyBindings -> Maybe UserKeyBindings -> Maybe UserKeyBindings
   updateKeyBindings Nothing Nothing = Nothing

lib-opt/GHCup/OptParse/Install.hs

@@ -50,7 +50,7 @@ import qualified Data.Text                     as T
     ----------------
 
 
-data InstallCommand = InstallGHC InstallOptions
+data InstallCommand = InstallGHC InstallGHCOptions
                     | InstallCabal InstallOptions
                     | InstallHLS InstallOptions
                     | InstallStack InstallOptions
@@ -63,6 +63,15 @@ data InstallCommand = InstallGHC InstallOptions
     --[ Options ]--
     ---------------
 
+data InstallGHCOptions = InstallGHCOptions
+  { instVer       :: Maybe ToolVersion
+  , instBindist   :: Maybe URI
+  , instSet       :: Bool
+  , isolateDir    :: Maybe FilePath
+  , forceInstall  :: Bool
+  , addConfArgs   :: [T.Text]
+  , useStackSetup :: Maybe Bool
+  } deriving (Eq, Show)
 
 data InstallOptions = InstallOptions
   { instVer      :: Maybe ToolVersion
@@ -93,14 +102,14 @@ installCabalFooter = [s|Discussion:
     --[ Parsers ]--
     ---------------
 
-installParser :: Parser (Either InstallCommand InstallOptions)
+installParser :: Parser (Either InstallCommand InstallGHCOptions)
 installParser =
   (Left <$> subparser
       (  command
           "ghc"
           (   InstallGHC
           <$> info
-                (installOpts (Just GHC) <**> helper)
+                (installGHCOpts <**> helper)
                 (  progDesc "Install GHC"
                 <> footerDoc (Just $ text installGHCFooter)
                 )
@@ -134,7 +143,7 @@ installParser =
            )
       )
     )
-    <|> (Right <$> installOpts Nothing)
+    <|> (Right <$> installGHCOpts)
  where
   installHLSFooter :: String
   installHLSFooter = [s|Discussion:
@@ -210,6 +219,12 @@ installOpts tool =
     Just GHC -> False
     Just _   -> True
 
+installGHCOpts :: Parser InstallGHCOptions
+installGHCOpts =
+  (\InstallOptions{..} b -> let useStackSetup = b in InstallGHCOptions{..})
+    <$> installOpts (Just GHC)
+    <*> invertableSwitch "stack-setup" (Just 's') False (help "Set as active version after install")
+
 
 
 
@@ -291,6 +306,11 @@ type InstallGHCEffects = '[ AlreadyInstalled
                           , UninstallFailed
                           , UnknownArchive
                           , InstallSetError
+                          , NoCompatiblePlatform
+                          , GHCup.Errors.ParseError
+                          , UnsupportedSetupCombo
+                          , DistroNotFound
+                          , NoCompatibleArch
                           ]
 
 runInstGHC :: AppState
@@ -308,21 +328,21 @@ runInstGHC appstate' =
     -------------------
 
 
-install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
+install :: Either InstallCommand InstallGHCOptions -> 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
-  (Left (InstallGHC iopts)) -> installGHC iopts
-  (Left (InstallCabal iopts)) -> installCabal iopts
-  (Left (InstallHLS iopts)) -> installHLS iopts
-  (Left (InstallStack iopts)) -> installStack iopts
+    installGHC iGHCopts
+  (Left (InstallGHC iGHCopts)) -> installGHC iGHCopts
+  (Left (InstallCabal iopts))  -> installCabal iopts
+  (Left (InstallHLS iopts))    -> installHLS iopts
+  (Left (InstallStack iopts))  -> installStack iopts
  where
-  installGHC :: InstallOptions -> IO ExitCode
-  installGHC InstallOptions{..} = do
+  installGHC :: InstallGHCOptions -> IO ExitCode
+  installGHC InstallGHCOptions{..} = do
     s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
     (case instBindist of
-       Nothing -> runInstGHC s' $ do
+       Nothing -> runInstGHC s'{ settings = maybe settings (\b -> settings {stackSetup = b}) useStackSetup }  $ do
          (v, vi) <- liftE $ fromVersion instVer GHC
          liftE $ runBothE' (installGHCBin
                      v

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/GHCup/Download.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
 
-
 {-|
 Module      : GHCup.Download
 Description : Downloading
@@ -31,6 +30,8 @@ import           GHCup.Download.Utils
 #endif
 import           GHCup.Errors
 import           GHCup.Types
+import qualified GHCup.Types.Stack                as Stack
+import           GHCup.Types.Stack (downloadInfoUrl, downloadInfoSha256)
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
@@ -159,9 +160,10 @@ getBase :: ( MonadReader env m
            , MonadCatch m
            , HasLog env
            , MonadMask m
+           , FromJSON j
            )
         => URI
-        -> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m GHCupInfo
+        -> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m j
 getBase uri = do
   Settings { noNetwork, downloader, metaMode } <- lift getSettings
 
@@ -325,6 +327,107 @@ getDownloadInfo' t v = do
       _            -> with_distro <|> without_distro_ver <|> without_distro
     )
 
+getStackDownloadInfo :: ( MonadReader env m
+                        , HasDirs env
+                        , HasGHCupInfo env
+                        , HasLog env
+                        , HasPlatformReq env
+                        , HasSettings env
+                        , MonadCatch m
+                        , MonadFail m
+                        , MonadIO m
+                        , MonadMask m
+                        , MonadThrow m
+                        )
+                     => StackSetupURLSource
+                     -> [String]
+                     -> Tool
+                     -> GHCTargetVersion
+                     -- ^ tool version
+                     -> Excepts
+                          '[NoDownload, DownloadFailed]
+                          m
+                          DownloadInfo
+getStackDownloadInfo stackSetupSource keys@(_:_) GHC tv@(GHCTargetVersion Nothing v) =
+  case stackSetupSource of
+    StackSetupURL -> do
+      (dli :: Stack.SetupInfo) <- liftE $ reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getBase stackSetupURL
+      sDli <- liftE $ stackDownloadInfo dli
+      lift $ fromStackDownloadInfo sDli
+    (SOwnSource exts) -> do
+      (dlis :: [Stack.SetupInfo]) <- liftE $ reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ mapM (either pure getBase) exts
+      dli <- lift $ mergeSetupInfo dlis
+      sDli <- liftE $ stackDownloadInfo dli
+      lift $ fromStackDownloadInfo sDli
+    (SOwnSpec si) -> do
+      sDli <- liftE $ stackDownloadInfo si
+      lift $ fromStackDownloadInfo sDli
+    (SAddSource exts) -> do
+      base :: Stack.SetupInfo     <- liftE $ reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getBase stackSetupURL
+      (dlis :: [Stack.SetupInfo]) <- liftE $ reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ mapM (either pure getBase) exts
+      dli <- lift $ mergeSetupInfo (base:dlis)
+      sDli <- liftE $ stackDownloadInfo dli
+      lift $ fromStackDownloadInfo sDli
+
+ where
+  stackDownloadInfo :: MonadIO m => Stack.SetupInfo -> Excepts '[NoDownload] m Stack.DownloadInfo
+  stackDownloadInfo dli@Stack.SetupInfo{} = do
+    let siGHCs = Stack.siGHCs dli
+        ghcVersionsPerKey = (`M.lookup` siGHCs) <$> (T.pack <$> keys)
+    ghcVersions <- (listToMaybe . catMaybes $ ghcVersionsPerKey) ?? NoDownload tv GHC Nothing
+    (Stack.gdiDownloadInfo <$> M.lookup v ghcVersions) ?? NoDownload tv GHC Nothing
+
+  mergeSetupInfo :: MonadFail m
+                 => [Stack.SetupInfo]
+                 -> m Stack.SetupInfo
+  mergeSetupInfo [] = fail "mergeSetupInfo: internal error: need at least one SetupInfo"
+  mergeSetupInfo xs@(Stack.SetupInfo{}: _) =
+    let newSevenzExe   = Stack.siSevenzExe $ last xs
+        newSevenzDll   = Stack.siSevenzDll $ last xs
+        newMsys2       = M.unionsWith (\_ a2 -> a2              ) (Stack.siMsys2 <$> xs)
+        newGHCs        = M.unionsWith (M.unionWith (\_ b2 -> b2)) (Stack.siGHCs  <$> xs)
+        newStack       = M.unionsWith (M.unionWith (\_ b2 -> b2)) (Stack.siStack <$> xs)
+    in pure $ Stack.SetupInfo newSevenzExe newSevenzDll newMsys2 newGHCs newStack
+
+  fromStackDownloadInfo :: MonadThrow m => Stack.DownloadInfo -> m DownloadInfo
+  fromStackDownloadInfo 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
+getStackDownloadInfo _ _ t v = throwE $ NoDownload v t Nothing
+
+{--
+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)
+
+data VersionedDownloadInfo = VersionedDownloadInfo
+  { vdiVersion      :: Version
+  , vdiDownloadInfo :: DownloadInfo
+  }
+  }
+
+data DownloadInfo = DownloadInfo
+  { downloadInfoUrl           :: Text
+    -- ^ URL or absolute file path
+  , downloadInfoContentLength :: Maybe Int
+  , downloadInfoSha1          :: Maybe ByteString
+  , downloadInfoSha256        :: Maybe ByteString
+  }
+
+data GHCDownloadInfo = GHCDownloadInfo
+  { gdiConfigureOpts :: [Text]
+  , gdiConfigureEnv  :: Map Text Text
+  , gdiDownloadInfo  :: DownloadInfo
+  }
+
+
+   --}
+
+
 
 -- | Tries to download from the given http or https url
 -- and saves the result in continuous memory into a file.

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
@@ -687,6 +689,17 @@ instance Pretty DuplicateReleaseChannel where
       <> (T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
       <> "\nGiving up. You can use '--force' to remove and append the duplicate URI (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 ]--
     -------------------------
@@ -821,6 +834,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

@@ -26,6 +26,7 @@ import           GHCup.Types
 import           GHCup.Types.JSON               ( )
 import           GHCup.Types.Optics
 import           GHCup.Utils
+import           GHCup.Platform
 import           GHCup.Prelude
 import           GHCup.Prelude.File
 import           GHCup.Prelude.Logger
@@ -74,6 +75,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 +218,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 +516,7 @@ installGHCBin :: ( MonadFail m
                  , MonadResource m
                  , MonadIO m
                  , MonadUnliftIO m
+                 , Alternative m
                  )
               => GHCTargetVersion -- ^ the version to install
               -> InstallDir
@@ -533,11 +538,23 @@ installGHCBin :: ( MonadFail m
                     , ProcessError
                     , UninstallFailed
                     , MergeFileTreeError
+                    , NoCompatiblePlatform
+                    , ParseError
+                    , UnsupportedSetupCombo
+                    , DistroNotFound
+                    , NoCompatibleArch
                     ]
                    m
                    ()
 installGHCBin tver installDir forceInstall addConfArgs = do
-  dlinfo <- liftE $ getDownloadInfo' GHC tver
+  Settings{ stackSetupSource, stackSetup } <- lift getSettings
+  dlinfo <- if stackSetup
+            then do
+              lift $ logInfo "Using stack's setup-info to install GHC"
+              pfreq <- lift getPlatformReq
+              keys <- liftE $ getStackPlatformKey pfreq
+              liftE $ getStackDownloadInfo stackSetupSource keys GHC tver
+            else liftE $ getDownloadInfo' GHC tver
   liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs
 
 

lib/GHCup/Platform.hs

@@ -23,11 +23,13 @@ import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
-import           GHCup.Utils.Dirs
+import           GHCup.Utils
 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
+
 
 
 
@@ -197,3 +206,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, Alternative 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/MegaParsec.hs

@@ -120,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
-  cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir })
+executeOut path args chdir = executeOut' path args chdir 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' = do
+  cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir, env = env' })
   (exit, out, err) <- liftIO $ readCreateProcessWithExitCodeBS cp ""
   pure $ CapturedProcess exit out err
 

lib/GHCup/Types.hs

@@ -26,6 +26,7 @@ module GHCup.Types
   )
   where
 
+import           GHCup.Types.Stack              ( SetupInfo )
 import {-# SOURCE #-} GHCup.Utils.Dirs          ( fromGHCupPath, GHCupPath )
 
 import           Control.DeepSeq                ( NFData, rnf )
@@ -46,7 +47,6 @@ 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
@@ -58,6 +58,7 @@ data Key = KEsc  | KChar Char | KBS | KEnter
 #endif
 
 
+
     --------------------
     --[ GHCInfo Tree ]--
     --------------------
@@ -249,13 +250,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
 
@@ -268,6 +274,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"
@@ -332,10 +340,19 @@ data URLSource = GHCupURL
                | AddSource [Either GHCupInfo URI] -- ^ merge with GHCupURL
                deriving (GHC.Generic, Show)
 
+data StackSetupURLSource = StackSetupURL
+                         | SOwnSource [Either SetupInfo URI] -- ^ complete source list
+                         | SOwnSpec SetupInfo
+                         | SAddSource [Either SetupInfo URI] -- ^ merge with GHCupURL
+  deriving (Show, Eq, GHC.Generic)
+
+instance NFData StackSetupURLSource
+
 instance NFData URLSource
 instance NFData (URIRef Absolute) where
   rnf (URI !_ !_ !_ !_ !_) = ()
 
+
 data MetaMode = Strict
               | Lax
   deriving (Show, Read, Eq, GHC.Generic)
@@ -356,11 +373,13 @@ data UserSettings = UserSettings
   , uGPGSetting  :: Maybe GPGSetting
   , uPlatformOverride :: Maybe PlatformRequest
   , uMirrors     :: Maybe DownloadMirrors
+  , uStackSetupSource  :: Maybe StackSetupURLSource
+  , uStackSetup        :: Maybe Bool
   }
   deriving (Show, GHC.Generic)
 
 defaultUserSettings :: UserSettings
-defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
 fromSettings Settings{..} Nothing =
@@ -378,6 +397,8 @@ fromSettings Settings{..} Nothing =
     , uGPGSetting = Just gpgSetting
     , uPlatformOverride = platformOverride
     , uMirrors = Just mirrors
+    , uStackSetupSource = Just stackSetupSource
+    , uStackSetup = Just stackSetup
   }
 fromSettings Settings{..} (Just KeyBindings{..}) =
   let ukb = UserKeyBindings
@@ -405,6 +426,8 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
     , uGPGSetting = Just gpgSetting
     , uPlatformOverride = platformOverride
     , uMirrors = Just mirrors
+    , uStackSetupSource = Just stackSetupSource
+    , uStackSetup = Just stackSetup
   }
 
 data UserKeyBindings = UserKeyBindings
@@ -489,6 +512,8 @@ data Settings = Settings
   , noColor          :: Bool -- this also exists in LoggerConfig
   , platformOverride :: Maybe PlatformRequest
   , mirrors          :: DownloadMirrors
+  , stackSetupSource :: StackSetupURLSource
+  , stackSetup       :: Bool
   }
   deriving (Show, GHC.Generic)
 
@@ -496,7 +521,7 @@ defaultMetaCache :: Integer
 defaultMetaCache = 300 -- 5 minutes
 
 defaultSettings :: Settings
-defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty)
+defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty) StackSetupURL False
 
 instance NFData Settings
 
@@ -742,3 +767,4 @@ instance Pretty ToolVersion where
 data BuildSystem = Hadrian
                  | Make
   deriving (Show, Eq)
+

lib/GHCup/Types/JSON.hs

@@ -23,6 +23,7 @@ module GHCup.Types.JSON where
 
 import           GHCup.Types
 import           GHCup.Types.JSON.Utils
+import           GHCup.Types.JSON.Versions ()
 import           GHCup.Prelude.MegaParsec
 
 import           Control.Applicative            ( (<|>) )
@@ -112,34 +113,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
@@ -176,43 +149,6 @@ 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
 
@@ -348,6 +284,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downlo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
 deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
+deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, constructorTagModifier = \str' -> if str' == "StackSetupURL" then str' else maybe str' T.unpack . T.stripPrefix (T.pack "S") . T.pack $ str' } ''StackSetupURLSource
 deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Port

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"            .!= mempty
+    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
@@ -92,7 +91,7 @@ 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 System.Environment (getEnvironment)
 import Data.Time (Day(..), diffDays, addDays)
 
 
@@ -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
-    broken <- isBrokenSymlink hlsBin
+  handleIO' NoSuchThing (\_ -> pure Nothing) $ do
+    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
@@ -1079,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
@@ -1314,20 +1320,27 @@ warnAboutHlsCompatibility = do
 
 
 
-addToPath :: FilePath
+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
+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/Version.hs

@@ -34,7 +34,10 @@ import Data.Void (Void)
 -- 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|]
 
 -- | The current ghcup version.
 ghcUpVer :: V.PVP
@@ -53,7 +56,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

test/optparse-test/InstallTest.hs

@@ -2,6 +2,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module InstallTest where
 
@@ -13,6 +16,8 @@ import Data.Versions
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import GHCup.OptParse.Install as Install
 import URI.ByteString.QQ
+import URI.ByteString
+import Data.Text (Text)
 
 -- Some interests:
 --   install ghc *won't* select `set as activate version` as default
@@ -26,37 +31,52 @@ installTests = testGroup "install"
       (buildTestTree installParseWith)
       [ ("old-style", oldStyleCheckList)
       , ("ghc", installGhcCheckList)
-      , ("cabal", installCabalCheckList)
-      , ("hls", installHlsCheckList)
-      , ("stack", installStackCheckList)
+      , ("cabal", (fmap . fmap . fmap) toGHCOptions installCabalCheckList)
+      , ("hls", (fmap . fmap . fmap) toGHCOptions installHlsCheckList)
+      , ("stack", (fmap . fmap . fmap) toGHCOptions installStackCheckList)
       ]
 
+toGHCOptions :: InstallOptions -> InstallGHCOptions
+toGHCOptions InstallOptions{..}
+  = InstallGHCOptions instVer
+                      instBindist
+                      instSet
+                      isolateDir
+                      forceInstall
+                      addConfArgs
+                      Nothing
+
+
+
 defaultOptions :: InstallOptions
 defaultOptions = InstallOptions Nothing Nothing False Nothing False []
 
+defaultGHCOptions :: InstallGHCOptions
+defaultGHCOptions = InstallGHCOptions Nothing Nothing False Nothing False [] Nothing
+
 -- | Don't set as active version
-mkInstallOptions :: ToolVersion -> InstallOptions
-mkInstallOptions ver = InstallOptions (Just ver) Nothing False Nothing False []
+mkInstallOptions :: ToolVersion -> InstallGHCOptions
+mkInstallOptions ver = InstallGHCOptions (Just ver) Nothing False Nothing False [] Nothing
 
 -- | Set as active version
 mkInstallOptions' :: ToolVersion -> InstallOptions
 mkInstallOptions' ver = InstallOptions (Just ver) Nothing True Nothing False []
 
-oldStyleCheckList :: [(String, Either InstallCommand InstallOptions)]
+oldStyleCheckList :: [(String, Either InstallCommand InstallGHCOptions)]
 oldStyleCheckList =
-      ("install", Right defaultOptions)
-    : ("install --set", Right defaultOptions{instSet = True})
-    : ("install --force", Right defaultOptions{forceInstall = True})
+      ("install", Right defaultGHCOptions)
+    : ("install --set", Right (defaultGHCOptions{instSet = True} :: InstallGHCOptions))
+    : ("install --force", Right (defaultGHCOptions{forceInstall = True} :: InstallGHCOptions))
 #ifdef IS_WINDOWS
-    : ("install -i C:\\\\", Right defaultOptions{Install.isolateDir = Just "C:\\\\"})
+    : ("install -i C:\\\\", Right (defaultGHCOptions{Install.isolateDir = Just "C:\\\\"} :: InstallGHCOptions))
 #else
-    : ("install -i /", Right defaultOptions{Install.isolateDir = Just "/"})
+    : ("install -i /", Right (defaultGHCOptions{Install.isolateDir = Just "/"} :: InstallGHCOptions))
 #endif
     : ("install -u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz head"
-    , Right defaultOptions
+    , Right (defaultGHCOptions
         { 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  $(versionQ "head")
-        }
+        } :: InstallGHCOptions)
     )
     : mapSecond
         (Right . mkInstallOptions)
@@ -108,9 +128,9 @@ oldStyleCheckList =
           )
         ]
 
-installGhcCheckList :: [(String, Either InstallCommand InstallOptions)]
+installGhcCheckList :: [(String, Either InstallCommand InstallGHCOptions)]
 installGhcCheckList =
-  ("install ghc", Left $ InstallGHC defaultOptions)
+  ("install ghc", Left $ InstallGHC defaultGHCOptions)
   : mapSecond (Left . InstallGHC . mkInstallOptions)
     [ ("install ghc 9.2", GHCVersion
           $ GHCTargetVersion
@@ -151,7 +171,7 @@ installGhcCheckList =
 
 installCabalCheckList :: [(String, Either InstallCommand InstallOptions)]
 installCabalCheckList =
-  ("install cabal", Left $ InstallCabal defaultOptions{instSet = True})
+  ("install cabal", Left $ InstallCabal (defaultOptions{instSet = True} :: InstallOptions))
   : mapSecond (Left . InstallCabal . mkInstallOptions')
     [ ("install cabal 3.10", ToolVersion $(versionQ "3.10"))
     , ("install cabal next", ToolVersion $(versionQ "next"))
@@ -197,7 +217,7 @@ installStackCheckList =
     , ("install stack stack-2.9", ToolVersion $(versionQ "stack-2.9"))
     ]
 
-installParseWith :: [String] -> IO (Either InstallCommand InstallOptions)
+installParseWith :: [String] -> IO (Either InstallCommand InstallGHCOptions)
 installParseWith args = do
   Install a <- parseWith args
   pure a