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
data Richness
= Standard
| Enriched Int Int
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
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)
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
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
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
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
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 ]
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
")'"
]
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"
]