More improvements to completers
This commit is contained in:
parent
3f96a6460a
commit
04fc04f586
@ -124,6 +124,7 @@ 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" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
|
||||||
@ -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)
|
||||||
@ -148,6 +150,7 @@ opts =
|
|||||||
"Downloader to use (default: curl)"
|
"Downloader to use (default: curl)"
|
||||||
#endif
|
#endif
|
||||||
<> hidden
|
<> hidden
|
||||||
|
<> completer (listCompleter ["curl", "wget"])
|
||||||
))
|
))
|
||||||
<*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.")
|
<*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.")
|
||||||
<*> optional (option
|
<*> optional (option
|
||||||
@ -156,6 +159,7 @@ opts =
|
|||||||
<> 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
|
||||||
|
@ -52,6 +52,7 @@ 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.Process ( readProcess )
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import Text.HTML.TagSoup hiding ( Tag )
|
import Text.HTML.TagSoup hiding ( Tag )
|
||||||
@ -301,20 +302,34 @@ 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
|
fileUri :: Completer
|
||||||
fileUri = mkCompleter $ \case
|
fileUri = mkCompleter fileUri'
|
||||||
"" -> pure ["https://", "http://", "file:///"]
|
|
||||||
|
fileUri' :: String -> IO [String]
|
||||||
|
fileUri' = \case
|
||||||
|
"" -> do
|
||||||
|
pwd <- getCurrentDirectory
|
||||||
|
pure ["https://", "http://", "file:///", "file://" <> pwd <> "/"]
|
||||||
xs
|
xs
|
||||||
| "file://" `isPrefixOf` xs -> fmap ("file://" <>) <$>
|
| "file:///" `isPrefixOf` xs -> fmap ("file://" <>) <$>
|
||||||
case stripPrefix "file://" xs of
|
case stripPrefix "file://" xs of
|
||||||
Nothing -> pure []
|
Nothing -> pure []
|
||||||
Just r -> do
|
Just r -> do
|
||||||
let cmd = unwords ["compgen", "-A", "file", "--", requote r]
|
pwd <- getCurrentDirectory
|
||||||
result <- tryIO $ readProcess "bash" ["-c", cmd] ""
|
dirs <- compgen "directory" r ["-S", "/"]
|
||||||
return . lines . either (const []) id $ result
|
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 []
|
| otherwise -> pure []
|
||||||
where
|
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.
|
-- | Strongly quote the string we pass to compgen.
|
||||||
--
|
--
|
||||||
-- We need to do this so bash doesn't expand out any ~ or other
|
-- We need to do this so bash doesn't expand out any ~ or other
|
||||||
@ -459,8 +474,9 @@ versionCompleter criteria tool = listIOCompleter $ do
|
|||||||
|
|
||||||
toolDlCompleter :: Tool -> Completer
|
toolDlCompleter :: Tool -> Completer
|
||||||
toolDlCompleter tool = mkCompleter $ \case
|
toolDlCompleter tool = mkCompleter $ \case
|
||||||
"" -> pure $ initUrl tool
|
"" -> pure (initUrl tool <> ["https://", "http://", "file:///"])
|
||||||
word
|
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
|
||||||
@ -501,6 +517,10 @@ toolDlCompleter tool = mkCompleter $ \case
|
|||||||
|
|
||||||
| "h" `isPrefixOf` word -> pure $ 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 []
|
| otherwise -> pure []
|
||||||
where
|
where
|
||||||
initUrl :: Tool -> [String]
|
initUrl :: Tool -> [String]
|
||||||
|
Loading…
Reference in New Issue
Block a user