-- | 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,

    bashCompletionScript,
    fishCompletionScript,
    zshCompletionScript,
  ) 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 (Richness -> Richness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Richness -> Richness -> Bool
$c/= :: Richness -> Richness -> Bool
== :: Richness -> Richness -> Bool
$c== :: Richness -> Richness -> Bool
Eq, Eq Richness
Richness -> Richness -> Bool
Richness -> Richness -> Ordering
Richness -> Richness -> Richness
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Richness -> Richness -> Richness
$cmin :: Richness -> Richness -> Richness
max :: Richness -> Richness -> Richness
$cmax :: Richness -> Richness -> Richness
>= :: Richness -> Richness -> Bool
$c>= :: Richness -> Richness -> Bool
> :: Richness -> Richness -> Bool
$c> :: Richness -> Richness -> Bool
<= :: Richness -> Richness -> Bool
$c<= :: Richness -> Richness -> Bool
< :: Richness -> Richness -> Bool
$c< :: Richness -> Richness -> Bool
compare :: Richness -> Richness -> Ordering
$ccompare :: Richness -> Richness -> Ordering
Ord, Int -> Richness -> ShowS
[Richness] -> ShowS
Richness -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Richness] -> ShowS
$cshowList :: [Richness] -> ShowS
show :: Richness -> String
$cshow :: Richness -> String
showsPrec :: Int -> Richness -> ShowS
$cshowsPrec :: Int -> Richness -> ShowS
Show)

bashCompletionParser :: ParserInfo a -> ParserPrefs -> Parser CompletionResult
bashCompletionParser :: forall a. ParserInfo a -> ParserPrefs -> Parser CompletionResult
bashCompletionParser ParserInfo a
pinfo ParserPrefs
pprefs = Parser CompletionResult
complParser
  where
    returnCompletions :: (String -> IO [String]) -> CompletionResult
returnCompletions String -> IO [String]
opts =
      (String -> IO String) -> CompletionResult
CompletionResult forall a b. (a -> b) -> a -> b
$
        \String
progn -> [String] -> String
unlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
opts String
progn

    scriptRequest :: ShowS -> CompletionResult
scriptRequest =
      (String -> IO String) -> CompletionResult
CompletionResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure

    complParser :: Parser CompletionResult
complParser = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ (String -> IO [String]) -> CompletionResult
returnCompletions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (  forall a.
ParserInfo a
-> ParserPrefs
-> Richness
-> [String]
-> Int
-> String
-> IO [String]
bashCompletionQuery ParserInfo a
pinfo ParserPrefs
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.
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall a. a -> Mod FlagFields a -> Parser a
flag' Int -> Int -> Richness
Enriched (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"bash-completion-enriched" forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a. Mod f a
internal)
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"bash-completion-option-desc-length" forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a. Mod f a
internal forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
40)
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"bash-completion-command-desc-length" forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a. Mod f a
internal forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
40)
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Richness
Standard
          )
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. IsString s => Mod OptionFields s -> Parser s
strOption) (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"bash-completion-word"
                                  forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a. Mod f a
internal)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"bash-completion-index" forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a. Mod f a
internal) )

      , ShowS -> CompletionResult
scriptRequest forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
bashCompletionScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"bash-completion-script" forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a. Mod f a
internal)
      , ShowS -> CompletionResult
scriptRequest forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
fishCompletionScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"fish-completion-script" forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a. Mod f a
internal)
      , ShowS -> CompletionResult
scriptRequest forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
zshCompletionScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"zsh-completion-script" forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a. Mod f a
internal)
      ]

bashCompletionQuery :: ParserInfo a -> ParserPrefs -> Richness -> [String] -> Int -> String -> IO [String]
bashCompletionQuery :: forall a.
ParserInfo a
-> ParserPrefs
-> Richness
-> [String]
-> Int
-> String
-> IO [String]
bashCompletionQuery ParserInfo a
pinfo ParserPrefs
pprefs Richness
richness [String]
ws Int
i String
_ = case forall r.
Completion r
-> ParserPrefs -> Maybe (Either (SomeParser, ArgPolicy) Completer)
runCompletion Completion a
compl ParserPrefs
pprefs of
  Just (Left (SomeParser Parser a
p, ArgPolicy
a))
    -> forall {a}. ArgPolicy -> Parser a -> IO [String]
list_options ArgPolicy
a Parser a
p
  Just (Right Completer
c)
    -> Completer -> IO [String]
run_completer Completer
c
  Maybe (Either (SomeParser, ArgPolicy) Completer)
Nothing
    -> forall (m :: * -> *) a. Monad m => a -> m a
return []
  where
    compl :: Completion a
