Fix double appstate

It would error out trying to set the version.

CHANGELOG.md

@@ -1,5 +1,16 @@
 # Revision history for ghcup
 
+## 0.1.17.6 -- ????-??-??
+
+* Vastly improve shell completions wrt [#242](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/242)
+* Fix 'ghcup install cabal/hls/stack --set' wrt [#324](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/324)
+* Fix bad error message wrt [#323](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/323)
+* Use predictable /tmp names for `ghcup run`, fixes [#329](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/329)
+* Fix bug with isolated installation of not previously installed versions
+* Add `--no-set` to install commands, fixes [#330](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/330)
+* Fix serious bug in `ghcup list --raw-format -t <tool> -c installed`
+* Overhaul metadata merging and add `ghcup config add-release-channel URI` wrt [#328](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/328)
+
 ## 0.1.17.5 -- 2022-02-26
 
 * Implement `ghcup run` subcommand wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/137)

app/ghcup/GHCup/OptParse.hs

@@ -98,7 +98,7 @@ data Command
 #ifndef DISABLE_UPGRADE
   | Upgrade UpgradeOpts Bool
 #endif
-  | ToolRequirements
+  | ToolRequirements ToolReqOpts
   | ChangeLog ChangeLogOptions
   | Nuke
 #if defined(BRICK)
@@ -113,8 +113,8 @@ data Command
 opts :: Parser Options
 opts =
   Options
-    <$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)")
+    <$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
-    <*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
+    <*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
     <*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
     <*> optional
           (option
@@ -124,9 +124,10 @@ opts =
             <> metavar "URL"
             <> help "Alternative ghcup download info url"
             <> internal
+            <> completer fileUri
             )
           )
-    <*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
+    <*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
     <*> optional (option
           (eitherReader keepOnParser)
           (  long "keep"
@@ -134,6 +135,7 @@ opts =
           <> help
                "Keep build directories? (default: errors)"
           <> hidden
+          <> completer (listCompleter ["always", "errors", "never"])
           ))
     <*> optional (option
           (eitherReader downloaderParser)
@@ -142,20 +144,23 @@ opts =
           <> metavar "<internal|curl|wget>"
           <> help
           "Downloader to use (default: internal)"
+          <> completer (listCompleter ["internal", "curl", "wget"])
 #else
           <> metavar "<curl|wget>"
           <> help
           "Downloader to use (default: curl)"
+          <> completer (listCompleter ["curl", "wget"])
 #endif
           <> hidden
           ))
-    <*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.")
+    <*> invertableSwitch "offline" (Just 'o') False (help "Don't do any network calls, trying cached assets and failing if missing.")
     <*> optional (option
           (eitherReader gpgParser)
           (  long "gpg"
           <> metavar "<strict|lax|none>"
           <> help
           "GPG verification (default: none)"
+          <> completer (listCompleter ["strict", "lax", "none"])
           ))
     <*> com
  where
@@ -284,8 +289,8 @@ com =
               ((\_ -> DInfo) <$> info helper (progDesc "Show debug info"))
           <> command
                "tool-requirements"
-               (   (\_ -> ToolRequirements)
+               (   ToolRequirements
-               <$> info helper
+               <$> info (toolReqP <**> helper)
                         (progDesc "Show the requirements for ghc/cabal")
                )
           <> command

app/ghcup/GHCup/OptParse/ChangeLog.hs

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

app/ghcup/GHCup/OptParse/Common.hs

@@ -3,6 +3,8 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE NumericUnderscores #-}
 
 module GHCup.OptParse.Common where
 
@@ -14,36 +16,55 @@ import           GHCup.Platform
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Utils
+import           GHCup.Utils.File
 import           GHCup.Utils.Logger
 import           GHCup.Utils.MegaParsec
 import           GHCup.Utils.Prelude
 
+import           Control.DeepSeq
+import           Control.Concurrent
+import           Control.Concurrent.Async
 import           Control.Exception.Safe
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
 import           Control.Monad.Reader
+import           Data.Aeson
+#if MIN_VERSION_aeson(2,0,0)
+import qualified Data.Aeson.Key    as KM
+import qualified Data.Aeson.KeyMap as KM
+#else
+import qualified Data.HashMap.Strict as KM
+#endif
+import           Data.ByteString.Lazy           ( ByteString )
 import           Data.Bifunctor
 import           Data.Char
 import           Data.Either
 import           Data.Functor
-import           Data.List                      ( nub, sort, sortBy )
+import           Data.List                      ( nub, sort, sortBy, isPrefixOf, stripPrefix )
 import           Data.Maybe
 import           Data.Text                      ( Text )
 import           Data.Versions           hiding ( str )
 import           Data.Void
+import qualified Data.Vector      as V
+import           GHC.IO.Exception
 import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           Safe
+import           System.Directory
+import           System.Process                  ( readProcess )
 import           System.FilePath
+import           Text.HTML.TagSoup       hiding ( Tag )
 import           URI.ByteString
 
 import qualified Data.ByteString.UTF8          as UTF8
 import qualified Data.Map.Strict               as M
 import qualified Data.Text                     as T
 import qualified Text.Megaparsec               as MP
+import qualified System.FilePath.Posix         as FP
 import GHCup.Version
+import Control.Exception (evaluate)
 
 
     -------------
@@ -117,7 +138,7 @@ versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar
 -- the help is shown only for --no-recursive.
 invertableSwitch
     :: String              -- ^ long option
-    -> Char                -- ^ short option for the non-default option
+    -> Maybe Char          -- ^ short option for the non-default option
     -> Bool                -- ^ is switch enabled by default?
     -> Mod FlagFields Bool -- ^ option modifier
     -> Parser (Maybe Bool)
@@ -128,14 +149,14 @@ invertableSwitch longopt shortopt defv optmod = invertableSwitch' longopt shorto
 -- | Allows providing option modifiers for both --foo and --no-foo.
 invertableSwitch'
     :: String              -- ^ long option (eg "foo")
-    -> Char                -- ^ short option for the non-default option
+    -> Maybe Char          -- ^ short option for the non-default option
     -> Bool                -- ^ is switch enabled by default?
     -> Mod FlagFields Bool -- ^ option modifier for --foo
     -> Mod FlagFields Bool -- ^ option modifier for --no-foo
     -> Parser (Maybe Bool)
 invertableSwitch' longopt shortopt defv enmod dismod = optional
-    ( flag' True ( enmod <> long longopt <> if defv then mempty else short shortopt)
+    ( flag' True ( enmod <> long longopt <> if defv then mempty else maybe mempty short shortopt)
-    <|> flag' False (dismod <> long nolongopt <> if defv then short shortopt else mempty)
+    <|> flag' False (dismod <> long nolongopt <> if defv then maybe mempty short shortopt else mempty)
     )
   where
     nolongopt = "no-" ++ longopt
@@ -277,6 +298,126 @@ gpgParser s' | t == T.pack "strict" = Right GPGStrict
     --[ Completers ]--
     ------------------
 
+
+toolCompleter :: Completer
+toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
+
+gitFileUri :: [String] -> Completer
+gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
+
+fileUri :: Completer
+fileUri = mkCompleter $ fileUri' []
+
+fileUri' :: [String] -> String -> IO [String]
+fileUri' add = \case
+  "" -> do
+    pwd <- getCurrentDirectory
+    pure $ ["https://", "http://", "file:///", "file://" <> pwd <> "/"] <> add
+  xs
+   | "file:///" `isPrefixOf` xs -> fmap ("file://" <>) <$>
+      case stripPrefix "file://" xs of
+        Nothing -> pure []
+        Just r ->  do
+          pwd <- getCurrentDirectory
+          dirs  <- compgen "directory" r ["-S", "/"]
+          files <- filter (\f -> (f <> "/") `notElem` dirs) <$> compgen "file" r []
+          pure (dirs <> files <> if r `isPrefixOf` pwd then [pwd <> "/"] else [])
+   | xs `isPrefixOf` "file:///" -> pure ["file:///"]
+   | xs `isPrefixOf` "https://" -> pure ["https://"]
+   | xs `isPrefixOf` "http://"  -> pure ["http://"]
+   | otherwise -> pure []
+ where
+  compgen :: String -> String -> [String] -> IO [String]
+  compgen action' r opts = do
+    let cmd = unwords $ ["compgen", "-A", action'] <> opts <> ["--", requote r]
+    result <- tryIO $ readProcess "bash" ["-c", cmd] ""
+    return . lines . either (const []) id $ result
+
+  -- | Strongly quote the string we pass to compgen.
+  --
+  -- We need to do this so bash doesn't expand out any ~ or other
+  -- chars we want to complete on, or emit an end of line error
+  -- when seeking the close to the quote.
+  -- 
+  -- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
+  requote :: String -> String
+  requote s =
+    let
+      -- Bash doesn't appear to allow "mixed" escaping
+      -- in bash completions. So we don't have to really
+      -- worry about people swapping between strong and
+      -- weak quotes.
+      unescaped =
+        case s of
+          -- It's already strongly quoted, so we
+          -- can use it mostly as is, but we must
+          -- ensure it's closed off at the end and
+          -- there's no single quotes in the
+          -- middle which might confuse bash.
+          ('\'': rs) -> unescapeN rs
+
+          -- We're weakly quoted.
+          ('"': rs)  -> unescapeD rs
+
+          -- We're not quoted at all.
+          -- We need to unescape some characters like
+          -- spaces and quotation marks.
+          elsewise   -> unescapeU elsewise
+    in
+      strong unescaped
+
+    where
+      strong ss = '\'' : foldr go "'" ss
+        where
+          -- If there's a single quote inside the
+          -- command: exit from the strong quote and
+          -- emit it the quote escaped, then resume.
+          go '\'' t = "'\\''" ++ t
+          go h t    = h : t
+
+      -- Unescape a strongly quoted string
+      -- We have two recursive functions, as we
+      -- can enter and exit the strong escaping.
+      unescapeN = goX
+        where
+          goX ('\'' : xs) = goN xs
+          goX (x : xs) = x : goX xs
+          goX [] = []
+
+          goN ('\\' : '\'' : xs) = '\'' : goN xs
+          goN ('\'' : xs) = goX xs
+          goN (x : xs) = x : goN xs
+          goN [] = []
+
+      -- Unescape an unquoted string
+      unescapeU = goX
+        where
+          goX [] = []
+          goX ('\\' : x : xs) = x : goX xs
+          goX (x : xs) = x : goX xs
+
+      -- Unescape a weakly quoted string
+      unescapeD = goX
+        where
+          -- Reached an escape character
+          goX ('\\' : x : xs)
+            -- If it's true escapable, strip the
+            -- slashes, as we're going to strong
+            -- escape instead.
+            | x `elem` ("$`\"\\\n" :: String) = x : goX xs
+            | otherwise = '\\' : x : goX xs
+          -- We've ended quoted section, so we
+          -- don't recurse on goX, it's done.
+          goX ('"' : xs)
+            = xs
+          -- Not done, but not a special character
+          -- just continue the fold.
+          goX (x : xs)
+            = x : goX xs
+          goX []
+            = []
+
+
 tagCompleter :: Tool -> [String] -> Completer
 tagCompleter tool add = listIOCompleter $ do
   dirs' <- liftIO getAllDirs
@@ -334,6 +475,150 @@ versionCompleter criteria tool = listIOCompleter $ do
       return $ T.unpack . prettyVer . lVer <$> installedVersions
 
 
+toolDlCompleter :: Tool -> Completer
+toolDlCompleter tool = mkCompleter $ \case
+  "" -> pure (initUrl tool <> ["https://", "http://", "file:///"])
+  word
+    | "file://" `isPrefixOf` word -> fileUri' [] word
+    -- downloads.haskell.org
+    | "https://downloads.haskell.org/" `isPrefixOf` word ->
+        fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> fromHRef word
+
+    -- github releases
+    | "https://github.com/haskell/haskell-language-server/releases/download/" `isPrefixOf` word
+    , let xs = splitPath word
+    , (length xs == 6 && last word == '/') || (length xs == 7 && last word /= '/') ->
+        fmap (\x -> completePrefix word x <> "/") . prefixMatch (FP.takeFileName word) <$> getGithubReleases "haskell" "haskell-language-server"
+    | "https://github.com/commercialhaskell/stack/releases/download/" == word
+    , let xs = splitPath word
+    , (length xs == 6 && last word == '/') || (length xs == 7 && last word /= '/') ->
+        fmap (\x -> completePrefix word x <> "/") . prefixMatch (FP.takeFileName word) <$> getGithubReleases "commercialhaskell" "stack"
+
+    -- github release assets
+    | "https://github.com/haskell/haskell-language-server/releases/download/" `isPrefixOf` word
+    , let xs = splitPath word
+    , (length xs == 7 && last word == '/') || length xs == 8
+    , let rel = xs !! 6
+    , length rel > 1 -> do
+        fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> getGithubAssets "haskell" "haskell-language-server" (init rel)
+    | "https://github.com/commercialhaskell/stack/releases/download/" `isPrefixOf` word
+    , let xs = splitPath word
+    , (length xs == 7 && last word == '/') || length xs == 8
+    , let rel = xs !! 6
+    , length rel > 1 -> do
+        fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> getGithubAssets "commercialhaskell" "stack" (init rel)
+
+    -- github
+    | "https://github.com/c" `isPrefixOf` word -> pure ["https://github.com/commercialhaskell/stack/releases/download/"]
+    | "https://github.com/h" `isPrefixOf` word -> pure ["https://github.com/haskell/haskell-language-server/releases/download/"]
+    | "https://g" `isPrefixOf` word
+    , tool == Stack -> pure ["https://github.com/commercialhaskell/stack/releases/download/"]
+    | "https://g" `isPrefixOf` word
+    , tool == HLS -> pure ["https://github.com/haskell/haskell-language-server/releases/download/"]
+
+    | "https://d" `isPrefixOf` word -> pure $ filter ("https://downloads.haskell.org/" `isPrefixOf`) $ initUrl tool
+
+    | "h" `isPrefixOf` word -> pure $ initUrl tool
+
+    | word `isPrefixOf` "file:///" -> pure ["file:///"]
+    | word `isPrefixOf` "https://" -> pure ["https://"]
+    | word `isPrefixOf` "http://"  -> pure ["http://"]
+
+    | otherwise -> pure []
+ where
+  initUrl :: Tool -> [String]
+  initUrl GHC   = [ "https://downloads.haskell.org/~ghc/"
+                  , "https://downloads.haskell.org/~ghcup/unofficial-bindists/ghc/"
+                  ]
+  initUrl Cabal = [ "https://downloads.haskell.org/~cabal/"
+                  , "https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/"
+                  ]
+  initUrl GHCup = [ "https://downloads.haskell.org/~ghcup/" ]
+  initUrl HLS   = [ "https://github.com/haskell/haskell-language-server/releases/download/"
+                  , "https://downloads.haskell.org/~ghcup/unofficial-bindists/haskell-language-server/"
+                  ]
+  initUrl Stack = [ "https://github.com/commercialhaskell/stack/releases/download/"
+                  , "https://downloads.haskell.org/~ghcup/unofficial-bindists/stack/"
+                  ]
+
+  completePrefix :: String -- ^ url, e.g.    'https://github.com/haskell/haskell-languag'
+                 -> String -- ^ match, e.g.  'haskell-language-server'
+                 -> String -- ^ result, e.g. 'https://github.com/haskell/haskell-language-server'
+  completePrefix url match =
+    let base = FP.takeDirectory url
+        fn   = FP.takeFileName url
+    in if fn `isPrefixOf` match then base <> "/" <> match else url
+
+  prefixMatch :: String -> [String] -> [String]
+  prefixMatch pref = filter (pref `isPrefixOf`)
+
+  fromHRef :: String -> IO [String]
+  fromHRef url = withCurl (FP.takeDirectory url) 2_000_000 $ \stdout ->
+      pure
+        . fmap (T.unpack . decUTF8Safe' . fromAttrib "href")
+        . filter isTagOpen
+        . filter (~== ("<a href>" :: String))
+        . parseTags
+        $ stdout
+
+  withCurl :: String                      -- ^ url
+           -> Int                         -- ^ delay
+           -> (ByteString -> IO [String]) -- ^ callback
+           -> IO [String]
+  withCurl url delay cb = do
+    let limit = threadDelay delay
+    race limit (executeOut "curl" ["-fL", url] Nothing) >>= \case
+      Right (CapturedProcess {_exitCode, _stdOut}) -> do
+        case _exitCode of
+          ExitSuccess ->
+            (try @_ @SomeException . cb $ _stdOut) >>= \case
+              Left _ ->  pure []
+              Right r' -> do
+                r <- try @_ @SomeException
+                  . evaluate
+                  . force
+                  $ r'
+                either (\_ -> pure []) pure r
+          ExitFailure _ -> pure []
+      Left _ -> pure []
+
+  getGithubReleases :: String
+                    -> String
+                    -> IO [String]
+  getGithubReleases owner repo = withCurl url 3_000_000 $ \stdout -> do
+    Just xs <- pure $ decode' @Array stdout
+    fmap V.toList $ forM xs $ \x -> do
+      (Object r) <- pure x
+      Just (String name) <- pure $ KM.lookup (mkval "tag_name") r
+      pure $ T.unpack name
+   where
+    url = "https://api.github.com/repos/" <> owner <> "/" <> repo <> "/releases"
+
+  getGithubAssets :: String
+                  -> String
+                  -> String
+                  -> IO [String]
+  getGithubAssets owner repo tag = withCurl url 3_000_000 $ \stdout -> do
+    Just xs <- pure $ decode' @Object stdout
+    Just (Array assets) <- pure $ KM.lookup (mkval "assets") xs
+    as <- fmap V.toList $ forM assets $ \val -> do
+      (Object asset) <- pure val
+      Just (String name) <- pure $ KM.lookup (mkval "name") asset
+      pure $ T.unpack name
+    pure as
+   where
+    url = "https://api.github.com/repos/" <> owner <> "/" <> repo <> "/releases/tags/" <> tag
+
+
+#if MIN_VERSION_aeson(2,0,0)
+  mkval = KM.fromString
+#else
+  mkval = id
+#endif
+
+
+
+
 
 
     -----------------

app/ghcup/GHCup/OptParse/Compile.hs

@@ -165,6 +165,7 @@ ghcCompileOpts =
           )
           (short 'v' <> long "version" <> metavar "VERSION" <> help
             "The tool version to compile"
+            <> (completer $ versionCompleter Nothing GHC)
           )
           ) <|>
           (Right <$> (GitBranch <$> option
@@ -172,7 +173,10 @@ ghcCompileOpts =
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
             "The git commit/branch/ref to build from"
           ) <*>
-          optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
+          optional (option str (
+            short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
+            <> completer (gitFileUri ["https://gitlab.haskell.org/ghc/ghc.git"])
+            ))
           )))
     <*> option
           (eitherReader
@@ -185,12 +189,14 @@ ghcCompileOpts =
           <> metavar "BOOTSTRAP_GHC"
           <> help
                "The GHC version (or full path) to bootstrap with (must be installed)"
+          <> (completer $ versionCompleter Nothing GHC)
           )
     <*> optional
           (option
             (eitherReader (readEither @Int))
             (short 'j' <> long "jobs" <> metavar "JOBS" <> help
               "How many jobs to use for make"
+              <> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
             )
           )
     <*> optional
@@ -198,6 +204,7 @@ ghcCompileOpts =
             str
             (short 'c' <> long "config" <> metavar "CONFIG" <> help
               "Absolute path to build config file"
+             <> completer (bashCompleter "file")
             )
           )
     <*> (optional
@@ -206,6 +213,7 @@ ghcCompileOpts =
               (eitherReader uriParser)
               (long "patch" <> metavar "PATCH_URI" <> help
                 "URI to a patch (https/http/file)"
+               <> completer fileUri
               )
             )
             <|>
@@ -213,6 +221,7 @@ ghcCompileOpts =
               str
               (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
                 "Absolute path to patch directory (applies all .patch and .diff files in order using -p1. This order is determined by a quilt series file if it exists, or the patches are lexicographically ordered)"
+               <> completer (bashCompleter "directory")
               )
             )
           )
