-- | You don't need to import this module to enable bash completion.
--
-- See
-- <http://github.com/pcapriotti/optparse-applicative/wiki/Bash-Completion the wiki>
-- for more information on bash completion.
module Options.Applicative.BashCompletion
( bashCompletionParser
) where
import Control.Applicative
import Prelude
import Data.Foldable ( asum )
import Data.List ( isPrefixOf )
import Data.Maybe ( fromMaybe, listToMaybe )
import Options.Applicative.Builder
import Options.Applicative.Common
import Options.Applicative.Internal
import Options.Applicative.Types
import Options.Applicative.Help.Pretty
import Options.Applicative.Help.Chunk
-- | Provide basic or rich command completions
data Richness
= Standard
-- ^ Add no help descriptions to the completions
| Enriched Int Int
-- ^ Include tab separated description for options
-- and commands when available.
-- Takes option description length and command
-- description length.
deriving (Eq, Ord, Show)
bashCompletionParser :: ParserInfo a -> ParserPrefs -> Parser CompletionResult
bashCompletionParser pinfo pprefs = complParser
where
failure opts = CompletionResult
{ execCompletion = \progn -> unlines <$> opts progn }
complParser = asum
[ failure <$>
( bashCompletionQuery pinfo pprefs
-- To get rich completions, one just needs the first
-- command. To customise the lengths, use either of
-- 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
)
<*> (many . strOption) (long "bash-completion-word"
`mappend` internal)
<*> option auto (long "bash-completion-index" `mappend` internal) )
, failure <$>
(bashCompletionScript <$>
strOption (long "bash-completion-script" `mappend` internal))
, failure <$>
(fishCompletionScript <$>
strOption (long "fish-completion-script" `mappend` internal))
, failure <$>
(zshCompletionScript <$>
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
Just (Left (SomeParser p, a))
-> list_options a p
Just (Right c)
-> run_completer c
Nothing
-> return []
where
compl = runParserInfo pinfo (drop 1 ws')
list_options a
= fmap concat
. sequence
. mapParser (opt_completions a)
--
-- Prior to 0.14 there was a subtle bug which would
-- mean that completions from positional arguments
-- further into the parse would be shown.
--
-- We therefore now check to see that
-- hinfoUnreachableArgs is off before running the
-- completion for position arguments.
--
-- For options and flags, ensure that the user
-- hasn't disabled them with `--`.
opt_completions argPolicy hinfo opt = case optMain opt of
OptReader ns _ _
| argPolicy /= AllPositionals
-> return . add_opt_help opt $ show_names ns
| otherwise
-> return []
FlagReader ns _
| argPolicy /= AllPositionals
-> return . add_opt_help opt $ show_names ns
| otherwise
-> return []
ArgReader rdr
| hinfoUnreachableArgs hinfo
-> return []
| otherwise
-> run_completer (crCompleter rdr)
CmdReader _ ns p
| hinfoUnreachableArgs hinfo
-> return []
| otherwise
-> return . add_cmd_help p $ filter_names 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
Standard
-> id
Enriched len _
-> fmap (\o -> let h = unChunk $ optHelp opt
in maybe o (\h' -> o ++ "\t" ++ render_line len h') h)
-- When doing enriched completions, add the command description
-- to the completion variables (tab separated).
add_cmd_help :: Functor f => (String -> Maybe (ParserInfo a)) -> f String -> f String
add_cmd_help p = case richness of
Standard
-> id
Enriched _ len
-> fmap (\cmd -> let h = p cmd >>= unChunk . infoProgDesc
in maybe cmd (\h' -> cmd ++ "\t" ++ render_line len h') h)
show_names :: [OptName] -> [String]
show_names = filter_names . map showOption
-- We only want to show a single line in the completion results description.
-- If there was a line break, it would come across as a different completion
-- possibility.
render_line :: Int -> Doc -> String
render_line len doc = case lines (displayS (renderPretty 1 len doc) "") of
[] -> ""
[x] -> x
x : _ -> x ++ "..."
filter_names :: [String] -> [String]
filter_names = filter is_completion
run_completer :: Completer -> IO [String]
run_completer c = runCompleter c (fromMaybe "" (listToMaybe ws''))
(ws', ws'') = splitAt i ws
is_completion :: String -> Bool
is_completion =
case ws'' of
w:_ -> isPrefixOf w
_ -> const True
bashCompletionScript :: String -> String -> IO [String]
bashCompletionScript prog progn = return
[ "_" ++ progn ++ "()"
, "{"
, " local CMDLINE"
, " 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[@]}\") )"
, "}"
, ""
, "complete -o filenames -F _" ++ progn ++ " " ++ progn ]
{-
/Note/: Fish Shell
Derived from Drezil's post in #169.
@
commandline
-c or --cut-at-cursor only print selection up until the current cursor position
-o or --tokenize tokenize the selection and print one string-type token per line
@
We tokenize so that the call to count (and hence --bash-completion-index)
gets the right number use cut-at-curstor to not bother sending anything
after the cursor position, which allows for completion of the middle of
words.
Tab characters separate items from descriptions.
-}
fishCompletionScript :: String -> String -> IO [String]
fishCompletionScript prog progn = return
[ " function _" ++ progn
, " set -l cl (commandline --tokenize --current-process)"
, " # 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"
, " for arg in $cl"
, " set tmpline $tmpline --bash-completion-word $arg"
, " end"
, " for opt in (" ++ prog ++ " $tmpline)"
, " if test -d $opt"
, " echo -E \"$opt/\""
, " else"
, " echo -E \"$opt\""
, " end"
, " end"
, "end"
, ""
, "complete --no-files --command " ++ progn ++ " --arguments '(_" ++ progn ++ ")'"
]
zshCompletionScript :: String -> String -> IO [String]
zshCompletionScript prog progn = return
[ "#compdef " ++ progn
, ""
, "local request"
, "local completions"
, "local word"
, "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[@]}\" ))"
, ""
, "for word in $completions; do"
, " local -a parts"
, ""
, " # Split the line at a tab if there is one."
, " IFS=$'\\t' parts=($( echo $word ))"
, ""
, " 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"
, " else"
, " compadd -f -- $word"
, " fi"
, "done"
]