Add command line completions for installed and available versions.
When running `ghcup set ghc` and pressing tab, one should be able to autocomplete the currently installed GHCs we have available. Add an optparse applicative completer for install, rm, and set commands which shows tags and versions. For installation, all are shown; while for remove and set, only those installed are.
This commit is contained in:
Huw campbell
Huw Campbell
parent
eab82b5d63
commit
d6fa61e223
@ -192,10 +192,10 @@ data ChangeLogOptions = ChangeLogOptions
|
||||
-- by default. For example:
|
||||
--
|
||||
-- > invertableSwitch "recursive" True (help "do not recurse into directories")
|
||||
--
|
||||
-- This example makes --recursive enabled by default, so
|
||||
--
|
||||
-- This example makes --recursive enabled by default, so
|
||||
-- the help is shown only for --no-recursive.
|
||||
invertableSwitch
|
||||
invertableSwitch
|
||||
:: String -- ^ long option
|
||||
-> Char -- ^ short option for the non-default option
|
||||
-> Bool -- ^ is switch enabled by default?
|
||||
@ -363,7 +363,7 @@ com =
|
||||
( command
|
||||
"install-cabal"
|
||||
((info
|
||||
((InstallCabalLegacy <$> installOpts) <**> helper)
|
||||
((InstallCabalLegacy <$> installOpts (Just Cabal)) <**> helper)
|
||||
( progDesc "Install or update cabal"
|
||||
<> footerDoc (Just $ text installCabalFooter)
|
||||
)
|
||||
@ -413,7 +413,7 @@ installParser =
|
||||
"ghc"
|
||||
( InstallGHC
|
||||
<$> (info
|
||||
(installOpts <**> helper)
|
||||
(installOpts (Just GHC) <**> helper)
|
||||
( progDesc "Install GHC"
|
||||
<> footerDoc (Just $ text installGHCFooter)
|
||||
)
|
||||
@ -423,7 +423,7 @@ installParser =
|
||||
"cabal"
|
||||
( InstallCabal
|
||||
<$> (info
|
||||
(installOpts <**> helper)
|
||||
(installOpts (Just Cabal) <**> helper)
|
||||
( progDesc "Install Cabal"
|
||||
<> footerDoc (Just $ text installCabalFooter)
|
||||
)
|
||||
@ -433,7 +433,7 @@ installParser =
|
||||
"hls"
|
||||
( InstallHLS
|
||||
<$> (info
|
||||
(installOpts <**> helper)
|
||||
(installOpts (Just HLS) <**> helper)
|
||||
( progDesc "Install haskell-languge-server"
|
||||
<> footerDoc (Just $ text installHLSFooter)
|
||||
)
|
||||
@ -441,7 +441,7 @@ installParser =
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> installOpts)
|
||||
<|> (Right <$> installOpts Nothing)
|
||||
where
|
||||
installHLSFooter :: String
|
||||
installHLSFooter = [s|Discussion:
|
||||
@ -472,8 +472,8 @@ Examples:
|
||||
ghcup install ghc -u https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27 head|]
|
||||
|
||||
|
||||
installOpts :: Parser InstallOptions
|
||||
installOpts =
|
||||
installOpts :: Maybe Tool -> Parser InstallOptions
|
||||
installOpts tool =
|
||||
(\p (u, v) b -> InstallOptions v p u b)
|
||||
<$> (optional
|
||||
(option
|
||||
@ -495,9 +495,9 @@ installOpts =
|
||||
)
|
||||
)
|
||||
)
|
||||
<*> (Just <$> toolVersionArgument)
|
||||
<*> (Just <$> toolVersionArgument Nothing tool)
|
||||
)
|
||||
<|> ((,) <$> pure Nothing <*> optional toolVersionArgument)
|
||||
<|> (pure (Nothing, Nothing))
|
||||
)
|
||||
<*> flag
|
||||
False
|
||||
@ -514,7 +514,7 @@ setParser =
|
||||
"ghc"
|
||||
( SetGHC
|
||||
<$> (info
|
||||
(setOpts <**> helper)
|
||||
(setOpts (Just GHC) <**> helper)
|
||||
( progDesc "Set GHC version"
|
||||
<> footerDoc (Just $ text setGHCFooter)
|
||||
)
|
||||
@ -524,7 +524,7 @@ setParser =
|
||||
"cabal"
|
||||
( SetCabal
|
||||
<$> (info
|
||||
(setOpts <**> helper)
|
||||
(setOpts (Just Cabal) <**> helper)
|
||||
( progDesc "Set Cabal version"
|
||||
<> footerDoc (Just $ text setCabalFooter)
|
||||
)
|
||||
@ -534,7 +534,7 @@ setParser =
|
||||
"hls"
|
||||
( SetHLS
|
||||
<$> (info
|
||||
(setOpts <**> helper)
|
||||
(setOpts (Just HLS) <**> helper)
|
||||
( progDesc "Set haskell-language-server version"
|
||||
<> footerDoc (Just $ text setHLSFooter)
|
||||
)
|
||||
@ -542,7 +542,7 @@ setParser =
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> setOpts)
|
||||
<|> (Right <$> setOpts Nothing)
|
||||
where
|
||||
setGHCFooter :: String
|
||||
setGHCFooter = [s|Discussion:
|
||||
@ -559,8 +559,8 @@ setParser =
|
||||
Sets the the current haskell-language-server version.|]
|
||||
|
||||
|
||||
setOpts :: Parser SetOptions
|
||||
setOpts = SetOptions <$> optional toolVersionArgument
|
||||
setOpts :: Maybe Tool -> Parser SetOptions
|
||||
setOpts tool = SetOptions <$> optional (toolVersionArgument (Just ListInstalled) tool)
|
||||
|
||||
listOpts :: Parser ListOptions
|
||||
listOpts =
|
||||
@ -592,7 +592,7 @@ rmParser =
|
||||
(Left <$> subparser
|
||||
( command
|
||||
"ghc"
|
||||
(RmGHC <$> (info (rmOpts <**> helper) (progDesc "Remove GHC version")))
|
||||
(RmGHC <$> (info (rmOpts (Just GHC) <**> helper) (progDesc "Remove GHC version")))
|
||||
<> command
|
||||
"cabal"
|
||||
( RmCabal
|
||||
@ -609,12 +609,12 @@ rmParser =
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> rmOpts)
|
||||
<|> (Right <$> rmOpts Nothing)
|
||||
|
||||
|
||||
|
||||
rmOpts :: Parser RmOptions
|
||||
rmOpts = RmOptions <$> versionArgument
|
||||
rmOpts :: Maybe Tool -> Parser RmOptions
|
||||
rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool
|
||||
|
||||
|
||||
changelogP :: Parser ChangeLogOptions
|
||||
@ -636,7 +636,7 @@ changelogP =
|
||||
)
|
||||
)
|
||||
)
|
||||
<*> optional toolVersionArgument
|
||||
<*> optional (toolVersionArgument Nothing Nothing)
|
||||
|
||||
compileP :: Parser CompileCommand
|
||||
compileP = subparser
|
||||
@ -765,13 +765,63 @@ toolVersionParser = verP' <|> toolP
|
||||
)
|
||||
|
||||
-- | same as toolVersionParser, except as an argument.
|
||||
toolVersionArgument :: Parser ToolVersion
|
||||
toolVersionArgument =
|
||||
argument (eitherReader toolVersionEither) (metavar "VERSION|TAG")
|
||||
toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
||||
toolVersionArgument criterial tool =
|
||||
argument (eitherReader toolVersionEither) (metavar "VERSION|TAG" <> completer tagCompleter <> foldMap (completer . versionCompleter criterial) tool)
|
||||
|
||||
|
||||
versionArgument :: Parser GHCTargetVersion
|
||||
versionArgument = argument (eitherReader tVersionEither) (metavar "VERSION")
|
||||
versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
||||
versionArgument criterial tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criterial) tool)
|
||||
|
||||
|
||||
tagCompleter :: Completer
|
||||
tagCompleter =
|
||||
listCompleter [
|
||||
"recommended", "latest"
|
||||
]
|
||||
|
||||
|
||||
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
||||
versionCompleter criteria tool =
|
||||
listIOCompleter $ do
|
||||
let
|
||||
loggerConfig =
|
||||
LoggerConfig
|
||||
{ lcPrintDebug = False
|
||||
, colorOutter = mempty
|
||||
, rawOutter = mempty
|
||||
}
|
||||
|
||||
runLogger =
|
||||
myLoggerT loggerConfig
|
||||
|
||||
mpFreq <-
|
||||
runLogger . runE $
|
||||
platformRequest
|
||||
|
||||
forFold mpFreq $ \pfreq -> do
|
||||
dirs <- getDirs
|
||||
let
|
||||
simpleSettings =
|
||||
Settings False False Never Curl False GHCupURL
|
||||
simpleAppState =
|
||||
AppState simpleSettings dirs defaultKeyBindings
|
||||
runEnv =
|
||||
runLogger . flip runReaderT simpleAppState
|
||||
|
||||
mGhcUpInfo <-
|
||||
runEnv . runE $
|
||||
getDownloadsF $
|
||||
urlSource simpleSettings
|
||||
|
||||
forFold mGhcUpInfo $ \(GHCupInfo _ dls) -> do
|
||||
installedVersions <-
|
||||
runEnv $
|
||||
listVersions dls (Just tool) criteria pfreq
|
||||
|
||||
return $
|
||||
T.unpack . prettyVer . lVer <$> installedVersions
|
||||
|
||||
|
||||
versionParser :: Parser GHCTargetVersion
|
||||
versionParser = option
|
||||
|
||||
@ -808,3 +808,12 @@ getVersionInfo v' tool dls =
|
||||
% _head
|
||||
)
|
||||
dls
|
||||
|
||||
|
||||
-- Gathering monoidal values
|
||||
traverseFold :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b
|
||||
traverseFold f = foldl (\mb a -> (<>) <$> mb <*> f a) (pure mempty)
|
||||
|
||||
-- | Gathering monoidal values
|
||||
forFold :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b
|
||||
forFold = flip traverseFold
|
||||
|
||||
Loading…
Reference in New Issue
Block a user