@@ -225,12 +234,7 @@ ghcCompileOpts =
             )
           )
     <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
-    <*> flag
+    <*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
-          False
-          True
-          (long "set" <> help
-            "Set as active version after install"
-          )
     <*> optional
           (option
             (eitherReader
@@ -238,6 +242,7 @@ ghcCompileOpts =
             )
             (short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
               "Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
+            <> (completer $ versionCompleter Nothing GHC)
             )
           )
     <*> optional
@@ -257,6 +262,7 @@ ghcCompileOpts =
             <> long "isolate"
             <> metavar "DIR"
             <> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
+            <> completer (bashCompleter "directory")
             )
            )
 
@@ -269,6 +275,7 @@ hlsCompileOpts =
           )
           (short 'v' <> long "version" <> metavar "VERSION" <> help
             "The tool version to compile"
+            <> (completer $ versionCompleter Nothing HLS)
           )
           ) <|>
           (Right <$> (GitBranch <$> option
@@ -276,21 +283,19 @@ hlsCompileOpts =
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
             "The git commit/branch/ref to build from"
           ) <*>
-          optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
+          optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
+            <> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
+          ))
           )))
     <*> optional
           (option
             (eitherReader (readEither @Int))
             (short 'j' <> long "jobs" <> metavar "JOBS" <> help
               "How many jobs to use for make"
+              <> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
             )
           )
