hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Improve --repository completion

Browse Source
This commit is contained in:
Julian Ospald 2022-03-07 22:23:39 +01:00
parent 2e08efeed7
commit 96cb99e1b5
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
2 changed files with 16 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
app/ghcup/GHCup/OptParse/Common.hs
View File

@ -302,14 +302,17 @@ gpgParser s' | t == T.pack "strict" = Right GPGStrict
toolCompleter :: Completer toolCompleter :: Completer
toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"] toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
fileUri :: Completer gitFileUri :: [String] -> Completer
fileUri = mkCompleter fileUri' gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
fileUri' :: String -> IO [String] fileUri :: Completer
fileUri' = \case fileUri = mkCompleter $ fileUri' []
fileUri' :: [String] -> String -> IO [String]
fileUri' add = \case
"" -> do "" -> do
pwd <- getCurrentDirectory pwd <- getCurrentDirectory
pure ["https://", "http://", "file:///", "file://" <> pwd <> "/"] pure $ ["https://", "http://", "file:///", "file://" <> pwd <> "/"] <> add
xs xs
| "file:///" `isPrefixOf` xs -> fmap ("file://" <>) <$> | "file:///" `isPrefixOf` xs -> fmap ("file://" <>) <$>
case stripPrefix "file://" xs of case stripPrefix "file://" xs of
@ -476,7 +479,7 @@ toolDlCompleter :: Tool -> Completer
toolDlCompleter tool = mkCompleter $ \case toolDlCompleter tool = mkCompleter $ \case
"" -> pure (initUrl tool <> ["https://", "http://", "file:///"]) "" -> pure (initUrl tool <> ["https://", "http://", "file:///"])
word word
| "file://" `isPrefixOf` word -> fileUri' word | "file://" `isPrefixOf` word -> fileUri' [] word
-- downloads.haskell.org -- downloads.haskell.org
| "https://downloads.haskell.org/" `isPrefixOf` word -> | "https://downloads.haskell.org/" `isPrefixOf` word ->
fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> fromHRef word fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> fromHRef word

9
app/ghcup/GHCup/OptParse/Compile.hs
View File

@ -173,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
@ -285,7 +288,9 @@ 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