Improve completion support
This commit is contained in:
parent
8afabf3ffb
commit
ab702bba9b
@ -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)
|
||||||
|
@ -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,54 @@ 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.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)
|
||||||
|
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
@ -277,6 +297,109 @@ gpgParser s' | t == T.pack "strict" = Right GPGStrict
|
|||||||
--[ Completers ]--
|
--[ Completers ]--
|
||||||
------------------
|
------------------
|
||||||
|
|
||||||
|
|
||||||
|
toolCompleter :: Completer
|
||||||
|
toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
|
||||||
|
|
||||||
|
|
||||||
|
fileUri :: Completer
|
||||||
|
fileUri = mkCompleter $ \case
|
||||||
|
"" -> pure ["https://", "http://", "file:///"]
|
||||||
|
xs
|
||||||
|
| "file://" `isPrefixOf` xs -> fmap ("file://" <>) <$>
|
||||||
|
case stripPrefix "file://" xs of
|
||||||
|
Nothing -> pure []
|
||||||
|
Just r -> do
|
||||||
|
let cmd = unwords ["compgen", "-A", "file", "--", requote r]
|
||||||
|
result <- tryIO $ readProcess "bash" ["-c", cmd] ""
|
||||||
|
return . lines . either (const []) id $ result
|
||||||
|
| otherwise -> pure []
|
||||||
|
where
|
||||||
|
-- | 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 +457,145 @@ 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
|
||||||
|
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
|
||||||
|
|
||||||
|
| 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
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
|
@ -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
|
||||||
@ -185,12 +186,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 +201,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 +210,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 +218,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")
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@ -238,6 +244,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 +264,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 +277,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
|
||||||
@ -283,6 +292,7 @@ hlsCompileOpts =
|
|||||||
(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
|
<*> flag
|
||||||
@ -298,6 +308,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 +318,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 +326,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 +334,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 +343,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 +351,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")
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
@ -189,6 +189,7 @@ 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)
|
||||||
@ -208,6 +209,7 @@ 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
|
||||||
|
@ -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
|
||||||
|
@ -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")
|
||||||
)
|
)
|
||||||
|
@ -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."))
|
||||||
|
@ -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
|
||||||
|
@ -241,14 +241,18 @@ executable ghcup
|
|||||||
, optparse-applicative >=0.15.1.0 && <0.17
|
, optparse-applicative >=0.15.1.0 && <0.17
|
||||||
, 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
|
||||||
|
, tagsoup ^>=0.14
|
||||||
, temporary ^>=1.3
|
, temporary ^>=1.3
|
||||||
, template-haskell >=2.7 && <2.18
|
, template-haskell >=2.7 && <2.18
|
||||||
, 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,7 +266,6 @@ 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)
|
||||||
|
Loading…
Reference in New Issue
Block a user