-    <*> flag
+    <*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
-          False
-          True
-          (long "set" <> help
-            "Set as active version after install"
-          )
     <*> optional
           (option
             (eitherReader
@@ -298,6 +303,7 @@ hlsCompileOpts =
             )
             (short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
               "Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
+            <> (completer $ versionCompleter Nothing HLS)
             )
           )
     <*> optional
@@ -307,6 +313,7 @@ hlsCompileOpts =
             <> long "isolate"
             <> metavar "DIR"
             <> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
+            <> completer (bashCompleter "directory")
             )
            )
     <*> optional
@@ -314,6 +321,7 @@ hlsCompileOpts =
             ((fmap Right $ eitherReader uriParser) <|> (fmap Left str))
             (long "cabal-project" <> metavar "CABAL_PROJECT" <> help
               "If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme."
+              <> completer fileUri
             )
           )
     <*> optional
@@ -321,6 +329,7 @@ hlsCompileOpts =
             (eitherReader uriParser)
             (long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
               "URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
+              <> completer fileUri
             )
           )
     <*> (optional
@@ -329,6 +338,7 @@ hlsCompileOpts =
               (eitherReader uriParser)
               (long "patch" <> metavar "PATCH_URI" <> help
                 "URI to a patch (https/http/file)"
+              <> completer fileUri
               )
             )
             <|>
@@ -336,6 +346,7 @@ hlsCompileOpts =
               str
               (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
                 "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
+              <> completer (bashCompleter "directory")
               )
             )
           )

app/ghcup/GHCup/OptParse/Config.hs

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

app/ghcup/GHCup/OptParse/Install.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ViewPatterns      #-}
 
 module GHCup.OptParse.Install where
 
@@ -189,18 +190,15 @@ installOpts tool =
                     (eitherReader uriParser)
                     (short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
                       "Install the specified version from this bindist"
+                      <> completer (toolDlCompleter (fromMaybe GHC tool))
                     )
                   )
             <*> (Just <$> toolVersionArgument Nothing tool)
             )
         <|> pure (Nothing, Nothing)
         )
-    <*> flag
+    <*> fmap (fromMaybe setDefault) (invertableSwitch "set" Nothing setDefault
-          False
+      (help $ if not setDefault then "Set as active version after install" else "Don't set as active version after install"))
-          True
-          (long "set" <> help
-            "Set as active version after install"
-          )
     <*> optional
           (option
            (eitherReader isolateParser)
@@ -208,10 +206,16 @@ installOpts tool =
            <> long "isolate"
            <> metavar "DIR"
            <> help "install in an isolated dir instead of the default one"
+           <> completer (bashCompleter "directory")
            )
           )
     <*> switch
           (short 'f' <> long "force" <> help "Force install")
+ where
+  setDefault = case tool of
+    Nothing  -> False
+    Just GHC -> False
+    Just _   -> True
           
 
 
@@ -253,6 +257,48 @@ type InstallEffects = '[ AlreadyInstalled
                        , NoToolVersionSet
                        , FileAlreadyExistsError
                        , ProcessError
+
+                       , (AlreadyInstalled, ())
+                       , (UnknownArchive, ())
+                       , (ArchiveResult, ())
+                       , (FileDoesNotExistError, ())
+                       , (CopyError, ())
+                       , (NotInstalled, ())
+                       , (DirNotEmpty, ())
+                       , (NoDownload, ())
+                       , (NotInstalled, ())
+                       , (BuildFailed, ())
+                       , (TagNotFound, ())
+                       , (DigestError, ())
+                       , (GPGError, ())
+                       , (DownloadFailed, ())
+                       , (TarDirDoesNotExist, ())
+                       , (NextVerNotFound, ())
+                       , (NoToolVersionSet, ())
+                       , (FileAlreadyExistsError, ())
+                       , (ProcessError, ())
+
+                       , (AlreadyInstalled, NotInstalled)
+                       , (UnknownArchive, NotInstalled)
+                       , (ArchiveResult, NotInstalled)
+                       , (FileDoesNotExistError, NotInstalled)
+                       , (CopyError, NotInstalled)
+                       , (NotInstalled, NotInstalled)
+                       , (DirNotEmpty, NotInstalled)
+                       , (NoDownload, NotInstalled)
+                       , (NotInstalled, NotInstalled)
+                       , (BuildFailed, NotInstalled)
+                       , (TagNotFound, NotInstalled)
+                       , (DigestError, NotInstalled)
+                       , (GPGError, NotInstalled)
+                       , (DownloadFailed, NotInstalled)
+                       , (TarDirDoesNotExist, NotInstalled)
+                       , (NextVerNotFound, NotInstalled)
+                       , (NoToolVersionSet, NotInstalled)
+                       , (FileAlreadyExistsError, NotInstalled)
+                       , (ProcessError, NotInstalled)
+
+                       , ((), NotInstalled)
                        ]
 
 
@@ -352,7 +398,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                      isolateDir
                      forceInstall
                    )
-                   $ when instSet $ void $ setGHC v SetGHCOnly Nothing
+                   $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
          pure vi
        Just uri -> do
          runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
@@ -363,7 +409,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                        isolateDir
                        forceInstall
                      )
-                     $ when instSet $ void $ setGHC v SetGHCOnly Nothing
+                     $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
            pure vi
       )
         >>= \case
