From fa008aa2d50f405b7e9e21628429f38ab4d04430 Mon Sep 17 00:00:00 2001 From: Robert Hensing Date: Mon, 1 Mar 2021 16:58:58 +0100 Subject: [PATCH] Add completion protocol version for backcompat (cherry picked from commit af10154bd6802ba024c9f3bacdcd32204530cca1) --- src/Options/Applicative/BashCompletion.hs | 48 +++++++++++++++++------ tests/test.hs | 20 ++++------ 2 files changed, 42 insertions(+), 26 deletions(-) diff --git a/src/Options/Applicative/BashCompletion.hs b/src/Options/Applicative/BashCompletion.hs index 49ad3c64..cff22498 100644 --- a/src/Options/Applicative/BashCompletion.hs +++ b/src/Options/Applicative/BashCompletion.hs @@ -24,6 +24,16 @@ import Options.Applicative.Types import Options.Applicative.Help.Pretty import Options.Applicative.Help.Chunk +-- | Which features are supported by the calling shell +-- completion integration script +data Features = Features + { richness :: Richness + , protocolVersion :: Int + } + +currentProtocolVerson :: Int +currentProtocolVerson = 1 + -- | Provide basic or rich command completions data Richness = Standard @@ -42,6 +52,19 @@ bashCompletionParser pinfo pprefs = complParser CompletionResult $ \progn -> unlines <$> opts progn + featuresParser :: Parser Features + featuresParser = Features <$> richnessParser <*> protocolVersionParser + + protocolVersionParser :: Parser Int + protocolVersionParser = option auto (long "optparse-completion-version" `mappend` value 0) + + richnessParser :: Parser Richness + richnessParser = + flag' Enriched (long "bash-completion-enriched" `mappend` internal) + <*> option auto (long "bash-completion-option-desc-length" `mappend` internal `mappend` value 40) + <*> option auto (long "bash-completion-command-desc-length" `mappend` internal `mappend` value 40) + <|> pure Standard + scriptRequest = CompletionResult . fmap pure @@ -53,14 +76,11 @@ bashCompletionParser pinfo pprefs = complParser -- the `desc-length` options. -- zsh commands can go on a single line, so they might -- want to be longer. - <$> ( flag' Enriched (long "bash-completion-enriched" `mappend` internal) - <*> option auto (long "bash-completion-option-desc-length" `mappend` internal `mappend` value 40) - <*> option auto (long "bash-completion-command-desc-length" `mappend` internal `mappend` value 40) - <|> pure Standard - ) + <$> featuresParser <*> (many . strOption) (long "bash-completion-word" `mappend` internal) - <*> option auto (long "bash-completion-index" `mappend` internal) ) + <*> option auto (long "bash-completion-index" `mappend` internal) + ) , scriptRequest . bashCompletionScript <$> strOption (long "bash-completion-script" `mappend` internal) @@ -70,8 +90,8 @@ bashCompletionParser pinfo pprefs = complParser strOption (long "zsh-completion-script" `mappend` internal) ] -bashCompletionQuery :: ParserInfo a -> ParserPrefs -> Richness -> [String] -> Int -> String -> IO [String] -bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl pprefs of +bashCompletionQuery :: ParserInfo a -> ParserPrefs -> Features -> [String] -> Int -> String -> IO [String] +bashCompletionQuery pinfo pprefs features ws i _ = case runCompletion compl pprefs of Just (Left (SomeParser p, a)) -> render_items <$> list_options a p Just (Right c) @@ -122,7 +142,7 @@ bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl ppre -- When doing enriched completions, add any help specified -- to the completion variables (tab separated). add_opt_help :: Functor f => Option a -> f String -> f String - add_opt_help opt = case richness of + add_opt_help opt = case richness features of Standard -> id Enriched len _ -> @@ -134,7 +154,7 @@ bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl ppre -- to the completion variables (tab separated). with_cmd_help :: Functor f => f (String, ParserInfo a) -> f String with_cmd_help = - case richness of + case richness features of Standard -> fmap fst Enriched _ len -> @@ -169,6 +189,8 @@ bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl ppre render_items = concatMap render_item render_item :: CompletionItem -> [String] + render_item CompletionItem { ciValue = val } + | protocolVersion features < 1 = [val] render_item CompletionItem { ciOptions = opts, ciValue = val } = [ "%addspace" | cioAddSpace opts ] ++ [ "%files" | cioFiles opts ] @@ -183,7 +205,7 @@ bashCompletionScript prog progn = unlines , " local CMDLINE" , " local value_mode=false" , " local IFS=$'\\n'" - , " CMDLINE=(--bash-completion-index $COMP_CWORD)" + , " CMDLINE=(--bash-completion-index $COMP_CWORD --optparse-completion-version " ++ show currentProtocolVerson ++ ")" , "" , " for arg in ${COMP_WORDS[@]}; do" , " CMDLINE=(${CMDLINE[@]} --bash-completion-word $arg)" @@ -240,7 +262,7 @@ fishCompletionScript prog progn = unlines , " # Hack around fish issue #3934" , " set -l cn (commandline --tokenize --cut-at-cursor --current-process)" , " set -l cn (count $cn)" - , " set -l tmpline --bash-completion-enriched --bash-completion-index $cn" + , " set -l tmpline --bash-completion-enriched --bash-completion-index $cn --optparse-completion-version " ++ show currentProtocolVerson , " for arg in $cl" , " set tmpline $tmpline --bash-completion-word $arg" , " end" @@ -282,7 +304,7 @@ zshCompletionScript prog progn = unlines , "local files=false" , "local index=$((CURRENT - 1))" , "" - , "request=(--bash-completion-enriched --bash-completion-index $index)" + , "request=(--bash-completion-enriched --bash-completion-index $index --optparse-completion-version " ++ show currentProtocolVerson ++ ")" , "for arg in ${words[@]}; do" , " request=(${request[@]} --bash-completion-word $arg)" , "done" diff --git a/tests/test.hs b/tests/test.hs index 128c4c36..57f4ead4 100644 --- a/tests/test.hs +++ b/tests/test.hs @@ -318,12 +318,6 @@ prop_ambiguous = once $ result = execParserPure (prefs disambiguate) i ["--ba"] in assertError result (\_ -> property succeeded) -completionValues :: [String] -> [String] -completionValues ("%value" : v : more) = v : completionValues more -completionValues (('%':_) : more) = completionValues more -completionValues (a:_) = error ("Unexpected non-% line in completions: " <> a) -completionValues [] = [] - prop_disambiguate_in_same_subparsers :: Property prop_disambiguate_in_same_subparsers = once $ let p0 = subparser (command "oranges" (info (pure "oranges") idm) <> command "apples" (info (pure "apples") idm) <> metavar "B") @@ -376,7 +370,7 @@ prop_completion = once . ioProperty $ in case result of CompletionInvoked (CompletionResult err) -> do completions <- lines <$> err "test" - return $ ["--foo", "--bar"] === completionValues completions + return $ ["--foo", "--bar"] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed @@ -391,7 +385,7 @@ prop_completion_opt_after_double_dash = once . ioProperty $ , "--bash-completion-word", "--"] in case result of CompletionInvoked (CompletionResult err) -> do - completions <- completionValues . lines <$> err "test" + completions <- lines <$> err "test" return $ ["bar"] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed @@ -406,7 +400,7 @@ prop_completion_only_reachable = once . ioProperty $ result = run i ["--bash-completion-index", "0"] in case result of CompletionInvoked (CompletionResult err) -> do - completions <- completionValues . lines <$> err "test" + completions <- lines <$> err "test" return $ ["reachable"] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed @@ -423,7 +417,7 @@ prop_completion_only_reachable_deep = once . ioProperty $ , "--bash-completion-word", "seen" ] in case result of CompletionInvoked (CompletionResult err) -> do - completions <- completionValues . lines <$> err "test" + completions <- lines <$> err "test" return $ ["now-reachable"] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed @@ -438,7 +432,7 @@ prop_completion_multi = once . ioProperty $ , "--bash-completion-word", "nope" ] in case result of CompletionInvoked (CompletionResult err) -> do - completions <- completionValues . lines <$> err "test" + completions <- lines <$> err "test" return $ ["reachable"] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed @@ -452,7 +446,7 @@ prop_completion_rich = once . ioProperty $ result = run i ["--bash-completion-enriched", "--bash-completion-index", "0"] in case result of CompletionInvoked (CompletionResult err) -> do - completions <- completionValues . lines <$> err "test" + completions <- lines <$> err "test" return $ ["--foo\tFo?", "--bar\tBa?"] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed @@ -469,7 +463,7 @@ prop_completion_rich_lengths = once . ioProperty $ , "--bash-completion-command-desc-length=30"] in case result of CompletionInvoked (CompletionResult err) -> do - completions <- completionValues . lines <$> err "test" + completions <- lines <$> err "test" return $ ["--foo\tFoo...", "--bar\tBar..."] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed