{-# LANGUAGE PatternGuards #-}
module System.Console.CmdArgs.Explicit.Complete(
Complete(..), complete,
completeBash, completeZsh
) where
import System.Console.CmdArgs.Explicit.Type
import Control.Monad
import Data.List
import Data.Maybe
data Complete
= CompleteValue String
| CompleteFile String FilePath
| CompleteDir String FilePath
deriving (Complete -> Complete -> Bool
(Complete -> Complete -> Bool)
-> (Complete -> Complete -> Bool) -> Eq Complete
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Complete -> Complete -> Bool
$c/= :: Complete -> Complete -> Bool
== :: Complete -> Complete -> Bool
$c== :: Complete -> Complete -> Bool
Eq,Eq Complete
Eq Complete
-> (Complete -> Complete -> Ordering)
-> (Complete -> Complete -> Bool)
-> (Complete -> Complete -> Bool)
-> (Complete -> Complete -> Bool)
-> (Complete -> Complete -> Bool)
-> (Complete -> Complete -> Complete)
-> (Complete -> Complete -> Complete)
-> Ord Complete
Complete -> Complete -> Bool
Complete -> Complete -> Ordering
Complete -> Complete -> Complete
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 :: Complete -> Complete -> Complete
$cmin :: Complete -> Complete -> Complete
max :: Complete -> Complete -> Complete
$cmax :: Complete -> Complete -> Complete
>= :: Complete -> Complete -> Bool
$c>= :: Complete -> Complete -> Bool
> :: Complete -> Complete -> Bool
$c> :: Complete -> Complete -> Bool
<= :: Complete -> Complete -> Bool
$c<= :: Complete -> Complete -> Bool
< :: Complete -> Complete -> Bool
$c< :: Complete -> Complete -> Bool
compare :: Complete -> Complete -> Ordering
$ccompare :: Complete -> Complete -> Ordering
$cp1Ord :: Eq Complete
Ord)
instance Show Complete where
show :: Complete -> String
show (CompleteValue String
a) = String
"VALUE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a
show (CompleteFile String
a String
b) = String
"FILE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
show (CompleteDir String
a String
b) = String
"DIR " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
showList :: [Complete] -> ShowS
showList [Complete]
xs = String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ((Complete -> String) -> [Complete] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Complete -> String
forall a. Show a => a -> String
show [Complete]
xs)
prepend :: String -> Complete -> Complete
prepend :: String -> Complete -> Complete
prepend String
a (CompleteFile String
b String
c) = String -> String -> Complete
CompleteFile (String
aString -> ShowS
forall a. [a] -> [a] -> [a]
++String
b) String
c
prepend String
a (CompleteDir String
b String
c) = String -> String -> Complete
CompleteDir (String
aString -> ShowS
forall a. [a] -> [a] -> [a]
++String
b) String
c
prepend String
a (CompleteValue String
b) = String -> Complete
CompleteValue (String
aString -> ShowS
forall a. [a] -> [a] -> [a]
++String
b)
complete
:: Mode a
-> [String]
-> (Int,Int)
-> [Complete]
complete :: Mode a -> [String] -> (Int, Int) -> [Complete]
complete Mode a
mode_ [String]
args_ (Int
i,Int
_) = [Complete] -> [Complete]
forall a. Eq a => [a] -> [a]
nub ([Complete] -> [Complete]) -> [Complete] -> [Complete]
forall a b. (a -> b) -> a -> b
$ Mode a -> [String] -> String -> [Complete]
forall a. Mode a -> [String] -> String -> [Complete]
followArgs Mode a
mode [String]
args String
now
where
([String]
seen,[String]
next) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [String]
args_
now :: String
now = [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
next [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
""]
(Mode a
mode,[String]
args) = Mode a -> [String] -> (Mode a, [String])
forall a. Mode a -> [String] -> (Mode a, [String])
followModes Mode a
mode_ [String]
seen
followModes :: Mode a -> [String] -> (Mode a, [String])
followModes :: Mode a -> [String] -> (Mode a, [String])
followModes Mode a
m (String
x:[String]
xs) | Just Mode a
m2 <- (Mode a -> [String]) -> String -> [Mode a] -> Maybe (Mode a)
forall a. (a -> [String]) -> String -> [a] -> Maybe a
pickBy Mode a -> [String]
forall a. Mode a -> [String]
modeNames String
x ([Mode a] -> Maybe (Mode a)) -> [Mode a] -> Maybe (Mode a)
forall a b. (a -> b) -> a -> b
$ Mode a -> [Mode a]
forall a. Mode a -> [Mode a]
modeModes Mode a
m = Mode a -> [String] -> (Mode a, [String])
forall a. Mode a -> [String] -> (Mode a, [String])
followModes Mode a
m2 [String]
xs
followModes Mode a
m [String]
xs = (Mode a
m,[String]
xs)
pickBy :: (a -> [String]) -> String -> [a] -> Maybe a
pickBy :: (a -> [String]) -> String -> [a] -> Maybe a
pickBy a -> [String]
f String
name [a]
xs = (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\a
x -> String
name String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` a -> [String]
f a
x) [a]
xs Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
(a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\a
x -> (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
name String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) (a -> [String]
f a
x)) [a]
xs
followArgs :: Mode a -> [String] -> (String -> [Complete])
followArgs :: Mode a -> [String] -> String -> [Complete]
followArgs Mode a
m = [String] -> String -> [Complete]
first
where
first :: [String] -> String -> [Complete]
first [] = [Mode a] -> Maybe (Arg a) -> [Flag a] -> String -> [Complete]
forall a.
[Mode a] -> Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlagMode (Mode a -> [Mode a]
forall a. Mode a -> [Mode a]
modeModes Mode a
m) (Int -> Maybe (Arg a)
argsPick Int
0) (Mode a -> [Flag a]
forall a. Mode a -> [Flag a]
modeFlags Mode a
m)
first [String]
xs = Int -> [String] -> String -> [Complete]
norm Int
0 [String]
xs
norm :: Int -> [String] -> String -> [Complete]
norm Int
i [] = Maybe (Arg a) -> [Flag a] -> String -> [Complete]
forall a. Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlag (Int -> Maybe (Arg a)
argsPick Int
i) (Mode a -> [Flag a]
forall a. Mode a -> [Flag a]
modeFlags Mode a
m)
norm Int
i (String
"--":[String]
xs) = Maybe (Arg a) -> String -> [Complete]
forall a. Maybe (Arg a) -> String -> [Complete]
expectArg (Maybe (Arg a) -> String -> [Complete])
-> Maybe (Arg a) -> String -> [Complete]
forall a b. (a -> b) -> a -> b
$ Int -> Maybe (Arg a)
argsPick (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs)
norm Int
i ((Char
'-':Char
'-':String
x):[String]
xs) | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b, Flag a -> FlagInfo
forall a. Flag a -> FlagInfo
flagInfo Flag a
flg FlagInfo -> FlagInfo -> Bool
forall a. Eq a => a -> a -> Bool
== FlagInfo
FlagReq = Int -> Flag a -> [String] -> String -> [Complete]
val Int
i Flag a
flg [String]
xs
| Bool
otherwise = Int -> [String] -> String -> [Complete]
norm Int
i [String]
xs
where (String
a,String
b) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') String
x
flg :: Flag a
flg = String -> Flag a
getFlag String
a
norm Int
i ((Char
'-':Char
x:String
y):[String]
xs) = case Flag a -> FlagInfo
forall a. Flag a -> FlagInfo
flagInfo Flag a
flg of
FlagInfo
FlagReq | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
y -> Int -> Flag a -> [String] -> String -> [Complete]
val Int
i Flag a
flg [String]
xs
| Bool
otherwise -> Int -> [String] -> String -> [Complete]
norm Int
i [String]
xs
FlagOpt{} -> Int -> [String] -> String -> [Complete]
norm Int
i [String]
xs
FlagInfo
_ | String
"=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
y -> Int -> [String] -> String -> [Complete]
norm Int
i [String]
xs
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
y -> Int -> [String] -> String -> [Complete]
norm Int
i [String]
xs
| Bool
otherwise -> Int -> [String] -> String -> [Complete]
norm Int
i ((Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:String
y)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs)
where flg :: Flag a
flg = String -> Flag a
getFlag [Char
x]
norm Int
i (String
x:[String]
xs) = Int -> [String] -> String -> [Complete]
norm (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [String]
xs
val :: Int -> Flag a -> [String] -> String -> [Complete]
val Int
i Flag a
flg [] = Flag a -> String -> [Complete]
forall a. Flag a -> String -> [Complete]
expectVal Flag a
flg
val Int
i Flag a
flg (String
x:[String]
xs) = Int -> [String] -> String -> [Complete]
norm Int
i [String]
xs
argsPick :: Int -> Maybe (Arg a)
argsPick Int
i = let ([Arg a]
lst,Maybe (Arg a)
end) = Mode a -> ([Arg a], Maybe (Arg a))
forall a. Mode a -> ([Arg a], Maybe (Arg a))
modeArgs Mode a
m in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Arg a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Arg a]
lst then Arg a -> Maybe (Arg a)
forall a. a -> Maybe a
Just (Arg a -> Maybe (Arg a)) -> Arg a -> Maybe (Arg a)
forall a b. (a -> b) -> a -> b
$ [Arg a]
lst [Arg a] -> Int -> Arg a
forall a. [a] -> Int -> a
!! Int
i else Maybe (Arg a)
end
getFlag :: String -> Flag a
getFlag String
x = Flag a -> Maybe (Flag a) -> Flag a
forall a. a -> Maybe a -> a
fromMaybe ([String] -> (a -> a) -> String -> Flag a
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [] a -> a
forall a. a -> a
id String
"") (Maybe (Flag a) -> Flag a) -> Maybe (Flag a) -> Flag a
forall a b. (a -> b) -> a -> b
$ (Flag a -> [String]) -> String -> [Flag a] -> Maybe (Flag a)
forall a. (a -> [String]) -> String -> [a] -> Maybe a
pickBy Flag a -> [String]
forall a. Flag a -> [String]
flagNames String
x ([Flag a] -> Maybe (Flag a)) -> [Flag a] -> Maybe (Flag a)
forall a b. (a -> b) -> a -> b
$ Mode a -> [Flag a]
forall a. Mode a -> [Flag a]
modeFlags Mode a
m
expectArgFlagMode :: [Mode a] -> Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlagMode :: [Mode a] -> Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlagMode [Mode a]
mode Maybe (Arg a)
arg [Flag a]
flag String
x =
(if String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then [] else [Mode a] -> String -> [Complete]
forall a. [Mode a] -> String -> [Complete]
expectMode [Mode a]
mode String
x) [Complete] -> [Complete] -> [Complete]
forall a. [a] -> [a] -> [a]
++
Maybe (Arg a) -> [Flag a] -> String -> [Complete]
forall a. Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlag Maybe (Arg a)
arg [Flag a]
flag String
x
expectArgFlag :: Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlag :: Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlag Maybe (Arg a)
arg [Flag a]
flag String
x
| String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = [Flag a] -> String -> [Complete]
forall a. [Flag a] -> String -> [Complete]
expectFlag [Flag a]
flag String
x [Complete] -> [Complete] -> [Complete]
forall a. [a] -> [a] -> [a]
++ [String -> Complete
CompleteValue String
"-" | String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-", Maybe (Arg a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Arg a)
arg]
| Bool
otherwise = Maybe (Arg a) -> String -> [Complete]
forall a. Maybe (Arg a) -> String -> [Complete]
expectArg Maybe (Arg a)
arg String
x [Complete] -> [Complete] -> [Complete]
forall a. [a] -> [a] -> [a]
++ [Flag a] -> String -> [Complete]
forall a. [Flag a] -> String -> [Complete]
expectFlag [Flag a]
flag String
x
expectMode :: [Mode a] -> String -> [Complete]
expectMode :: [Mode a] -> String -> [Complete]
expectMode [Mode a]
mode = [[String]] -> String -> [Complete]
expectStrings ((Mode a -> [String]) -> [Mode a] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map Mode a -> [String]
forall a. Mode a -> [String]
modeNames [Mode a]
mode)
expectArg :: Maybe (Arg a) -> String -> [Complete]
expectArg :: Maybe (Arg a) -> String -> [Complete]
expectArg Maybe (Arg a)
Nothing String
x = []
expectArg (Just Arg a
arg) String
x = String -> String -> [Complete]
expectFlagHelp (Arg a -> String
forall a. Arg a -> String
argType Arg a
arg) String
x
expectFlag :: [Flag a] -> String -> [Complete]
expectFlag :: [Flag a] -> String -> [Complete]
expectFlag [Flag a]
flag String
x
| (String
a,Char
_:String
b) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') String
x = case (Flag a -> [String]) -> String -> [Flag a] -> Maybe (Flag a)
forall a. (a -> [String]) -> String -> [a] -> Maybe a
pickBy (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
f ([String] -> [String])
-> (Flag a -> [String]) -> Flag a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag a -> [String]
forall a. Flag a -> [String]
flagNames) String
a [Flag a]
flag of
Maybe (Flag a)
Nothing -> []
Just Flag a
flg -> (Complete -> Complete) -> [Complete] -> [Complete]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Complete -> Complete
prepend (String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=")) ([Complete] -> [Complete]) -> [Complete] -> [Complete]
forall a b. (a -> b) -> a -> b
$ Flag a -> String -> [Complete]
forall a. Flag a -> String -> [Complete]
expectVal Flag a
flg String
b
| Bool
otherwise = [[String]] -> String -> [Complete]
expectStrings ((Flag a -> [String]) -> [Flag a] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
f ([String] -> [String])
-> (Flag a -> [String]) -> Flag a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag a -> [String]
forall a. Flag a -> [String]
flagNames) [Flag a]
flag) String
x
where f :: ShowS
f String
x = String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'-' | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
expectVal :: Flag a -> String -> [Complete]
expectVal :: Flag a -> String -> [Complete]
expectVal Flag a
flg = String -> String -> [Complete]
expectFlagHelp (Flag a -> String
forall a. Flag a -> String
flagType Flag a
flg)
expectStrings :: [[String]] -> String -> [Complete]
expectStrings :: [[String]] -> String -> [Complete]
expectStrings [[String]]
xs String
x = (String -> Complete) -> [String] -> [Complete]
forall a b. (a -> b) -> [a] -> [b]
map String -> Complete
CompleteValue ([String] -> [Complete]) -> [String] -> [Complete]
forall a b. (a -> b) -> a -> b
$ ([String] -> [String]) -> [[String]] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
x String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)) [[String]]
xs
expectFlagHelp :: FlagHelp -> String -> [Complete]
expectFlagHelp :: String -> String -> [Complete]
expectFlagHelp String
typ String
x = case String
typ of
String
"FILE" -> [String -> String -> Complete
CompleteFile String
"" String
x]
String
"DIR" -> [String -> String -> Complete
CompleteDir String
"" String
x]
String
"FILE/DIR" -> [String -> String -> Complete
CompleteFile String
"" String
x, String -> String -> Complete
CompleteDir String
"" String
x]
String
"DIR/FILE" -> [String -> String -> Complete
CompleteDir String
"" String
x, String -> String -> Complete
CompleteFile String
"" String
x]
Char
'[':String
s | String
"]" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
s -> String -> String -> [Complete]
expectFlagHelp (ShowS
forall a. [a] -> [a]
init String
s) String
x
String
_ -> []
completeBash :: String -> [String]
completeBash :: String -> [String]
completeBash String
prog =
[String
"# Completion for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prog
,String
"# Generated by CmdArgs: http://community.haskell.org/~ndm/cmdargs/"
,String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prog String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"()"
,String
"{"
,String
" # local CMDARGS_DEBUG=1 # uncomment to debug this script"
,String
""
,String
" COMPREPLY=()"
,String
" function add { COMPREPLY[((${#COMPREPLY[@]} + 1))]=$1 ; }"
,String
" IFS=$'\\n\\r'"
,String
""
,String
" export CMDARGS_COMPLETE=$((${COMP_CWORD} - 1))"
,String
" result=`" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prog String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ${COMP_WORDS[@]:1}`"
,String
""
,String
" if [ -n $CMDARGS_DEBUG ]; then"
,String
" echo Call \\(${COMP_WORDS[@]:1}, $CMDARGS_COMPLETE\\) > cmdargs.tmp"
,String
" echo $result >> cmdargs.tmp"
,String
" fi"
,String
" unset CMDARGS_COMPLETE"
,String
" unset CMDARGS_COMPLETE_POS"
,String
""
,String
" for x in $result ; do"
,String
" case $x in"
,String
" VALUE\\ *)"
,String
" add ${x:6}"
,String
" ;;"
,String
" FILE\\ *)"
,String
" local prefix=`expr match \"${x:5}\" '\\([^ ]*\\)'`"
,String
" local match=`expr match \"${x:5}\" '[^ ]* \\(.*\\)'`"
,String
" for x in `compgen -f -- \"$match\"`; do"
,String
" add $prefix$x"
,String
" done"
,String
" ;;"
,String
" DIR\\ *)"
,String
" local prefix=`expr match \"${x:4}\" '\\([^ ]*\\)'`"
,String
" local match=`expr match \"${x:4}\" '[^ ]* \\(.*\\)'`"
,String
" for x in `compgen -d -- \"$match\"`; do"
,String
" add $prefix$x"
,String
" done"
,String
" ;;"
,String
" esac"
,String
" done"
,String
" unset IFS"
,String
""
,String
" if [ -n $CMDARGS_DEBUG ]; then"
,String
" echo echo COMPREPLY: ${#COMPREPLY[@]} = ${COMPREPLY[@]} >> cmdargs.tmp"
,String
" fi"
,String
"}"
,String
"complete -o bashdefault -F _" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prog String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prog
]
completeZsh :: String -> [String]
completeZsh :: String -> [String]
completeZsh String
_ = [String
"echo TODO: help add Zsh completions to cmdargs programs"]