compl = forall (m :: * -> *) a. MonadP m => ParserInfo a -> [String] -> m a
runParserInfo ParserInfo a
pinfo (forall a. Int -> [a] -> [a]
drop Int
1 [String]
ws')

    list_options :: ArgPolicy -> Parser a -> IO [String]
list_options ArgPolicy
a
      = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a.
(forall x. ArgumentReachability -> Option x -> b)
-> Parser a -> [b]
mapParser (forall {a}.
ArgPolicy -> ArgumentReachability -> Option a -> IO [String]
opt_completions ArgPolicy
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 -> ArgumentReachability -> Option a -> IO [String]
opt_completions ArgPolicy
argPolicy ArgumentReachability
reachability Option a
opt = case forall a. Option a -> OptReader a
optMain Option a
opt of
      OptReader [OptName]
ns CReader a
_ String -> ParseError
_
         | ArgPolicy
argPolicy forall a. Eq a => a -> a -> Bool
/= ArgPolicy
AllPositionals
        -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Functor f =>
Option a -> f String -> f String
add_opt_help Option a
opt forall a b. (a -> b) -> a -> b
$ [OptName] -> [String]
show_names [OptName]
ns
         | Bool
otherwise
        -> forall (m :: * -> *) a. Monad m => a -> m a
return []
      FlagReader [OptName]
ns a
_
         | ArgPolicy
argPolicy forall a. Eq a => a -> a -> Bool
/= ArgPolicy
AllPositionals
        -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Functor f =>
Option a -> f String -> f String
add_opt_help Option a
opt forall a b. (a -> b) -> a -> b
$ [OptName] -> [String]
show_names [OptName]
ns
         | Bool
otherwise
        -> forall (m :: * -> *) a. Monad m => a -> m a
return []
      ArgReader CReader a
rdr
         | ArgumentReachability -> Bool
argumentIsUnreachable ArgumentReachability
reachability
        -> forall (m :: * -> *) a. Monad m => a -> m a
return []
         | Bool
otherwise
        -> Completer -> IO [String]
run_completer (forall a. CReader a -> Completer
crCompleter CReader a
rdr)
      CmdReader Maybe String
_ [(String, ParserInfo a)]
ns
         | ArgumentReachability -> Bool
argumentIsUnreachable ArgumentReachability
reachability
        -> forall (m :: * -> *) a. Monad m => a -> m a
return []
         | Bool
otherwise
        -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Functor f =>
f (String, ParserInfo a) -> f String
with_cmd_help forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
is_completion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, ParserInfo a)]
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 :: forall (f :: * -> *) a.
Functor f =>
Option a -> f String -> f String
add_opt_help Option a
opt = case Richness
richness of
      Richness
Standard ->
        forall a. a -> a
id
      Enriched Int
len Int
_ ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \String
o ->
          let h :: Maybe Doc
h = forall a. Chunk a -> Maybe a
unChunk forall a b. (a -> b) -> a -> b
$ forall a. Option a -> Chunk Doc
optHelp Option a
opt
          in  forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