@@ -418,20 +464,22 @@ install installCommand settings getAppState' runLogger = case installCommand of
     s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
     (case instBindist of
        Nothing -> runInstTool s' instPlatform $ do
-         (v, vi) <- liftE $ fromVersion instVer Cabal
+         (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
-         liftE $ installCabalBin
+         void $ liftE $ sequenceE (installCabalBin
-                   (_tvVersion v)
+                                    v
-                   isolateDir
+                                    isolateDir
-                   forceInstall
+                                    forceInstall
+                                  ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
          pure vi
        Just uri -> do
          runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
-           (v, vi) <- liftE $ fromVersion instVer Cabal
+           (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
-           liftE $ installCabalBindist 
+           void $ liftE $ sequenceE (installCabalBindist
-                     (DownloadInfo uri Nothing "")
+                                      (DownloadInfo uri Nothing "")
-                     (_tvVersion v)
+                                      v
-                     isolateDir
+                                      isolateDir
-                     forceInstall
+                                      forceInstall
+                                    ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
            pure vi
       )
       >>= \case
@@ -448,6 +496,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
               runLogger $ logWarn $
                 "File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
               pure $ ExitFailure 3
+            VLeft (V (AlreadyInstalled _ v, ())) -> do
+              runLogger $ logWarn $
+                "Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
+              pure ExitSuccess
+            VLeft (V (FileAlreadyExistsError fp, ())) -> do
+              runLogger $ logWarn $
+                "File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
+              pure $ ExitFailure 3
             VLeft e -> do
               runLogger $ do
                 logError $ T.pack $ prettyShow e
@@ -459,21 +515,23 @@ install installCommand settings getAppState' runLogger = case installCommand of
      s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
      (case instBindist of
        Nothing -> runInstTool s' instPlatform $ do
-         (v, vi) <- liftE $ fromVersion instVer HLS
+         (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-         liftE $ installHLSBin
+         void $ liftE $ sequenceE (installHLSBin
-                   (_tvVersion v)
+                                    v
-                   isolateDir
+                                    isolateDir
-                   forceInstall
+                                    forceInstall
+                                  ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
          pure vi
        Just uri -> do
          runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
-           (v, vi) <- liftE $ fromVersion instVer HLS
+           (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
            -- TODO: support legacy
-           liftE $ installHLSBindist
+           void $ liftE $ sequenceE (installHLSBindist
-                     (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
+                                      (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
-                     (_tvVersion v)
+                                      v
-                     isolateDir
+                                      isolateDir
-                     forceInstall
+                                      forceInstall
+                                    ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
            pure vi
       )
       >>= \case
@@ -494,6 +552,18 @@ install installCommand settings getAppState' runLogger = case installCommand of
               runLogger $ logWarn $
                 "File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
               pure $ ExitFailure 3
+            VLeft (V (AlreadyInstalled _ v, ())) -> do
+              runLogger $ logWarn $
+                  "HLS ver "
+                <> prettyVer v
+                <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
+                <> prettyVer v
+                <> "'"
+              pure ExitSuccess
+            VLeft (V (FileAlreadyExistsError fp, ())) -> do
+              runLogger $ logWarn $
+                "File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
+              pure $ ExitFailure 3
             VLeft e -> do
               runLogger $ do
                 logError $ T.pack $ prettyShow e
@@ -505,20 +575,22 @@ install installCommand settings getAppState' runLogger = case installCommand of
      s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
      (case instBindist of
         Nothing -> runInstTool s' instPlatform $ do
-          (v, vi) <- liftE $ fromVersion instVer Stack
+          (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
-          liftE $ installStackBin
+          void $ liftE $ sequenceE (installStackBin
-                    (_tvVersion v)
+                                     v
-                    isolateDir
+                                     isolateDir
-                    forceInstall
+                                     forceInstall
+                                   ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
           pure vi
         Just uri -> do
           runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
-            (v, vi) <- liftE $ fromVersion instVer Stack
+            (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
-            liftE $ installStackBindist
+            void $ liftE $ sequenceE (installStackBindist
-                      (DownloadInfo uri Nothing "")
+                                       (DownloadInfo uri Nothing "")
-                      (_tvVersion v)
+                                       v
-                      isolateDir
+                                       isolateDir
-                      forceInstall
+                                       forceInstall
+                                     ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
             pure vi
       )
       >>= \case
@@ -535,6 +607,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
               runLogger $ logWarn $
                 "File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
               pure $ ExitFailure 3
+            VLeft (V (AlreadyInstalled _ v, ())) -> do
+              runLogger $ logWarn $
+                "Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
+              pure ExitSuccess
+            VLeft (V (FileAlreadyExistsError fp, ())) -> do
+              runLogger $ logWarn $
+                "File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
+              pure $ ExitFailure 3
             VLeft e -> do
               runLogger $ do
                 logError $ T.pack $ prettyShow e

app/ghcup/GHCup/OptParse/List.hs

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

app/ghcup/GHCup/OptParse/Prefetch.hs

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

app/ghcup/GHCup/OptParse/Run.hs

@@ -15,7 +15,7 @@ import           GHCup.Utils.File
 import           GHCup.OptParse.Common
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Types.Optics             ( getDirs )
+import           GHCup.Types.Optics
 import           GHCup.Utils.Logger
 import           GHCup.Utils.String.QQ
 
@@ -35,7 +35,6 @@ import           Prelude                 hiding ( appendFile )
 import           System.Directory
 import           System.FilePath
 import           System.Environment
-import           System.IO.Temp
 import           System.Exit
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
@@ -72,6 +71,7 @@ data RunOptions = RunOptions
     ---------------
 
           
+    
 runOpts :: Parser RunOptions
 runOpts =
   RunOptions
@@ -82,22 +82,34 @@ runOpts =
     <*> optional
           (option
             (eitherReader toolVersionEither)
-            (metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version")
+            (metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
+            <> completer (tagCompleter GHC [])
+            <> (completer $ versionCompleter Nothing GHC)
+            )
           )
     <*> optional
           (option
             (eitherReader toolVersionEither)
-            (metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version")
+            (metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
+            <> completer (tagCompleter Cabal [])
+            <> (completer $ versionCompleter Nothing Cabal)
+            )
           )
     <*> optional
           (option
             (eitherReader toolVersionEither)
-            (metavar "HLS_VERSION" <> long "hls" <> help "The HLS version")
+            (metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
+            <> completer (tagCompleter HLS [])
+            <> (completer $ versionCompleter Nothing HLS)
+            )
           )
     <*> optional
           (option
             (eitherReader toolVersionEither)
-            (metavar "STACK_VERSION" <> long "stack" <> help "The stack version")
+            (metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
+            <> completer (tagCompleter Stack [])
+            <> (completer $ versionCompleter Nothing Stack)
+            )
           )
     <*> optional
           (option
@@ -106,6 +118,7 @@ runOpts =
            <> long "bindir"
            <> metavar "DIR"
            <> help "directory where to create the tool symlinks (default: newly created system temp dir)"
+           <> completer (bashCompleter "directory")
            )
           )
     <*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
@@ -174,14 +187,16 @@ runLeanRUN leanAppstate =
       @RunEffects
 
 runRUN :: MonadUnliftIO m
-      => (ReaderT AppState m (VEither RunEffects a) -> m (VEither RunEffects a))
+      => IO AppState
       -> Excepts RunEffects (ResourceT (ReaderT AppState m)) a
       -> m (VEither RunEffects a)
-runRUN runAppState =
+runRUN appState action' = do
-  runAppState
+  s' <- liftIO appState
+  flip runReaderT s'
     . runResourceT
     . runE
       @RunEffects
+    $ action'
 
 
 
@@ -199,110 +214,182 @@ run :: forall m.
        , MonadUnliftIO m
        )
    => RunOptions
-   -> (forall a. ReaderT AppState m (VEither RunEffects a) -> m (VEither RunEffects a))
+   -> IO AppState
    -> LeanAppState
    -> (ReaderT LeanAppState m () -> m ())
    -> m ExitCode
 run RunOptions{..} runAppState leanAppstate runLogger = do
-   tmp <- case runBinDir of
+   r <- if or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool'
-     Just bdir -> do
+        then runRUN runAppState $ do
-       liftIO $ createDirRecursive' bdir
+         toolchain <- liftE resolveToolchainFull
-       liftIO $ canonicalizePath bdir
+         tmp <- case runBinDir of
-     Nothing -> liftIO (getTemporaryDirectory >>= \tmp -> createTempDirectory tmp "ghcup")
+           Just bindir -> do
-   r <- do
+             liftIO $ createDirRecursive' bindir
-     addToolsToDir tmp
+             liftIO $ canonicalizePath bindir
+           Nothing -> do
+             d <- liftIO $ predictableTmpDir toolchain
+             liftIO $ createDirRecursive' d
+             liftIO $ canonicalizePath d
+         liftE $ installToolChainFull toolchain tmp
+         pure tmp
+        else runLeanRUN leanAppstate $ do
+         toolchain <- resolveToolchain
+         tmp <- case runBinDir of
+           Just bindir -> do
+             liftIO $ createDirRecursive' bindir
+             liftIO $ canonicalizePath bindir
+           Nothing -> do
+             d <- liftIO $ predictableTmpDir toolchain
+             liftIO $ createDirRecursive' d
+             liftIO $ canonicalizePath d
+         liftE $ installToolChain toolchain tmp
+         pure tmp
    case r of
-     VRight _ -> do
+         VRight tmp -> do
-       case runCOMMAND of
+           case runCOMMAND of
-         [] -> do
+             [] -> do
-           liftIO $ putStr tmp
+               liftIO $ putStr tmp
-           pure ExitSuccess
+               pure ExitSuccess
-         (cmd:args) -> do
+             (cmd:args) -> do
-           newEnv <- liftIO $ addToPath tmp
+               newEnv <- liftIO $ addToPath tmp
 #ifndef IS_WINDOWS
-           void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
+               void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
-           pure ExitSuccess
+               pure ExitSuccess
 #else
-           r' <- runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
+               r' <- runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
-           case r' of
+               case r' of
-             VRight _ -> pure ExitSuccess
+                 VRight _ -> pure ExitSuccess
-             VLeft e -> do
+                 VLeft e -> do
-               runLogger $ logError $ T.pack $ prettyShow e
+                   runLogger $ logError $ T.pack $ prettyShow e
-               pure $ ExitFailure 28
+                   pure $ ExitFailure 28
 #endif
-     VLeft e -> do
+         VLeft e -> do
-       runLogger $ logError $ T.pack $ prettyShow e
+           runLogger $ logError $ T.pack $ prettyShow e
-       pure $ ExitFailure 27
+           pure $ ExitFailure 27
+
   where
+
    isToolTag :: ToolVersion -> Bool
    isToolTag (ToolTag _) = True
    isToolTag _           = False
 
    -- TODO: doesn't work for cross
-   addToolsToDir tmp
+   resolveToolchainFull :: ( MonadFail m
-     | or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
+                           , MonadThrow m
-         forM_ runGHCVer $ \ver -> do
+                           , MonadIO m
+                           , MonadCatch m
+                           )
+                        => Excepts
+                             '[ TagNotFound
+                              , NextVerNotFound
+                              , NoToolVersionSet
+                              ] (ResourceT (ReaderT AppState m)) Toolchain
+   resolveToolchainFull = do
+         ghcVer <- forM runGHCVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) GHC
-           installTool GHC v
+           pure v
-           setTool GHC v tmp
+         cabalVer <- forM runCabalVer $ \ver -> do
-         forM_ runCabalVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) Cabal
-           installTool Cabal v
+           pure v
-           setTool Cabal v tmp
+         hlsVer <- forM runHLSVer $ \ver -> do
-         forM_ runHLSVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) HLS
-           installTool HLS v
+           pure v
-           setTool HLS v tmp
+         stackVer <- forM runStackVer $ \ver -> do
-         forM_ runStackVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) Stack
-           installTool Stack v
+           pure v
-           setTool Stack v tmp
+         pure Toolchain{..}
-     | otherwise = runLeanRUN leanAppstate $ do
-         case runGHCVer of
-            Just (ToolVersion v) ->
-              setTool GHC v tmp
-            Nothing -> pure ()
-            _ -> fail "Internal error"
-         case runCabalVer of
-            Just (ToolVersion v) ->
-              setTool Cabal v tmp
-            Nothing -> pure ()
-            _ -> fail "Internal error"
-         case runHLSVer of
-            Just (ToolVersion v) ->
-              setTool HLS v tmp
-            Nothing -> pure ()
-            _ -> fail "Internal error"
-         case runStackVer of
-            Just (ToolVersion v) ->
-              setTool Stack v tmp
-            Nothing -> pure ()
-            _ -> fail "Internal error"
 
-   installTool tool v = do
+   resolveToolchain = do
-      isInstalled <- checkIfToolInstalled' tool v
+         ghcVer <- case runGHCVer of
-      case tool of
+            Just (ToolVersion v) -> pure $ Just v
-        GHC -> do
+            Nothing -> pure Nothing
-          unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
+            _ -> fail "Internal error"
-            (_tvVersion v)
+         cabalVer <- case runCabalVer of
-            Nothing
+            Just (ToolVersion v) -> pure $ Just v
-            False
+            Nothing -> pure Nothing
-        Cabal -> do
+            _ -> fail "Internal error"
-          unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
+         hlsVer <- case runHLSVer of
-            (_tvVersion v)
+            Just (ToolVersion v) -> pure $ Just v
-            Nothing
+            Nothing -> pure Nothing
-            False
+            _ -> fail "Internal error"
-        Stack -> do
+         stackVer <- case runStackVer of
-          unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
+            Just (ToolVersion v) -> pure $ Just v
-            (_tvVersion v)
+            Nothing -> pure Nothing
-            Nothing
+            _ -> fail "Internal error"
-            False
+         pure Toolchain{..}
-        HLS -> do
+
-          unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
+   installToolChainFull :: ( MonadFail m
-            (_tvVersion v)
+                           , MonadThrow m
-            Nothing
+                           , MonadIO m
-            False
+                           , MonadCatch m
-        GHCup -> pure ()
+                           )
+                        => Toolchain
+                        -> FilePath
+                        -> Excepts
+                             '[ TagNotFound
+                              , NextVerNotFound
+                              , NoToolVersionSet
+                              , UnknownArchive
+                              , TarDirDoesNotExist
+                              , ProcessError
+                              , NotInstalled
+                              , NoDownload
+                              , GPGError
+                              , DownloadFailed
+                              , DirNotEmpty
+                              , DigestError
+                              , BuildFailed
+                              , ArchiveResult
+                              , AlreadyInstalled
+                              , FileAlreadyExistsError
+                              , CopyError
+                              ] (ResourceT (ReaderT AppState m)) ()
+   installToolChainFull Toolchain{..} tmp = do
+         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
+           isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt
+           case mt of
+             Just (GHC, v) -> do
+               unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
+                 (_tvVersion v)
+                 Nothing
+                 False
+               setTool GHC v tmp
+             Just (Cabal, v) -> do
+               unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
+                 (_tvVersion v)
+                 Nothing
+                 False
+               setTool Cabal v tmp
+             Just (Stack, v) -> do
+               unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
+                 (_tvVersion v)
+                 Nothing
+                 False
+               setTool Stack v tmp
+             Just (HLS, v) -> do
+               unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
+                 (_tvVersion v)
+                 Nothing
+                 False
+               setTool HLS v tmp
+             _ -> pure ()
+
+   installToolChain :: ( MonadFail m
+                       , MonadThrow m
+                       , MonadIO m
+                       , MonadCatch m
+                       )
+                    => Toolchain
+                    -> FilePath
+                    -> Excepts '[NotInstalled] (ReaderT LeanAppState m) ()
+   installToolChain Toolchain{..} tmp = do
+         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
+           case mt of
+             Just (GHC, v)   -> setTool GHC v tmp
+             Just (Cabal, v) -> setTool Cabal v tmp
+             Just (Stack, v) -> setTool Stack v tmp
+             Just (HLS, v)   -> setTool HLS v tmp
+             _ -> pure ()
 
    setTool tool v tmp =
       case tool of
@@ -324,7 +411,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
           if legacy
           then do
             -- TODO: factor this out
-            (Just hlsWrapper) <- hlsWrapperBinary v'
+            hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v' !? (NotInstalled HLS (mkTVer v'))
             cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)
             lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)
             hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
@@ -346,3 +433,31 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
         envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
     liftIO $ setEnv pathVar newPath
     return envWithNewPath
+
+   predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) =
+     liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none"))
+   predictableTmpDir Toolchain{..} = do
+      tmp <- getTemporaryDirectory
+      pure $ tmp
+        </> ("ghcup-" <> intercalate "_"
+              (  maybe [] ( (:[]) . ("ghc-"   <>) . T.unpack . tVerToText) ghcVer
+              <> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . tVerToText) cabalVer
+              <> maybe [] ( (:[]) . ("hls-"   <>) . T.unpack . tVerToText) hlsVer
+              <> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . tVerToText) stackVer
+              )
+            )
+
+
+
+    -------------------------
+    --[ Other local types ]--
+    -------------------------
+
+
+
+data Toolchain = Toolchain
+  { ghcVer     :: Maybe GHCTargetVersion
+  , cabalVer   :: Maybe GHCTargetVersion
+  , hlsVer     :: Maybe GHCTargetVersion
+  , stackVer   :: Maybe GHCTargetVersion
+  }

app/ghcup/GHCup/OptParse/ToolRequirements.hs

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

app/ghcup/GHCup/OptParse/Upgrade.hs

@@ -72,6 +72,7 @@ upgradeOptsP =
               str
               (short 't' <> long "target" <> metavar "TARGET_DIR" <> help
                 "Absolute filepath to write ghcup into"
+                <> completer (bashCompleter "file")
               )
         )
     <|> pure UpgradeGHCupDir

