Merge branches 'two-argument-0.18.1', 'completion-control-0.18.1' and…

… 'fix-compgen-wrong-bash-0.18.1' into fork-0.18.1

CHANGELOG.md

@@ -1,3 +1,10 @@
+## Next
+
+- Add `mkCompleterWithOptions`, allowing completers to
+  request that no space is added after the completion.
+  This is useful in situations where not all completions
+  can be computed efficiently, or when they are too many.
+
 ## Version 0.18.1.0 (29 May 2023)
 
 - Change pretty printer layout algorithm used.

README.md

@@ -509,7 +509,7 @@ number of arguments, combine the `argument` builder with either the
 `many` or `some` combinator:
 
 ```haskell
-some (argument str (metavar "FILES..."))
+some (argument str (metavar "FILES"))
 ```
 
 Note that arguments starting with `-` are considered options by
@@ -721,8 +721,8 @@ The `progDesc`, `header`, and `footer` functions can be used to
 specify a brief description or tagline for the program, and detailed
 information surrounding the generated option and command descriptions.
 
-Internally we actually use the [ansi-wl-pprint][ansi-wl-pprint]
-library, and one can use the `headerDoc` combinator and friends if
+Internally we actually use the [prettyprinter][prettyprinter]
+library, and one can supply either text or prettyprinter `Doc` elements if
 additional customisation is required.
 
 To display the usage text, the user may type `--help` if the `helper`
@@ -1030,4 +1030,4 @@ simplified implementation.
  [parsec]: http://hackage.haskell.org/package/parsec
  [status]: https://github.com/pcapriotti/optparse-applicative/actions/workflows/haskell-ci.yml
  [status-png]: https://github.com/pcapriotti/optparse-applicative/workflows/Haskell-CI/badge.svg
- [ansi-wl-pprint]: http://hackage.haskell.org/package/ansi-wl-pprint
+ [prettyprinter]: http://hackage.haskell.org/package/prettyprinter

src/Options/Applicative.hs