o (\Doc
h' -> String
o forall a. [a] -> [a] -> [a]
++ String
"\t" forall a. [a] -> [a] -> [a]
++ Int -> Doc -> String
render_line Int
len Doc
h') Maybe Doc
h

    -- When doing enriched completions, add the command description
    -- to the completion variables (tab separated).
    with_cmd_help :: Functor f => f (String, ParserInfo a) -> f String
    with_cmd_help :: forall (f :: * -> *) a.
Functor f =>
f (String, ParserInfo a) -> f String
with_cmd_help =
      case Richness
richness of
        Richness
Standard ->
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst
        Enriched Int
_ Int
len ->
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \(String
cmd, ParserInfo a
cmdInfo) ->
            let h :: Maybe Doc
h = forall a. Chunk a -> Maybe a
unChunk (forall a. ParserInfo a -> Chunk Doc
infoProgDesc ParserInfo a
cmdInfo)
            in  forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
cmd (\Doc
h' -> String
cmd forall a. [a] -> [a] -> [a]
++ String
"\t" forall a. [a] -> [a] -> [a]
++ Int -> Doc -> String
render_line Int
len Doc
h') Maybe Doc
h

    show_names :: [OptName] -> [String]
    show_names :: [OptName] -> [String]
show_names = forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
is_completion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map OptName -> String
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 :: Int -> Doc -> String
render_line Int
len Doc
doc = case String -> [String]
lines (Double -> Int -> Doc -> String
prettyString Double
1 Int
len Doc
doc) of
      [] -> String
""
      [String
x] -> String
x
      String
x : [String]
_ -> String
x forall a. [a] -> [a] -> [a]
++ String
"..."

    run_completer :: Completer -> IO [String]
    run_completer :: Completer -> IO [String]
run_completer Completer
c = Completer -> String -> IO [String]
runCompleter Completer
c (forall a. a -> Maybe a -> a
fromMaybe String
"" (forall a. [a] -> Maybe a
listToMaybe [String]
ws''))

    ([String]
ws', [String]
ws'') = forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [String]
ws

    is_completion :: String -> Bool
    is_completion :: String -> Bool
is_completion =
      case [String]
ws'' of
        String
w:[String]
_ -> forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
w
        [String]
_ -> forall a b. a -> b -> a
const Bool
True

-- | Generated bash shell completion script
bashCompletionScript :: String -> String -> String
bashCompletionScript :: String -> ShowS
bashCompletionScript String
prog String
progn = [String] -> String
unlines
  [ String
"_" forall a. [a] -> [a] -> [a]
++ String
progn forall a. [a] -> [a] -> [a]
++ String
"()"
  , String
"{"
  , String
"    local CMDLINE"
  , String
"    local IFS=$'\\n'"
  , String
"    CMDLINE=(--bash-completion-index $COMP_CWORD)"
  , String
""
  , String
"    for arg in ${COMP_WORDS[@]}; do"
  , String
"        CMDLINE=(${CMDLINE[@]} --bash-completion-word $arg)"
  , String
"    done"
  , String
""
  , String
"    COMPREPLY=( $(" forall a. [a] -> [a] -> [a]
++ String
prog forall a. [a] -> [a] -> [a]
++ String
" \"${CMDLINE[@]}\") )"
  , String
"}"
  , String
""
  , String
"complete -o filenames -F _" forall a. [a] -> [a] -> [a]
++ String
progn forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
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.
-}

-- | Generated fish shell completion script 
fishCompletionScript :: String -> String -> String
fishCompletionScript :: String -> ShowS
fishCompletionScript String
prog String
progn = [String] -> String
unlines
  [ String
" function _" forall a. [a] -> [a] -> [a]
++ String
progn
  , String
"    set -l cl (commandline --tokenize --current-process)"
  , String
"    # Hack around fish issue #3934"
  , String
"    set -l cn (commandline --tokenize --cut-at-cursor --current-process)"
  , String
"    set -l cn (count $cn)"
  , String
"    set -l tmpline --bash-completion-enriched --bash-completion-index $cn"
  , String
"    for arg in $cl"
  , String
"      set tmpline $tmpline --bash-completion-word $arg"
  , String
"    end"
  , String
"    for opt in (" forall a. [a] -> [a] -> [a]
++ String
prog forall a. [a] -> [a] -> [a]
++ String
" $tmpline)"
  , String
"      if test -d $opt"
  , String
"        echo -E \"$opt/\""
  , String
"      else"
  , String
"        echo -E \"$opt\""
  , String
"      end"
  , String
"    end"
  , String
"end"
  , String
""
  , String
"complete --no-files --command " forall a. [a] -> [a] -> [a]
++ String
progn forall a. [a] -> [a] -> [a]
++ String
" --arguments '(_"  forall a. [a] -> [a] -> [a]
++ String
progn forall a. [a] -> [a] -> [a]
++  String
")'"
  ]

-- | Generated zsh shell completion script
zshCompletionScript :: String -> String -> String
zshCompletionScript :: String -> ShowS
zshCompletionScript String
prog String
progn = [String] -> String
unlines
  [ String
"#compdef " forall a. [a] -> [a] -> [a]
++ String
progn
  , String
""
  , String
"local request"
  , String
"local completions"
  , String
"local word"
  , String
"local index=$((CURRENT - 1))"
  , String
""
  , String
"request=(--bash-completion-enriched --bash-completion-index $index)"
  , String
"for arg in ${words[@]}; do"
  , String
"  request=(${request[@]} --bash-completion-word $arg)"
  , String
"done"
  , String
""
  , String
"IFS=$'\\n' completions=($( " forall a. [a] -> [a] -> [a]
++ String
prog forall a. [a] -> [a] -> [a]
++ String
" \"${request[@]}\" ))"
  , String
""
  , String
"for word in $completions; do"
  , String
"  local -a parts"
  , String
""
  , String
"  # Split the line at a tab if there is one."
  , String
"  IFS=$'\\t' parts=($( echo $word ))"
  , String
""
  , String
"  if [[ -n $parts[2] ]]; then"
  , String
"     if [[ $word[1] == \"-\" ]]; then"
  , String
"       local desc=(\"$parts[1] ($parts[2])\")"
  , String
"       compadd -d desc -- $parts[1]"
  , String
"     else"
  , String
"       local desc=($(print -f  \"%-019s -- %s\" $parts[1] $parts[2]))"
  , String
"       compadd -l -d desc -- $parts[1]"
  , String
"     fi"
  , String
"  else"
  , String
"    compadd -f -- $word"
  , String
"  fi"
  , String
"done"
  ]