app/ghcup/Main.hs

@@ -82,7 +82,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 optUrlSource
+         urlSource   = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) (OwnSource . (:[]) . Right) optUrlSource
          noNetwork   = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
          gpgSetting  = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
      in (Settings {..}, keyBindings)
@@ -228,14 +228,16 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   Nuke -> pure ()
                   Whereis _ _ -> pure ()
                   DInfo -> pure ()
-                  ToolRequirements -> pure ()
+                  ToolRequirements _ -> pure ()
                   ChangeLog _ -> pure ()
                   UnSet _ -> pure ()
 #if defined(BRICK)
                   Interactive -> pure ()
 #endif
                   -- check for new tools
-                  _ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
+                  _
+                    | Just False <- optVerbose -> pure ()
+                    | otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
                          Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
                            newTools <- lift checkForUpdates 
                            forM_ newTools $ \newTool@(t, l) -> do
@@ -308,12 +310,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 #ifndef DISABLE_UPGRADE
             Upgrade uOpts force'     -> upgrade uOpts force' dirs runAppState runLogger
 #endif
-            ToolRequirements         -> toolRequirements runAppState runLogger
+            ToolRequirements topts   -> toolRequirements topts runAppState runLogger
             ChangeLog changelogOpts  -> changelog changelogOpts runAppState runLogger
             Nuke                     -> nuke appState runLogger
             Prefetch pfCom           -> prefetch pfCom runAppState runLogger
             GC gcOpts                -> gc gcOpts runAppState runLogger
-            Run runCommand           -> run runCommand runAppState leanAppstate runLogger
+            Run runCommand           -> run runCommand appState leanAppstate runLogger
 
           case res of
             ExitSuccess        -> pure ()

cabal.ghc8107.project.freeze

@@ -10,8 +10,8 @@ constraints: any.Cabal ==3.6.2.0,
              any.StateVar ==1.2.2,
              any.abstract-deque ==0.3,
              abstract-deque -usecas,
-             any.aeson ==2.0.2.0,
+             any.aeson ==2.0.3.0,
-             aeson -bytestring-builder -cffi +ordered-keymap,
+             aeson -cffi +ordered-keymap,
              any.aeson-pretty ==0.8.9,
              aeson-pretty +lib-only,
              any.alex ==3.2.7.1,
@@ -25,14 +25,14 @@ constraints: any.Cabal ==3.6.2.0,
              async -bench,
              any.atomic-primops ==0.8.4,
              atomic-primops -debug,
-             any.attoparsec ==0.13.2.5,
+             any.attoparsec ==0.14.4,
              attoparsec -developer,
              any.base ==4.14.3.0,
              any.base-compat ==0.12.1,
              any.base-compat-batteries ==0.12.1,
              any.base-orphans ==0.8.6,
              any.base16-bytestring ==1.0.2.0,
