Compare commits

...

17 Commits

Author SHA1 Message Date
604a6fc92b Fix bug with isolated installation of not previously installed versions
It would error out trying to set the version.
2022-03-14 00:36:08 +01:00
8c205fd18c Add --no-set to install commands, fixes #330
This also slightly changes the default for
'ghcup install cabal/stack/hls'... instead of
only setting the installed version if it's the latest,
we always set it. So the default is `--set`.

For GHC, the default is `--no-set`.
2022-03-13 22:48:45 +01:00
41ecf897fb Update stack.yaml 2022-03-09 20:33:45 +01:00
4c9c6e9223 Update cabal bounds 2022-03-09 19:52:16 +01:00
8be71c4c5c Fix color 2022-03-08 22:25:34 +01:00
01d310e630 Add tool version tables 2022-03-08 22:23:29 +01:00
96cb99e1b5 Improve --repository completion 2022-03-07 22:23:39 +01:00
2e08efeed7 Adjust colors 2022-03-07 21:37:04 +01:00
04fceb3134 Update changelog 2022-03-06 12:37:17 +01:00
1f0a891bab Fix 'ghcup install cabal/hls/stack --set' wrt #324 2022-03-05 20:50:58 +01:00
6c63a65983 Fix bad error message wrt #323 2022-03-05 20:19:54 +01:00
199d3b7aee Fix downloader completer 2022-03-05 20:14:10 +01:00
04fc04f586 More improvements to completers 2022-03-05 20:00:32 +01:00
3f96a6460a Merge branch 'url-completer' 2022-03-05 13:49:12 +01:00
bfcaa7f6fb Update ghcup-metadata 2022-03-05 12:56:38 +01:00
e2bd4c4880 Update stack resolver 2022-03-05 12:56:29 +01:00
ab702bba9b Improve completion support 2022-03-05 12:56:19 +01:00
16 changed files with 588 additions and 126 deletions

View File

@@ -1,5 +1,11 @@
# Revision history for ghcup # 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)
## 0.1.17.5 -- 2022-02-26 ## 0.1.17.5 -- 2022-02-26
* Implement `ghcup run` subcommand wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/137) * Implement `ghcup run` subcommand wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/137)

View File

