Control addition of space after completion in bash and zsh

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.17.0.0 (1 Feb 2022)
 
 - Make tabulation width configurable in usage texts.

src/Options/Applicative.hs

@@ -213,6 +213,8 @@ module Options.Applicative (
   -- convenience, to use 'bashCompleter' and 'listCompleter' as a 'Mod'.
   Completer,
   mkCompleter,
+  CompletionItem(..),
+  mkCompleterWithOptions,
   listIOCompleter,
 
   listCompleter,

src/Options/Applicative/BashCompletion.hs

@@ -67,9 +67,9 @@ bashCompletionParser pinfo pprefs = complParser
 bashCompletionQuery :: ParserInfo a -> ParserPrefs -> Richness -> [String] -> Int -> String -> IO [String]
 bashCompletionQuery pinfo pprefs richness 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
@@ -94,12 +94,12 @@ bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl ppre
     opt_completions argPolicy reachability opt = case optMain opt of
       OptReader ns _ _
          | argPolicy /= AllPositionals
-        -> return . add_opt_help opt $ show_names ns
+        -> return . fmap defaultCompletionItem . add_opt_help opt $ show_names ns
          | otherwise
         -> return []
       FlagReader ns _
          | argPolicy /= AllPositionals
-        -> return . add_opt_help opt $ show_names ns
+        -> return . fmap defaultCompletionItem . add_opt_help opt $ show_names ns
          | otherwise
         -> return []
       ArgReader rdr
@@ -111,7 +111,7 @@ 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 defaultCompletionItem . with_cmd_help $ filter (is_completion . fst) ns
 
     -- When doing enriched completions, add any help specified
     -- to the completion variables (tab separated).
@@ -148,7 +148,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
@@ -159,19 +159,45 @@ 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 { ciOptions = opts, ciValue = val } =
+      [ "%addspace" | cioAddSpace opts ]
+      ++ ["%value", val]
+
 bashCompletionScript :: String -> String -> IO [String]
 bashCompletionScript prog progn = return
+  -- 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)"
   , ""
   , "    for arg in ${COMP_WORDS[@]}; do"
   , "        CMDLINE=(${CMDLINE[@]} --bash-completion-word $arg)"
   , "    done"
   , ""
-  , "    COMPREPLY=( $(" ++ prog ++ " \"${CMDLINE[@]}\") )"
+  , "    compopt -o nospace"
+  , "    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"
+  , "                    ;;"
+  , "            esac"
+  , "        fi"
+  , "    done"
   , "}"
   , ""
   , "complete -o filenames -F _" ++ progn ++ " " ++ progn ]
@@ -205,11 +231,23 @@ fishCompletionScript prog progn = return
   , "    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"
@@ -219,36 +257,57 @@ fishCompletionScript prog progn = return
 
 zshCompletionScript :: String -> String -> IO [String]
 zshCompletionScript prog progn = return
+  -- 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)"
   , "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"
   , "  else"
-  , "    compadd -f -- $word"
+  , "    case $word in"
+  , "      %value)"
+  , "        value_mode=true"
+  , "        ;;"
+  , "      %addspace)"
+  , "        addspace=true"
+  , "        ;;"
+  , "    esac"
   , "  fi"
   , "done"
   ]

src/Options/Applicative/Builder/Completer.hs

@@ -22,7 +22,7 @@ import Options.Applicative.Types
 
 -- | Create a 'Completer' from an IO action
 listIOCompleter :: IO [String] -> Completer
-listIOCompleter ss = Completer $ \s ->
+listIOCompleter ss = mkCompleter $ \s ->
   filter (isPrefixOf s) <$> ss
 
 -- | Create a 'Completer' from a constant
@@ -38,7 +38,7 @@ listCompleter = listIOCompleter . pure
 -- for a complete list.
 bashCompleter :: String -> Completer
 #ifdef MIN_VERSION_process
-bashCompleter action = Completer $ \word -> do
+bashCompleter action = mkCompleter $ \word -> do
   let cmd = unwords ["compgen", "-A", action, "--", requote word]
   result <- tryIO $ readProcess "bash" ["-c", cmd] ""
   return . lines . either (const []) id $ result

src/Options/Applicative/Types.hs