-             any.base64-bytestring ==1.1.0.0,
+             any.base64-bytestring ==1.2.1.0,
              any.bifunctors ==5.5.11,
              bifunctors +semigroups +tagged,
              any.binary ==0.8.8.0,
@@ -69,7 +69,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.cryptohash-sha1 ==0.11.101.0,
              any.cryptohash-sha256 ==0.11.102.1,
              cryptohash-sha256 -exe +use-cbits,
-             any.data-clist ==0.1.2.3,
+             any.data-clist ==0.2,
              any.data-fix ==0.3.2,
              any.deepseq ==1.4.4.0,
              any.directory ==1.3.6.0,
@@ -82,10 +82,14 @@ constraints: any.Cabal ==3.6.2.0,
              any.filepath ==1.4.2.1,
              any.free ==5.1.7,
              any.fusion-plugin-types ==0.1.0,
-             any.generic-arbitrary ==0.1.0,
+             any.generic-arbitrary ==0.2.0,
+             any.ghc ==8.10.7,
+             any.ghc-boot ==8.10.7,
              any.ghc-boot-th ==8.10.7,
              any.ghc-byteorder ==4.11.0.0.10,
+             any.ghc-heap ==8.10.7,
              any.ghc-prim ==0.6.1,
+             any.ghci ==8.10.7,
              any.happy ==1.20.0,
              any.hashable ==1.4.0.2,
              hashable +containers +integer-gmp -random-initial-seed,
@@ -93,11 +97,12 @@ constraints: any.Cabal ==3.6.2.0,
              any.haskus-utils-types ==1.5.1,
              any.haskus-utils-variant ==3.2.1,
              any.heaps ==0.4,
+             any.hpc ==0.6.1.0,
              any.hsc2hs ==0.68.8,
              hsc2hs -in-ghc-tree,
-             any.hspec ==2.7.10,
+             any.hspec ==2.9.4,
-             any.hspec-core ==2.7.10,
+             any.hspec-core ==2.9.4,
-             any.hspec-discover ==2.7.10,
+             any.hspec-discover ==2.9.4,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
              any.http-io-streams ==0.1.6.0,
@@ -118,7 +123,7 @@ constraints: any.Cabal ==3.6.2.0,
              libyaml-streamly -no-unicode -system-libyaml,
              any.lockfree-queue ==0.2.3.1,
              any.lzma-static ==5.2.5.4,
-             any.megaparsec ==9.0.1,
+             any.megaparsec ==9.2.0,
              megaparsec -dev,
              any.microlens ==0.4.12.0,
              any.microlens-mtl ==0.2.0.1,
@@ -134,7 +139,7 @@ constraints: any.Cabal ==3.6.2.0,
              optics-core -explicit-generic-labels,
              any.optics-extra ==0.4,
              any.optics-th ==0.4,
-             any.optparse-applicative ==0.16.1.0,
+             any.optparse-applicative ==0.17.0.0,
              optparse-applicative +process,
              any.os-release ==1.0.2.1,
              os-release -devel,
@@ -173,13 +178,14 @@ constraints: any.Cabal ==3.6.2.0,
              any.splitmix ==0.1.0.4,
              splitmix -optimised-mixer,
              any.stm ==2.5.0.1,
-             any.streamly ==0.8.1.1,
+             any.streamly ==0.8.2,
-             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -use-c-malloc,
+             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc -use-unliftio,
              any.strict ==0.4.0.1,
              strict +assoc,
              any.strict-base ==0.4.0.0,
              any.tagged ==0.8.6.1,
              tagged +deepseq +transformers,
+             any.tagsoup ==0.14.8,
              any.template-haskell ==2.16.0.0,
              any.temporary ==1.3,
              any.terminal-progress-bar ==0.4.1,
@@ -211,7 +217,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.unix-compat ==0.5.4,
              unix-compat -old-time,
              any.unliftio-core ==0.2.0.1,
-             any.unordered-containers ==0.2.16.0,
+             any.unordered-containers ==0.2.17.0,
              unordered-containers -debug,
              any.uri-bytestring ==0.3.3.1,
              uri-bytestring -lib-werror,
@@ -219,15 +225,15 @@ constraints: any.Cabal ==3.6.2.0,
              any.uuid-types ==1.0.5,
              any.vector ==0.12.3.1,
              vector +boundschecks -internalchecks -unsafechecks -wall,
-             any.versions ==5.0.2,
+             any.versions ==5.0.3,
              any.vty ==5.33,
              any.witherable ==0.4.2,
              any.word-wrap ==0.5,
              any.word8 ==0.1.3,
-             any.xor ==0.0.1.0,
+             any.xor ==0.0.1.1,
              any.yaml-streamly ==0.12.1,
              yaml-streamly +no-examples +no-exe,
              any.zlib ==0.6.2.3,
              zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
              any.zlib-bindings ==0.1.1.5
-index-state: hackage.haskell.org 2022-02-15T12:16:42Z
+index-state: hackage.haskell.org 2022-03-15T16:43:02Z

cabal.ghc902.project.freeze

@@ -10,8 +10,8 @@ constraints: any.Cabal ==3.6.2.0,
              any.StateVar ==1.2.2,
              any.abstract-deque ==0.3,
              abstract-deque -usecas,
-             any.aeson ==2.0.2.0,
+             any.aeson ==2.0.3.0,
-             aeson -bytestring-builder -cffi +ordered-keymap,
+             aeson -cffi +ordered-keymap,
              any.aeson-pretty ==0.8.9,
              aeson-pretty +lib-only,
              any.alex ==3.2.7.1,
@@ -25,14 +25,14 @@ constraints: any.Cabal ==3.6.2.0,
              async -bench,
              any.atomic-primops ==0.8.4,
              atomic-primops -debug,
-             any.attoparsec ==0.13.2.5,
+             any.attoparsec ==0.14.4,
              attoparsec -developer,
              any.base ==4.15.1.0,
              any.base-compat ==0.12.1,
              any.base-compat-batteries ==0.12.1,
              any.base-orphans ==0.8.6,
              any.base16-bytestring ==1.0.2.0,
-             any.base64-bytestring ==1.1.0.0,
+             any.base64-bytestring ==1.2.1.0,
              any.bifunctors ==5.5.11,
              bifunctors +semigroups +tagged,
              any.binary ==0.8.8.0,
@@ -69,7 +69,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.cryptohash-sha1 ==0.11.101.0,
              any.cryptohash-sha256 ==0.11.102.1,
              cryptohash-sha256 -exe +use-cbits,
-             any.data-clist ==0.1.2.3,
+             any.data-clist ==0.2,
              any.data-fix ==0.3.2,
              any.deepseq ==1.4.5.0,
              any.directory ==1.3.6.2,
@@ -82,11 +82,15 @@ constraints: any.Cabal ==3.6.2.0,
              any.filepath ==1.4.2.1,
              any.free ==5.1.7,
              any.fusion-plugin-types ==0.1.0,
-             any.generic-arbitrary ==0.1.0,
+             any.generic-arbitrary ==0.2.0,
+             any.ghc ==9.0.2,
              any.ghc-bignum ==1.1,
+             any.ghc-boot ==9.0.2,
              any.ghc-boot-th ==9.0.2,
              any.ghc-byteorder ==4.11.0.0.10,
+             any.ghc-heap ==9.0.2,
              any.ghc-prim ==0.7.0,
+             any.ghci ==9.0.2,
              any.happy ==1.20.0,
              any.hashable ==1.4.0.2,
              hashable +containers +integer-gmp -random-initial-seed,
@@ -94,11 +98,12 @@ constraints: any.Cabal ==3.6.2.0,
              any.haskus-utils-types ==1.5.1,
              any.haskus-utils-variant ==3.2.1,
              any.heaps ==0.4,
+             any.hpc ==0.6.1.0,
              any.hsc2hs ==0.68.8,
              hsc2hs -in-ghc-tree,
-             any.hspec ==2.7.10,
+             any.hspec ==2.9.4,
-             any.hspec-core ==2.7.10,
+             any.hspec-core ==2.9.4,
-             any.hspec-discover ==2.7.10,
+             any.hspec-discover ==2.9.4,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
              any.http-io-streams ==0.1.6.0,
@@ -118,7 +123,7 @@ constraints: any.Cabal ==3.6.2.0,
              libyaml-streamly -no-unicode -system-libyaml,
              any.lockfree-queue ==0.2.3.1,
              any.lzma-static ==5.2.5.4,
-             any.megaparsec ==9.0.1,
+             any.megaparsec ==9.2.0,
              megaparsec -dev,
              any.microlens ==0.4.12.0,
              any.microlens-mtl ==0.2.0.1,
@@ -134,7 +139,7 @@ constraints: any.Cabal ==3.6.2.0,
              optics-core -explicit-generic-labels,
              any.optics-extra ==0.4,
              any.optics-th ==0.4,
-             any.optparse-applicative ==0.16.1.0,
+             any.optparse-applicative ==0.17.0.0,
              optparse-applicative +process,
              any.os-release ==1.0.2.1,
              os-release -devel,
@@ -173,13 +178,14 @@ constraints: any.Cabal ==3.6.2.0,
              any.splitmix ==0.1.0.4,
              splitmix -optimised-mixer,
              any.stm ==2.5.0.0,
-             any.streamly ==0.8.1.1,
+             any.streamly ==0.8.2,
-             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -use-c-malloc,
+             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc -use-unliftio,
              any.strict ==0.4.0.1,
              strict +assoc,
              any.strict-base ==0.4.0.0,
              any.tagged ==0.8.6.1,
              tagged +deepseq +transformers,
+             any.tagsoup ==0.14.8,
              any.template-haskell ==2.17.0.0,
              any.temporary ==1.3,
              any.terminal-progress-bar ==0.4.1,
@@ -211,7 +217,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.unix-compat ==0.5.4,
              unix-compat -old-time,
              any.unliftio-core ==0.2.0.1,
-             any.unordered-containers ==0.2.16.0,
+             any.unordered-containers ==0.2.17.0,
              unordered-containers -debug,
              any.uri-bytestring ==0.3.3.1,
              uri-bytestring -lib-werror,
@@ -219,15 +225,15 @@ constraints: any.Cabal ==3.6.2.0,
              any.uuid-types ==1.0.5,
              any.vector ==0.12.3.1,
              vector +boundschecks -internalchecks -unsafechecks -wall,
-             any.versions ==5.0.2,
+             any.versions ==5.0.3,
              any.vty ==5.33,
              any.witherable ==0.4.2,
              any.word-wrap ==0.5,
              any.word8 ==0.1.3,
-             any.xor ==0.0.1.0,
+             any.xor ==0.0.1.1,
              any.yaml-streamly ==0.12.1,
              yaml-streamly +no-examples +no-exe,
              any.zlib ==0.6.2.3,
              zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
              any.zlib-bindings ==0.1.1.5
-index-state: hackage.haskell.org 2022-02-15T12:16:42Z
+index-state: hackage.haskell.org 2022-03-15T16:43:02Z

data/config.yaml

@@ -48,12 +48,16 @@ url-source:
 
   ## Example 1: Read download info from this location instead
   ## Accepts file/http/https scheme
+  ## Can also be an array of URLs or an array of 'Either GHCupInfo URL', in
+  ## which case they are merged right-biased (overwriting duplicate versions).
   # OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
 
-  ## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions
+  ## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions.
+  ## Can also be an array of 'Either GHCupInfo URL', also see Example 3.
   # AddSource:
     # Left:
-      # toolRequirements: {} # this is ignored
+      # globalTools: {}
+      # toolRequirements: {}
       # ghcupDownloads:
         # GHC:
           # 9.10.2:
@@ -66,6 +70,8 @@ url-source:
                     # dlSubdir: ghc-7.10.3
                     # dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
 
-  ## Example 3: Add a custom download file to the default downloads, overwriting duplicate versions
+  ## Example 3: Add multiple custom download files to the default downloads via right-biased merge (overwriting duplicate
+  ## versions).
   # AddSource:
-    # Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
+    # - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
+    # - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"

docs/css/extra.css

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

docs/install.md

@@ -50,10 +50,90 @@ On windows, double-click on the `Uninstall Haskell.ps1` PowerShell script on you
 
 GHCup supports the following tools, which are also known as the **Haskell Toolchain**:
 
-1. [GHC](https://www.haskell.org/ghc/)
+<details>
-2. [cabal-install](https://cabal.readthedocs.io/en/stable/)
+  <summary>Show all supported <a href='https://www.haskell.org/ghc/'>GHC</a> versions</summary>
-3. [haskell-language-server](https://haskell-language-server.readthedocs.io/en/stable/)
+  
-4. [stack](https://docs.haskellstack.org/en/stable/README/)
+<table>
+<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
+<tbody>
+<tr><td>7.10.3</td><td>base-4.8.2.0</td></tr>
+<tr><td>8.0.2</td><td>base-4.9.1.0</td></tr>
+<tr><td>8.2.2</td><td>base-4.10.1.0</td></tr>
+<tr><td>8.4.1</td><td>base-4.11.0.0</td></tr>
+<tr><td>8.4.2</td><td>base-4.11.1.0</td></tr>
+<tr><td>8.4.3</td><td>base-4.11.1.0</td></tr>
+<tr><td>8.4.4</td><td>base-4.11.1.0</td></tr>
+<tr><td>8.6.1</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.6.2</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.6.3</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.6.4</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.6.5</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.8.1</td><td>base-4.13.0.0</td></tr>
+<tr><td>8.8.2</td><td>base-4.13.0.0</td></tr>
+<tr><td>8.8.3</td><td>base-4.13.0.0</td></tr>
+<tr><td>8.8.4</td><td>base-4.13.0.0</td></tr>
+<tr><td>8.10.1</td><td>base-4.14.0.0</td></tr>
+<tr><td>8.10.2</td><td>base-4.14.1.0</td></tr>
+<tr><td>8.10.3</td><td>base-4.14.1.0</td></tr>
+<tr><td>8.10.4</td><td>base-4.14.1.0</td></tr>
+<tr><td>8.10.5</td><td>base-4.14.2.0</td></tr>
+<tr><td>8.10.6</td><td>base-4.14.3.0</td></tr>
+<tr><td>8.10.7</td><td><span style="color:green">recommended</span>, base-4.14.3.0</td></tr>
+<tr><td>9.0.1</td><td>base-4.15.0.0</td></tr>
+<tr><td>9.0.2</td><td>base-4.15.1.0</td></tr>
+<tr><td>9.2.1</td><td>base-4.16.0.0</td></tr>
+<tr><td>9.2.2</td><td><span style="color:blue">latest</span>, base-4.16.1.0</td></tr>
+</tbody>
+</table>
+
+</details>
+
+<details>
+  <summary>Show all supported <a href='https://cabal.readthedocs.io/en/stable/'>cabal-install</a> versions</summary>
+  <table>
+<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
+<tbody>
+<tr><td>2.4.1.0</td><td></td></tr>
+<tr><td>3.0.0.0</td><td></td></tr>
+<tr><td>3.2.0.0</td><td></td></tr>
+<tr><td>3.4.0.0</td><td></td></tr>
+<tr><td>3.4.1.0</td><td></td></tr>
+<tr><td>3.6.0.0</td><td></td></tr>
+<tr><td>3.6.2.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+</tbody>
+</table>
+
+</details>
+
+<details>
+  <summary>Show all supported <a href='https://haskell-language-server.readthedocs.io/en/stable/'>HLS</a> versions</summary>
+<table>
+<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
+<tbody>
+<tr><td>1.1.0</td><td></td></tr>
+<tr><td>1.2.0</td><td></td></tr>
+<tr><td>1.3.0</td><td></td></tr>
+<tr><td>1.4.0</td><td></td></tr>
+<tr><td>1.5.0</td><td></td></tr>
+<tr><td>1.5.1</td><td></td></tr>
+<tr><td>1.6.0.0</td><td></td></tr>
+<tr><td>1.6.1.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+</tbody>
+</table>
+</details>
+
+<details>
+  <summary>Show all supported <a href='https://docs.haskellstack.org/en/stable/README/'>Stack</a> versions</summary>
+<table>
+<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
+<tbody>
+<tr><td>2.5.1</td><td></td></tr>
+<tr><td>2.7.1</td><td></td></tr>
+<tr><td>2.7.3</td><td></td></tr>
+<tr><td>2.7.5</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+</tbody>
+</table>
+</details>
 
 ## Supported platforms
 

ghcup.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               ghcup
-version:            0.1.17.5
+version:            0.1.17.6
 license:            LGPL-3.0-only
 license-file:       LICENSE
 copyright:          Julian Ospald 2020
@@ -121,7 +121,7 @@ library
     , haskus-utils-variant  ^>=3.2.1
     , libarchive            ^>=3.0.3.0
     , lzma-static           ^>=5.2.5.3
-    , megaparsec            >=8.0.0      && <9.1
+    , megaparsec            >=8.0.0      && <9.3
     , mtl                   ^>=2.2
     , optics                ^>=0.4
     , os-release            ^>=1.0.0
@@ -236,19 +236,23 @@ executable ghcup
     , ghcup
     , haskus-utils-variant  ^>=3.2.1
     , libarchive            ^>=3.0.3.0
-    , megaparsec            >=8.0.0    && <9.1
+    , megaparsec            >=8.0.0    && <9.3
     , mtl                   ^>=2.2
-    , optparse-applicative  >=0.15.1.0 && <0.17
+    , optparse-applicative  >=0.15.1.0 && <0.18
     , pretty                ^>=1.1.3.1
     , pretty-terminal       ^>=0.1.0.0
+    , process               ^>=1.6.11.0
     , resourcet             ^>=1.2.2
     , safe                  ^>=0.3.18
     , safe-exceptions       ^>=0.1
-    , temporary             ^>=1.3
+    , tagsoup               ^>=0.14
     , template-haskell      >=2.7      && <2.18
+    , temporary             ^>=1.3
     , text                  ^>=1.2.4.0
+    , unordered-containers  ^>=0.2
     , uri-bytestring        ^>=0.3.2.2
     , utf8-string           ^>=1.0
+    , vector                ^>=0.12
     , versions              >=4.0.1    && <5.1
     , yaml-streamly         ^>=0.12.0
 
@@ -262,23 +266,22 @@ executable ghcup
       , brick         ^>=0.64
       , transformers  ^>=0.5
       , unix          ^>=2.7
-      , vector        ^>=0.12
       , vty           >=5.28.2 && <5.34
 
   if os(windows)
     cpp-options: -DIS_WINDOWS
+
   else
-    build-depends:
+    build-depends: unix ^>=2.7
-      , unix             ^>=2.7
 
   if flag(no-exe)
     buildable: False
 
-  if (flag(disable-upgrade))
+  if flag(disable-upgrade)
-    cpp-options:   -DDISABLE_UPGRADE
+    cpp-options: -DDISABLE_UPGRADE
+
   else
-    other-modules:
+    other-modules: GHCup.OptParse.Upgrade
-        GHCup.OptParse.Upgrade
 
 test-suite ghcup-test
   type:               exitcode-stdio-1.0
@@ -307,9 +310,9 @@ test-suite ghcup-test
     , base                      >=4.12    && <5
     , bytestring                ^>=0.10
     , containers                ^>=0.6
-    , generic-arbitrary         ^>=0.1.0
+    , generic-arbitrary         >=0.1.0   && <0.3
     , ghcup
-    , hspec                     ^>=2.7.10
+    , hspec                     >=2.7.10  && <2.10
     , hspec-golden-aeson        ^>=0.9
     , QuickCheck                ^>=2.14.1
     , quickcheck-arbitrary-adt  ^>=0.3.1.0

lib/GHCup.hs

@@ -468,10 +468,6 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do
     Nothing -> do                 -- regular install
       liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall
 
-      -- create symlink if this is the latest version for regular installs
-      cVers <- lift $ fmap rights getInstalledCabals
-      let lInstCabal = headMay . reverse . sort $ cVers
-      when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
       
 -- | Install an unpacked cabal distribution.Symbol
 installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
@@ -626,7 +622,6 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
         liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir inst ver
         liftE $ setHLS ver SetHLS_XYZ Nothing
 
-  liftE $ installHLSPostInst isoFilepath ver
 
 isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
                    -> IO Bool
@@ -696,19 +691,6 @@ installHLSUnpackedLegacy path inst mver' forceInstall = do
   lift $ chmod_755 destWrapperPath
 
 
-installHLSPostInst :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m, MonadCatch m, MonadMask m, MonadFail m, MonadUnliftIO m)
-                   => Maybe FilePath
-                   -> Version
-                   -> Excepts '[NotInstalled] m ()
-installHLSPostInst isoFilepath ver = 
-  case isoFilepath of
-    Just _ -> pure ()
-    Nothing -> do
-      -- create symlink if this is the latest version in a regular install
-      hlsVers <- lift $ fmap rights getInstalledHLSs
-      let lInstHLS = headMay . reverse . sort $ hlsVers
-      when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver SetHLSOnly Nothing
-
 
 -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
 -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
@@ -916,8 +898,6 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
           liftE $ installHLSUnpackedLegacy installDir binDir (Just installVer) True
     )
 
-  liftE $ installHLSPostInst isolateDir installVer
-
   pure installVer
 
 
@@ -1034,11 +1014,6 @@ installStackBindist dlinfo ver isoFilepath forceInstall = do
     Nothing -> do                     -- regular install
       liftE $ installStackUnpacked workdir binDir (Just ver) forceInstall
 
-      -- create symlink if this is the latest version and a regular install
-      sVers <- lift $ fmap rights getInstalledStacks
-      let lInstStack = headMay . reverse . sort $ sVers
-      when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
-
 
 -- | Install an unpacked stack distribution.
 installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)

lib/GHCup/Download.hs

@@ -121,28 +121,25 @@ getDownloadsF = do
   Settings { urlSource } <- lift getSettings
   case urlSource of
     GHCupURL -> liftE $ getBase ghcupURL
-    (OwnSource url) -> liftE $ getBase url
+    (OwnSource exts) -> do
+      ext  <- liftE $ mapM (either pure getBase) exts
+      mergeGhcupInfo ext
     (OwnSpec av) -> pure av
-    (AddSource (Left ext)) -> do
+    (AddSource exts) -> do
       base <- liftE $ getBase ghcupURL
-      pure (mergeGhcupInfo base ext)
+      ext  <- liftE $ mapM (either pure getBase) exts
-    (AddSource (Right uri)) -> do
+      mergeGhcupInfo (base:ext)
-      base <- liftE $ getBase ghcupURL
-      ext  <- liftE $ getBase uri
-      pure (mergeGhcupInfo base ext)
 
-    where
+ where
-
+  mergeGhcupInfo :: MonadFail m
-  mergeGhcupInfo :: GHCupInfo -- ^ base to merge with
+                 => [GHCupInfo]
-                 -> GHCupInfo -- ^ extension overwriting the base
+                 -> m GHCupInfo
-                 -> GHCupInfo
+  mergeGhcupInfo [] = fail "mergeGhcupInfo: internal error: need at least one GHCupInfo"
-  mergeGhcupInfo (GHCupInfo tr base base2) (GHCupInfo _ ext ext2) =
+  mergeGhcupInfo xs@(GHCupInfo{}: _) =
-    let newDownloads = M.mapWithKey (\k a -> case M.lookup k ext of
+    let newDownloads   = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_ghcupDownloads   <$> xs)
-                                        Just a' -> M.union a' a
+        newGlobalTools = M.unionsWith (\_ a2 -> a2              ) (_globalTools      <$> xs)
-                                        Nothing -> a
+        newToolReqs    = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_toolRequirements <$> xs)
-                                    ) base
+    in pure $ GHCupInfo newToolReqs newDownloads newGlobalTools
-        newGlobalTools = M.union base2 ext2
-    in GHCupInfo tr newDownloads newGlobalTools
 
 
 yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath

lib/GHCup/Requirements.hs

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

lib/GHCup/Types.hs

@@ -286,9 +286,9 @@ instance Pretty TarDir where
 
 -- | Where to fetch GHCupDownloads from.
 data URLSource = GHCupURL
-               | OwnSource URI
+               | OwnSource [Either GHCupInfo URI] -- ^ complete source list
                | OwnSpec GHCupInfo
-               | AddSource (Either GHCupInfo URI) -- ^ merge with GHCupURL
+               | AddSource [Either GHCupInfo URI] -- ^ merge with GHCupURL
                deriving (GHC.Generic, Show)
 
 instance NFData URLSource

lib/GHCup/Types/JSON.hs

@@ -79,6 +79,38 @@ instance FromJSON Tag where
 instance ToJSON URI where
   toJSON = toJSON . E.decodeUtf8With E.lenientDecode . serializeURIRef'
 
+instance FromJSON URLSource where
+  parseJSON v =
+        parseGHCupURL v
+    <|> parseOwnSourceLegacy v
+    <|> parseOwnSourceNew1 v
+    <|> parseOwnSourceNew2 v
+    <|> parseOwnSpec v
+    <|> legacyParseAddSource v
+    <|> newParseAddSource v
+   where
+    parseOwnSourceLegacy = withObject "URLSource" $ \o -> do
+      r :: URI <- o .: "OwnSource"
+      pure (OwnSource [Right r])
+    parseOwnSourceNew1 = withObject "URLSource" $ \o -> do
+      r :: [URI] <- o .: "OwnSource"
+      pure (OwnSource (fmap Right r))
+    parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
+      r :: [Either GHCupInfo URI] <- o .: "OwnSource"
+      pure (OwnSource r)
+    parseOwnSpec = withObject "URLSource" $ \o -> do
+      r :: GHCupInfo <- o .: "OwnSpec"
+      pure (OwnSpec r)
+    parseGHCupURL = withObject "URLSource" $ \o -> do
+      _ :: [Value] <- o .: "GHCupURL"
+      pure GHCupURL
+    legacyParseAddSource = withObject "URLSource" $ \o -> do
+      r :: Either GHCupInfo URI <- o .: "AddSource"
+      pure (AddSource [r])
+    newParseAddSource = withObject "URLSource" $ \o -> do
+      r :: [Either GHCupInfo URI] <- o .: "AddSource"
+      pure (AddSource r)
+
 instance FromJSON URI where
   parseJSON = withText "URL" $ \t ->
     case parseURI strictURIParserOptions (encodeUtf8 t) of
@@ -314,7 +346,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requir
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
-deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
+deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
 deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings

lib/GHCup/Utils/Dirs.hs

@@ -339,13 +339,15 @@ useXDG = isJust <$> lookupEnv "GHCUP_USE_XDG_DIRS"
 relativeSymlink :: FilePath  -- ^ the path in which to create the symlink
                 -> FilePath  -- ^ the symlink destination
                 -> FilePath
-relativeSymlink p1 p2 =
+relativeSymlink p1 p2
-  let d1      = splitDirectories p1
+  | isWindows = p2 -- windows quickly gets into MAX_PATH issues so we don't care about relative symlinks
-      d2      = splitDirectories p2
+  | otherwise =
-      common  = takeWhile (\(x, y) -> x == y) $ zip d1 d2
+    let d1      = splitDirectories p1
-      cPrefix = drop (length common) d1
+        d2      = splitDirectories p2
-  in  joinPath (replicate (length cPrefix) "..")
+        common  = takeWhile (\(x, y) -> x == y) $ zip d1 d2
-        <> joinPath ([pathSeparator] : drop (length common) d2)
+        cPrefix = drop (length common) d1
+    in  joinPath (replicate (length cPrefix) "..")
+          <> joinPath ([pathSeparator] : drop (length common) d2)
 
 
 cleanupTrash :: ( MonadIO m

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-18.25
+resolver: lts-18.27
 
 packages:
   - .
@@ -16,6 +16,7 @@ extra-deps:
   - composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
   - haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
   - haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
+  - haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200
   - heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
   - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
   - hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
@@ -39,11 +40,6 @@ extra-deps:
   - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
   - yaml-streamly-0.12.0
 
-  - git: https://github.com/hasufell/packages.git
-    commit: cc0b4688f8bb374fa92f17c856949de795b56291
-    subdirs:
-      - haskus-utils-variant
-
 flags:
   http-io-streams:
     brotli: false