{-# 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 a :: String
a) = "VALUE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a
show (CompleteFile a :: String
a b :: String
b) = "FILE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
show (CompleteDir a :: String
a b :: String
b) = "DIR " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
showList :: [Complete] -> ShowS
showList xs :: [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 a :: String
a (CompleteFile b :: String
b c :: String
c) = String -> String -> Complete
CompleteFile (String
aString -> ShowS
forall a. [a] -> [a] -> [a]
++String
b) String
c
prepend a :: String
a (CompleteDir b :: String
b c :: String
c) = String -> String -> Complete
CompleteDir (String
aString -> ShowS
forall a. [a] -> [a] -> [a]
++String
b) String
c
prepend a :: String
a (CompleteValue b :: 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_ :: Mode a
mode_ args_ :: [String]
args_ (i :: Int
i,_) = [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
(seen :: [String]
seen,next :: [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]
++ [""]
(mode :: Mode a
mode,args :: [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 m :: Mode a
m (x :: String
x:xs :: [String]
xs) | Just m2 :: 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 m :: Mode a
m xs :: [String]
xs = (Mode a
m,[String]
xs)
pickBy :: (a -> [String]) -> String -> [a] -> Maybe a
pickBy :: (a -> [String]) -> String -> [a] -> Maybe a
pickBy f :: a -> [String]
f name :: String
name xs :: [a]
xs = (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\x :: 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 (\x :: 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 m :: 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 0) (Mode a -> [Flag a]
forall a. Mode a -> [Flag a]
modeFlags Mode a
m)
first xs :: [String]
xs = Int -> [String] -> String -> [Complete]
norm 0 [String]
xs
norm :: Int -> [String] -> String -> [Complete]
norm i :: 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 i :: Int
i ("--":xs :: [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 i :: Int
i (('-':'-':x :: String
x):xs :: [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 (a :: String
a,b :: 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
== '=') String
x
flg :: Flag a
flg = String -> Flag a
getFlag String
a
norm i :: Int
i (('-':x :: Char
x:y :: String
y):xs :: [String]
xs) = case Flag a -> FlagInfo
forall a. Flag a -> FlagInfo
flagInfo Flag a
flg of
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
_ | "=" 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 -> 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 i :: Int
i (x :: String
x:xs :: [String]
xs) = Int -> [String] -> String -> [Complete]
norm (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [String]
xs
val :: Int -> Flag a -> [String] -> String -> [Complete]
val i :: Int
i flg :: Flag a
flg [] = Flag a -> String -> [Complete]
forall a. Flag a -> String -> [Complete]
expectVal Flag a
flg
val i :: Int
i flg :: Flag a
flg (x :: String
x:xs :: [String]
xs) = Int -> [String] -> String -> [Complete]
norm Int
i [String]
xs
argsPick :: Int -> Maybe (Arg a)
argsPick i :: Int
i = let (lst :: [Arg a]
lst,end :: 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 x :: 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 "") (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 :: [Mode a]
mode arg :: Maybe (Arg a)
arg flag :: [Flag a]
flag x :: String
x =
(if "-" 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 arg :: Maybe (Arg a)
arg flag :: [Flag a]
flag x :: String
x
| "-" 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
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "-", 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 :: [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 Nothing x :: String
x = []
expectArg (Just arg :: Arg a
arg) x :: 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 :: [Flag a]
flag x :: String
x
| (a :: String
a,_:b :: 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
== '=') 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
Nothing -> []
Just flg :: 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]
++ "=")) ([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 x :: String
x = "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ['-' | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
expectVal :: Flag a -> String -> [Complete]
expectVal :: Flag a -> String -> [Complete]
expectVal flg :: 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 xs :: [[String]]
xs x :: 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 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 typ :: String
typ x :: String
x = case String
typ of
"FILE" -> [String -> String -> Complete
CompleteFile "" String
x]
"DIR" -> [String -> String -> Complete
CompleteDir "" String
x]
"FILE/DIR" -> [String -> String -> Complete
CompleteFile "" String
x, String -> String -> Complete
CompleteDir "" String
x]
"DIR/FILE" -> [String -> String -> Complete
CompleteDir "" String
x, String -> String -> Complete
CompleteFile "" String
x]
'[':s :: String
s | "]" 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
_ -> []
completeBash :: String -> [String]
completeBash :: String -> [String]
completeBash prog :: String
prog =
["# Completion for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prog
,"# Generated by CmdArgs: http://community.haskell.org/~ndm/cmdargs/"
,"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prog String -> ShowS
forall a. [a] -> [a] -> [a]
++ "()"
,"{"
," # local CMDARGS_DEBUG=1 # uncomment to debug this script"
,""
," COMPREPLY=()"
," function add { COMPREPLY[((${#COMPREPLY[@]} + 1))]=$1 ; }"
," IFS=$'\\n\\r'"
,""
," export CMDARGS_COMPLETE=$((${COMP_CWORD} - 1))"
," result=`" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prog String -> ShowS
forall a. [a] -> [a] -> [a]
++ " ${COMP_WORDS[@]:1}`"
,""
," if [ -n $CMDARGS_DEBUG ]; then"
," echo Call \\(${COMP_WORDS[@]:1}, $CMDARGS_COMPLETE\\) > cmdargs.tmp"
," echo $result >> cmdargs.tmp"
," fi"
," unset CMDARGS_COMPLETE"
," unset CMDARGS_COMPLETE_POS"
,""
," for x in $result ; do"
," case $x in"
," VALUE\\ *)"
," add ${x:6}"
," ;;"
," FILE\\ *)"
," local prefix=`expr match \"${x:5}\" '\\([^ ]*\\)'`"
," local match=`expr match \"${x:5}\" '[^ ]* \\(.*\\)'`"
," for x in `compgen -f -- \"$match\"`; do"
," add $prefix$x"
," done"
," ;;"
," DIR\\ *)"
," local prefix=`expr match \"${x:4}\" '\\([^ ]*\\)'`"
," local match=`expr match \"${x:4}\" '[^ ]* \\(.*\\)'`"
," for x in `compgen -d -- \"$match\"`; do"
," add $prefix$x"
," done"
," ;;"
," esac"
," done"
," unset IFS"
,""
," if [ -n $CMDARGS_DEBUG ]; then"
," echo echo COMPREPLY: ${#COMPREPLY[@]} = ${COMPREPLY[@]} >> cmdargs.tmp"
," fi"
,"}"
,"complete -o bashdefault -F _" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prog String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prog
]
completeZsh :: String -> [String]
completeZsh :: String -> [String]
completeZsh _ = ["echo TODO: help add Zsh completions to cmdargs programs"]