@@ -113,8 +113,8 @@ data Command
opts :: Parser Options opts :: Parser Options
opts = opts =
Options 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 auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
<*> optional <*> optional
(option (option
@@ -124,9 +124,10 @@ opts =
<> metavar "URL" <> metavar "URL"
<> help "Alternative ghcup download info url" <> help "Alternative ghcup download info url"
<> internal <> 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 <*> optional (option
(eitherReader keepOnParser) (eitherReader keepOnParser)
( long "keep" ( long "keep"
@@ -134,6 +135,7 @@ opts =
<> help <> help
"Keep build directories? (default: errors)" "Keep build directories? (default: errors)"
<> hidden <> hidden
<> completer (listCompleter ["always", "errors", "never"])
)) ))
<*> optional (option <*> optional (option
(eitherReader downloaderParser) (eitherReader downloaderParser)
@@ -142,20 +144,23 @@ opts =
<> metavar "<internal|curl|wget>" <> metavar "<internal|curl|wget>"
<> help <> help
"Downloader to use (default: internal)" "Downloader to use (default: internal)"
<> completer (listCompleter ["internal", "curl", "wget"])
#else #else
<> metavar "<curl|wget>" <> metavar "<curl|wget>"
<> help <> help
"Downloader to use (default: curl)" "Downloader to use (default: curl)"
<> completer (listCompleter ["curl", "wget"])
#endif #endif
<> hidden <> 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 <*> optional (option
(eitherReader gpgParser) (eitherReader gpgParser)
( long "gpg" ( long "gpg"
<> metavar "<strict|lax|none>" <> metavar "<strict|lax|none>"
<> help <> help
"GPG verification (default: none)" "GPG verification (default: none)"
<> completer (listCompleter ["strict", "lax", "none"])
)) ))
<*> com <*> com
where where

View File

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

View File

@@ -3,6 +3,8 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NumericUnderscores #-}
module GHCup.OptParse.Common where module GHCup.OptParse.Common where
@@ -14,36 +16,55 @@ import GHCup.Platform
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.File
import GHCup.Utils.Logger import GHCup.Utils.Logger
import GHCup.Utils.MegaParsec import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import Control.DeepSeq
import Control.Concurrent
import Control.Concurrent.Async
import Control.Exception.Safe import Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
#endif #endif
import Control.Monad.Reader 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.Bifunctor
import Data.Char import Data.Char
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.List ( nub, sort, sortBy ) import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
import Data.Maybe import Data.Maybe
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions hiding ( str ) import Data.Versions hiding ( str )
import Data.Void import Data.Void
import qualified Data.Vector as V
import GHC.IO.Exception
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import Safe import Safe
import System.Directory
import System.Process ( readProcess )
import System.FilePath import System.FilePath
import Text.HTML.TagSoup hiding ( Tag )
import URI.ByteString import URI.ByteString
import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import qualified System.FilePath.Posix as FP
import GHCup.Version 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. -- the help is shown only for --no-recursive.
invertableSwitch invertableSwitch
:: String -- ^ long option :: 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? -> Bool -- ^ is switch enabled by default?
-> Mod FlagFields Bool -- ^ option modifier -> Mod FlagFields Bool -- ^ option modifier
-> Parser (Maybe Bool) -> 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. -- | Allows providing option modifiers for both --foo and --no-foo.
invertableSwitch' invertableSwitch'
:: String -- ^ long option (eg "foo") :: 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? -> Bool -- ^ is switch enabled by default?
-> Mod FlagFields Bool -- ^ option modifier for --foo -> Mod FlagFields Bool -- ^ option modifier for --foo
-> Mod FlagFields Bool -- ^ option modifier for --no-foo -> Mod FlagFields Bool -- ^ option modifier for --no-foo
-> Parser (Maybe Bool) -> Parser (Maybe Bool)
invertableSwitch' longopt shortopt defv enmod dismod = optional 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 where
nolongopt = "no-" ++ longopt nolongopt = "no-" ++ longopt
@@ -277,6 +298,126 @@ gpgParser s' | t == T.pack "strict" = Right GPGStrict
--[ Completers ]-- --[ 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 -> [String] -> Completer
tagCompleter tool add = listIOCompleter $ do tagCompleter tool add = listIOCompleter $ do
dirs' <- liftIO getAllDirs dirs' <- liftIO getAllDirs
@@ -334,6 +475,150 @@ versionCompleter criteria tool = listIOCompleter $ do
return $ T.unpack . prettyVer . lVer <$> installedVersions 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
----------------- -----------------

View File

@@ -165,6 +165,7 @@ ghcCompileOpts =
) )
(short 'v' <> long "version" <> metavar "VERSION" <> help (short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile" "The tool version to compile"
<> (completer $ versionCompleter Nothing GHC)
) )
) <|> ) <|>
(Right <$> (GitBranch <$> option (Right <$> (GitBranch <$> option
@@ -172,7 +173,10 @@ ghcCompileOpts =
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
"The git commit/branch/ref to build from" "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 <*> option
(eitherReader (eitherReader
@@ -185,12 +189,14 @@ ghcCompileOpts =
<> metavar "BOOTSTRAP_GHC" <> metavar "BOOTSTRAP_GHC"
<> help <> help
"The GHC version (or full path) to bootstrap with (must be installed)" "The GHC version (or full path) to bootstrap with (must be installed)"
<> (completer $ versionCompleter Nothing GHC)
) )
<*> optional <*> optional
(option (option
(eitherReader (readEither @Int)) (eitherReader (readEither @Int))
(short 'j' <> long "jobs" <> metavar "JOBS" <> help (short 'j' <> long "jobs" <> metavar "JOBS" <> help
"How many jobs to use for make" "How many jobs to use for make"
<> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
) )
) )
<*> optional <*> optional
@@ -198,6 +204,7 @@ ghcCompileOpts =
str str
(short 'c' <> long "config" <> metavar "CONFIG" <> help (short 'c' <> long "config" <> metavar "CONFIG" <> help
"Absolute path to build config file" "Absolute path to build config file"
<> completer (bashCompleter "file")
) )
) )
<*> (optional <*> (optional
@@ -206,6 +213,7 @@ ghcCompileOpts =
(eitherReader uriParser) (eitherReader uriParser)
(long "patch" <> metavar "PATCH_URI" <> help (long "patch" <> metavar "PATCH_URI" <> help
"URI to a patch (https/http/file)" "URI to a patch (https/http/file)"
<> completer fileUri
) )
) )
<|> <|>
@@ -213,6 +221,7 @@ ghcCompileOpts =
str str
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help (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)" "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)")) <*> 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 <*> optional
(option (option
(eitherReader (eitherReader
@@ -238,6 +242,7 @@ ghcCompileOpts =
) )
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help (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'" "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 <*> optional
@@ -257,6 +262,7 @@ ghcCompileOpts =
<> long "isolate" <> long "isolate"
<> metavar "DIR" <> metavar "DIR"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made" <> 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 (short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile" "The tool version to compile"
<> (completer $ versionCompleter Nothing HLS)
) )
) <|> ) <|>
(Right <$> (GitBranch <$> option (Right <$> (GitBranch <$> option
@@ -276,21 +283,19 @@ hlsCompileOpts =
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
"The git commit/branch/ref to build from" "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 <*> optional
(option (option
(eitherReader (readEither @Int)) (eitherReader (readEither @Int))
(short 'j' <> long "jobs" <> metavar "JOBS" <> help (short 'j' <> long "jobs" <> metavar "JOBS" <> help
"How many jobs to use for make" "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 <*> optional
(option (option
(eitherReader (eitherReader
@@ -298,6 +303,7 @@ hlsCompileOpts =
) )
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help (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'" "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 <*> optional
@@ -307,6 +313,7 @@ hlsCompileOpts =
<> long "isolate" <> long "isolate"
<> metavar "DIR" <> metavar "DIR"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made" <> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
<> completer (bashCompleter "directory")
) )
) )
<*> optional <*> optional
@@ -314,6 +321,7 @@ hlsCompileOpts =
((fmap Right $ eitherReader uriParser) <|> (fmap Left str)) ((fmap Right $ eitherReader uriParser) <|> (fmap Left str))
(long "cabal-project" <> metavar "CABAL_PROJECT" <> help (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." "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 <*> optional
@@ -321,6 +329,7 @@ hlsCompileOpts =
(eitherReader uriParser) (eitherReader uriParser)
(long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help (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." "URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
<> completer fileUri
) )
) )
<*> (optional <*> (optional
@@ -329,6 +338,7 @@ hlsCompileOpts =
(eitherReader uriParser) (eitherReader uriParser)
(long "patch" <> metavar "PATCH_URI" <> help (long "patch" <> metavar "PATCH_URI" <> help
"URI to a patch (https/http/file)" "URI to a patch (https/http/file)"
<> completer fileUri
) )
) )
<|> <|>
@@ -336,6 +346,7 @@ hlsCompileOpts =
str str
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)" "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
<> completer (bashCompleter "directory")
) )
) )
) )