@@ -65,6 +65,8 @@ module Options.Applicative (
   strOption,
   option,
 
+  biOption,
+
   strArgument,
   argument,
 
@@ -94,6 +96,7 @@ module Options.Applicative (
   showDefaultWith,
   showDefault,
   metavar,
+  metavar2,
   noArgError,
   hidden,
   internal,
@@ -103,6 +106,7 @@ module Options.Applicative (
   completeWith,
   action,
   completer,
+  completer2,
   idm,
   mappend,
 
@@ -113,8 +117,10 @@ module Options.Applicative (
 
   HasName,
   HasCompleter,
+  HasCompleter2,
   HasValue,
   HasMetavar,
+  HasMetavar2,
   -- ** Readers
   --
   -- | A reader is used by the 'option' and 'argument' builders to parse
@@ -214,6 +220,9 @@ module Options.Applicative (
   -- convenience, to use 'bashCompleter' and 'listCompleter' as a 'Mod'.
   Completer,
   mkCompleter,
+  CompletionItem(..),
+  CompletionItemOptions(..),
+  mkCompleterWithOptions,
   listIOCompleter,
 
   listCompleter,

src/Options/Applicative/BashCompletion.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
 -- | You don't need to import this module to enable bash completion.
 --
 -- See
@@ -24,6 +26,22 @@ 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
+  }
+
+-- | Version of the output format that the shell integration script
+-- expects optparse-applicative to write to stdout.
+--
+-- Version increases should be rare, because most changes
+-- can be handled by adding a new % keyword. Unknown keywords
+-- are ignored by the shell integration scripts.
+currentProtocolVerson :: Int
+currentProtocolVerson = 1
+
 -- | Provide basic or rich command completions
 data Richness
   = Standard
@@ -42,6 +60,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 +84,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,12 +98,12 @@ 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))
-    -> list_options a p
+    -> render_items <$> list_options a p
   Just (Right c)
-    -> run_completer c
+    -> render_items <$> run_completer c
   Nothing
     -> return []
   where
@@ -97,15 +125,22 @@ bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl ppre
     --
     -- For options and flags, ensure that the user
     -- hasn't disabled them with `--`.
+    opt_completions :: forall a. ArgPolicy -> ArgumentReachability -> Option a -> IO [String]
     opt_completions argPolicy reachability opt = case optMain opt of
       OptReader ns _ _
          | argPolicy /= AllPositionals
+        -> return . fmap legacyCompletionItem . add_opt_help opt $ show_names ns
+         | otherwise
+        -> return []
+      BiOptReader ns _ _ _
+         | argPolicy /= AllPositionals
         -> return . add_opt_help opt $ show_names ns
          | otherwise
         -> return []
+      MapReader _f optr -> opt_completions argPolicy reachability (opt { optMain = optr })
       FlagReader ns _
          | argPolicy /= AllPositionals
-        -> return . add_opt_help opt $ show_names ns
+        -> return . fmap legacyCompletionItem . add_opt_help opt $ show_names ns
          | otherwise
         -> return []
       ArgReader rdr
@@ -117,12 +152,12 @@ bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl ppre
          | argumentIsUnreachable reachability
         -> return []
          | otherwise
-        -> return . with_cmd_help $ filter (is_completion . fst) ns
+        -> return . fmap legacyCompletionItem . with_cmd_help $ filter (is_completion . fst) ns
 
     -- 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 +169,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 ->
@@ -154,7 +189,7 @@ bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl ppre
       [x] -> x
       x : _ -> x ++ "..."
 
-    run_completer :: Completer -> IO [String]
+    run_completer :: Completer -> IO [CompletionItem]
     run_completer c = runCompleter c (fromMaybe "" (listToMaybe ws''))
 
     (ws', ws'') = splitAt i ws
@@ -165,20 +200,52 @@ bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl ppre
         w:_ -> isPrefixOf w
         _ -> const True
 
+    render_items :: [CompletionItem] -> [String]
+    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 ]
+      ++ ["%value", val]
+
 -- | Generated bash shell completion script
 bashCompletionScript :: String -> String -> String
 bashCompletionScript prog progn = unlines
+  -- compopt: see complete -o at https://www.gnu.org/software/bash/manual/html_node/Programmable-Completion-Builtins.html
   [ "_" ++ progn ++ "()"
   , "{"
   , "    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)"
   , "    done"
   , ""
-  , "    COMPREPLY=( $(" ++ prog ++ " \"${CMDLINE[@]}\") )"
+  , "    compopt -o nospace +o filenames"
+  , "    COMPREPLY=()"
+  , "    for ln in $(" ++ prog ++ " \"${CMDLINE[@]}\"); do"
+  , "        if $value_mode; then"
+  , "            COMPREPLY+=($ln)"
+  , "            value_mode=false"
+  , "        else"
+  , "            case $ln in"
+  , "                %value)"
+  , "                    value_mode=true"
+  , "                    ;;"
+  , "                %addspace)"
+  , "                    compopt +o nospace"
+  , "                    ;;"
+  , "                %files)"
+  , "                    compopt -o filenames"
+  , "                    ;;"
+  , "            esac"
+  , "        fi"
+  , "    done"
   , "}"
   , ""
   , "complete -o filenames -F _" ++ progn ++ " " ++ progn ]
@@ -210,15 +277,27 @@ 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"
-  , "    for opt in (" ++ prog ++ " $tmpline)"
-  , "      if test -d $opt"
-  , "        echo -E \"$opt/\""
+  , "    set -l value_mode false"
+  , "    for ln in (" ++ prog ++ " $tmpline)"
+  , "      if $value_mode"
+  , "        if test -d $ln"
+  , "          echo -E \"$ln/\""
+  , "        else"
+  , "          echo -E \"$ln\""
+  , "        end"
+  , "        set value_mode false"
   , "      else"
-  , "        echo -E \"$opt\""
+  , "        switch $ln"
+  , "          case '%value'"
+  , "            set value_mode true"
+    --         Ignore %addspace, because fish does not let us remove the end
+    --         space. Dynamic control has not been implemented as of 2020, see
+    --         https://github.com/fish-shell/fish-shell/issues/6928#issuecomment-618012509
+  , "        end"
   , "      end"
   , "    end"
   , "end"
@@ -229,36 +308,61 @@ fishCompletionScript prog progn = unlines
 -- | Generated zsh shell completion script
 zshCompletionScript :: String -> String -> String
 zshCompletionScript prog progn = unlines
+  -- compadd: http://zsh.sourceforge.net/Doc/Release/Completion-Widgets.html#Completion-Builtin-Commands
   [ "#compdef " ++ progn
   , ""
   , "local request"
   , "local completions"
   , "local word"
+  , "local value_mode=false"
+  , "local addspace=false"
+  , "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"
   , ""
-  , "IFS=$'\\n' completions=($( " ++ prog ++ " \"${request[@]}\" ))"
+  , "IFS=$'\\n' completionLines=($( " ++ prog ++ " \"${request[@]}\" ))"
+  , ""
+  , "for word in $completionLines; do"
+  , "  if $value_mode; then"
+  , "    local -a parts args"
   , ""
-  , "for word in $completions; do"
-  , "  local -a parts"
+  , "    # Split the line at a tab if there is one."
+  , "    IFS=$'\\t' parts=($( echo $word ))"
   , ""
-  , "  # Split the line at a tab if there is one."
-  , "  IFS=$'\\t' parts=($( echo $word ))"
+  , "    if $addspace; then"
+  , "      args+=( -S' ' )"
+  , "    fi"
   , ""
-  , "  if [[ -n $parts[2] ]]; then"
-  , "     if [[ $word[1] == \"-\" ]]; then"
-  , "       local desc=(\"$parts[1] ($parts[2])\")"
-  , "       compadd -d desc -- $parts[1]"
-  , "     else"
-  , "       local desc=($(print -f  \"%-019s -- %s\" $parts[1] $parts[2]))"
-  , "       compadd -l -d desc -- $parts[1]"
-  , "     fi"
+  , "    if [[ -n $parts[2] ]]; then"
+  , "       if [[ $word[1] == \"-\" ]]; then"
+  , "         local desc=(\"$parts[1] ($parts[2])\")"
+  , "         compadd $args -d desc -- $parts[1]"
+  , "       else"
+  , "         local desc=($(print -f  \"%-019s -- %s\" $parts[1] $parts[2]))"
+  , "         compadd $args -l -d desc -- $parts[1]"
+  , "       fi"
+  , "    else"
+  , "      compadd $args -f -- $word"
+  , "    fi"
+  , "    value_mode=false"
+  , "    addspace=false"
+  , "    files=false"
   , "  else"
-  , "    compadd -f -- $word"
+  , "    case $word in"
+  , "      %value)"
+  , "        value_mode=true"
+  , "        ;;"
+  , "      %addspace)"
+  , "        addspace=true"
+  , "        ;;"
+  , "      %files)"
+  , "        files=true"
+  , "        ;;"
+  , "    esac"
   , "  fi"
   , "done"
   ]