Add completion protocol version for backcompat

(cherry picked from commit af10154)

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"

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