View File

@@ -6,6 +6,7 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.OptParse.Install where module GHCup.OptParse.Install where
@@ -189,18 +190,15 @@ installOpts tool =
(eitherReader uriParser) (eitherReader uriParser)
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help (short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
"Install the specified version from this bindist" "Install the specified version from this bindist"
<> completer (toolDlCompleter (fromMaybe GHC tool))
) )
) )
<*> (Just <$> toolVersionArgument Nothing tool) <*> (Just <$> toolVersionArgument Nothing tool)
) )
<|> pure (Nothing, Nothing) <|> 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 <*> optional
(option (option
(eitherReader isolateParser) (eitherReader isolateParser)
@@ -208,10 +206,16 @@ installOpts tool =
<> long "isolate" <> long "isolate"
<> metavar "DIR" <> metavar "DIR"
<> help "install in an isolated dir instead of the default one" <> help "install in an isolated dir instead of the default one"
<> completer (bashCompleter "directory")
) )
) )
<*> switch <*> switch
(short 'f' <> long "force" <> help "Force install") (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 , NoToolVersionSet
, FileAlreadyExistsError , FileAlreadyExistsError
, ProcessError , 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 isolateDir
forceInstall forceInstall
) )
$ when instSet $ void $ setGHC v SetGHCOnly Nothing $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
pure vi pure vi
Just uri -> do Just uri -> do
runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
@@ -363,7 +409,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
isolateDir isolateDir
forceInstall forceInstall
) )
$ when instSet $ void $ setGHC v SetGHCOnly Nothing $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
pure vi pure vi
) )
>>= \case >>= \case
@@ -418,20 +464,22 @@ install installCommand settings getAppState' runLogger = case installCommand of
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of (case instBindist of
Nothing -> runInstTool s' instPlatform $ do 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 pure vi
Just uri -> do Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ 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 pure vi
) )
>>= \case >>= \case
@@ -448,6 +496,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
runLogger $ logWarn $ runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite." "File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3 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 VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e
@@ -459,21 +515,23 @@ install installCommand settings getAppState' runLogger = case installCommand of
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of (case instBindist of
Nothing -> runInstTool s' instPlatform $ do 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 pure vi
Just uri -> do Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ 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 -- 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 pure vi
) )
>>= \case >>= \case
@@ -494,6 +552,18 @@ install installCommand settings getAppState' runLogger = case installCommand of
runLogger $ logWarn $ runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite." "File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3 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 VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e
@@ -505,20 +575,22 @@ install installCommand settings getAppState' runLogger = case installCommand of
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of (case instBindist of
Nothing -> runInstTool s' instPlatform $ do 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 pure vi
Just uri -> do Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ 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 pure vi
) )
>>= \case >>= \case
@@ -535,6 +607,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
runLogger $ logWarn $ runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite." "File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3 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 VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e

View File

@@ -69,6 +69,7 @@ listOpts =
(eitherReader toolParser) (eitherReader toolParser)
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help (short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
"Tool to list versions for. Default is all" "Tool to list versions for. Default is all"
<> completer (toolCompleter)
) )
) )
<*> optional <*> optional
@@ -78,6 +79,7 @@ listOpts =
<> long "show-criteria" <> long "show-criteria"
<> metavar "<installed|set|available>" <> metavar "<installed|set|available>"
<> help "Show only installed/set/available tool versions" <> help "Show only installed/set/available tool versions"
<> completer (listCompleter ["installed", "set", "available"])
) )
) )
<*> switch <*> switch

View File

@@ -83,7 +83,7 @@ prefetchP = subparser
(PrefetchGHC (PrefetchGHC
<$> (PrefetchGHCOptions <$> (PrefetchGHCOptions
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper ) <$> ( 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)) ) <*> optional (toolVersionArgument Nothing (Just GHC)) )
( progDesc "Download GHC assets for installation") ( progDesc "Download GHC assets for installation")
) )
@@ -92,7 +92,7 @@ prefetchP = subparser
"cabal" "cabal"
(info (info
(PrefetchCabal (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 )) <*> ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper ))
( progDesc "Download cabal assets for installation") ( progDesc "Download cabal assets for installation")
) )
@@ -101,7 +101,7 @@ prefetchP = subparser
"hls" "hls"
(info (info
(PrefetchHLS (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 )) <*> ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper ))
( progDesc "Download HLS assets for installation") ( progDesc "Download HLS assets for installation")
) )
@@ -110,7 +110,7 @@ prefetchP = subparser
"stack" "stack"
(info (info
(PrefetchStack (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 )) <*> ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper ))
( progDesc "Download stack assets for installation") ( progDesc "Download stack assets for installation")
) )

View File

@@ -72,6 +72,7 @@ data RunOptions = RunOptions
--------------- ---------------
runOpts :: Parser RunOptions runOpts :: Parser RunOptions
runOpts = runOpts =
RunOptions RunOptions
@@ -82,22 +83,34 @@ runOpts =
<*> optional <*> optional
(option (option
(eitherReader toolVersionEither) (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 <*> optional
(option (option
(eitherReader toolVersionEither) (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 <*> optional
(option (option
(eitherReader toolVersionEither) (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 <*> optional
(option (option
(eitherReader toolVersionEither) (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 <*> optional
(option (option
@@ -106,6 +119,7 @@ runOpts =
<> long "bindir" <> long "bindir"
<> metavar "DIR" <> metavar "DIR"
<> help "directory where to create the tool symlinks (default: newly created system temp 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.")) <*> 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."))
@@ -324,7 +338,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
if legacy if legacy
then do then do
-- TODO: factor this out -- TODO: factor this out
(Just hlsWrapper) <- hlsWrapperBinary v' hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v' !? (NotInstalled HLS (mkTVer v'))
cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper) cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)
lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw) lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)
hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>)) hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))

View File

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

View File

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

View File

@@ -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**: 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 ## Supported platforms

View File

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

View File

@@ -468,10 +468,6 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do
Nothing -> do -- regular install Nothing -> do -- regular install
liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall 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 -- | Install an unpacked cabal distribution.Symbol
installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m) 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 $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir inst ver
liftE $ setHLS ver SetHLS_XYZ Nothing liftE $ setHLS ver SetHLS_XYZ Nothing
liftE $ installHLSPostInst isoFilepath ver
isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
-> IO Bool -> IO Bool
@@ -696,19 +691,6 @@ installHLSUnpackedLegacy path inst mver' forceInstall = do
lift $ chmod_755 destWrapperPath 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\>@ -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@. -- 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 $ installHLSUnpackedLegacy installDir binDir (Just installVer) True
) )
liftE $ installHLSPostInst isolateDir installVer
pure installVer pure installVer
@@ -1034,11 +1014,6 @@ installStackBindist dlinfo ver isoFilepath forceInstall = do
Nothing -> do -- regular install Nothing -> do -- regular install
liftE $ installStackUnpacked workdir binDir (Just ver) forceInstall 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. -- | Install an unpacked stack distribution.
installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m) installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)

View File

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