@@ -22,6 +22,10 @@ module Options.Applicative.Types (
   ParserM(..),
   Completer(..),
   mkCompleter,
+  mkCompleterWithOptions,
+  CompletionItem(..),
+  defaultCompletionItem,
+  CompletionItemOptions(..),
   CompletionResult(..),
   ParserFailure(..),
   ParserResult(..),
@@ -306,13 +310,40 @@ instance Alternative Parser where
   many = fromM . manyM
   some = fromM . someM
 
+data CompletionItem = CompletionItem {
+  ciOptions :: CompletionItemOptions,
+  ciValue :: String
+}
+defaultCompletionItem :: String -> CompletionItem
+defaultCompletionItem = CompletionItem mempty
+
+data CompletionItemOptions = CompletionItemOptions {
+  -- | Whether to add a space after the completion. Defaults to 'True'.
+  --
+  -- Set this value to 'False' if the completion is only a prefix of the final
+  -- valid values.
+  cioAddSpace :: Bool
+}
+instance Semigroup CompletionItemOptions where
+  a <> b =
+    CompletionItemOptions {
+      cioAddSpace = cioAddSpace a && cioAddSpace b
+    }
+instance Monoid CompletionItemOptions where
+  mempty = CompletionItemOptions True
+  mappend = (<>)
+
 -- | A shell complete function.
 newtype Completer = Completer
-  { runCompleter :: String -> IO [String] }
+  { runCompleter :: String -> IO [CompletionItem] }
 
 -- | Smart constructor for a 'Completer'
 mkCompleter :: (String -> IO [String]) -> Completer
-mkCompleter = Completer
+mkCompleter f = Completer (fmap (map (CompletionItem mempty)) . f)
+
+-- | Smart constructor for a 'Completer'
+mkCompleterWithOptions :: (String -> IO [CompletionItem]) -> Completer
+mkCompleterWithOptions = Completer
 
 instance Semigroup Completer where
   (Completer c1) <> (Completer c2) =

tests/test.hs

@@ -318,6 +318,11 @@ 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 $
@@ -371,7 +376,7 @@ prop_completion = once . ioProperty $
   in case result of
     CompletionInvoked (CompletionResult err) -> do
       completions <- lines <$> err "test"
-      return $ ["--foo", "--bar"] === completions
+      return $ ["--foo", "--bar"] === completionValues completions
     Failure _   -> return $ counterexample "unexpected failure" failed
     Success val -> return $ counterexample ("unexpected result " ++ show val) failed
 
@@ -386,7 +391,7 @@ prop_completion_opt_after_double_dash = once . ioProperty $
                     , "--bash-completion-word", "--"]
   in case result of
     CompletionInvoked (CompletionResult err) -> do
-      completions <- lines <$> err "test"
+      completions <- completionValues . lines <$> err "test"
       return $ ["bar"] === completions
     Failure _   -> return $ counterexample "unexpected failure" failed
     Success val -> return $ counterexample ("unexpected result " ++ show val) failed
@@ -401,7 +406,7 @@ prop_completion_only_reachable = once . ioProperty $
       result = run i ["--bash-completion-index", "0"]
   in case result of
     CompletionInvoked (CompletionResult err) -> do
-      completions <- lines <$> err "test"
+      completions <- completionValues . lines <$> err "test"
       return $ ["reachable"] === completions
     Failure _   -> return $ counterexample "unexpected failure" failed
     Success val -> return $ counterexample ("unexpected result " ++ show val) failed
@@ -418,7 +423,7 @@ prop_completion_only_reachable_deep = once . ioProperty $
                      , "--bash-completion-word", "seen" ]
   in case result of
     CompletionInvoked (CompletionResult err) -> do
-      completions <- lines <$> err "test"
+      completions <- completionValues . lines <$> err "test"
       return $ ["now-reachable"] === completions
     Failure _   -> return $ counterexample "unexpected failure" failed
     Success val -> return $ counterexample ("unexpected result " ++ show val) failed
@@ -433,7 +438,7 @@ prop_completion_multi = once . ioProperty $
                      , "--bash-completion-word", "nope" ]
   in case result of
     CompletionInvoked (CompletionResult err) -> do
-      completions <- lines <$> err "test"
+      completions <- completionValues . lines <$> err "test"
       return $ ["reachable"] === completions
     Failure _   -> return $ counterexample "unexpected failure" failed
     Success val -> return $ counterexample ("unexpected result " ++ show val) failed
@@ -447,7 +452,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 <- lines <$> err "test"
+      completions <- completionValues . lines <$> err "test"
       return $ ["--foo\tFo?", "--bar\tBa?"] === completions
     Failure _   -> return $ counterexample "unexpected failure" failed
     Success val -> return $ counterexample ("unexpected result " ++ show val) failed
@@ -464,7 +469,7 @@ prop_completion_rich_lengths = once . ioProperty $
                      , "--bash-completion-command-desc-length=30"]
   in case result of
     CompletionInvoked (CompletionResult err) -> do
-      completions <- lines <$> err "test"
+      completions <- completionValues . lines <$> err "test"
       return $ ["--foo\tFoo...", "--bar\tBar..."] === completions
     Failure _   -> return $ counterexample "unexpected failure" failed
     Success val -> return $ counterexample ("unexpected result " ++ show val) failed