{-# LANGUAGE PatternGuards #-}

-- | This module does command line completion
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


-- | How to complete a command line option.
--   The 'Show' instance is suitable for parsing from shell scripts.
data Complete
    = CompleteValue String -- ^ Complete to a particular value
    | CompleteFile String FilePath -- ^ Complete to a prefix, and a file
    | CompleteDir String FilePath -- ^ Complete to a prefix, and a directory
      deriving (Complete -> Complete -> Bool
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
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
Ord)

instance Show Complete where
    show :: Complete -> String
show (CompleteValue String
a) = String
"VALUE " forall a. [a] -> [a] -> [a]
++ String
a
    show (CompleteFile String
a String
b) = String
"FILE " forall a. [a] -> [a] -> [a]
++ String
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
b
    show (CompleteDir String
a String
b) = String
"DIR " forall a. [a] -> [a] -> [a]
++ String
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
b

    showList :: [Complete] -> ShowS
showList [Complete]
xs = String -> ShowS
showString forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map 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
aforall a. [a] -> [a] -> [a]
++String
b) String
c
prepend String
a (CompleteDir String
b String
c) = String -> String -> Complete
CompleteDir (String
aforall a. [a] -> [a] -> [a]
++String
b) String
c
prepend String
a (CompleteValue String
b) = String -> Complete
CompleteValue (String
aforall a. [a] -> [a] -> [a]
++String
b)


-- | Given a current state, return the set of commands you could type now, in preference order.
complete
    :: Mode a -- ^ Mode specifying which arguments are allowed
    -> [String] -- ^ Arguments the user has already typed
    -> (Int,Int) -- ^ 0-based index of the argument they are currently on, and the position in that argument
    -> [Complete]
-- Roll forward looking at modes, and if you match a mode, enter it
-- If the person just before is a flag without arg, look at how you can complete that arg
-- If your prefix is a complete flag look how you can complete that flag
-- If your prefix looks like a flag, look for legitimate flags
-- Otherwise give a file/dir if they are arguments to this mode, and all flags
-- If you haven't seen any args/flags then also autocomplete to any child modes
complete :: forall a. Mode a -> [String] -> (Int, Int) -> [Complete]
complete Mode a
mode_ [String]
args_ (Int
i,Int
_) = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [String] -> String -> [Complete]
followArgs Mode a
mode [String]
args String
now
    where
        ([String]
seen,[String]
next) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [String]
args_
        now :: String
now = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [String]
next forall a. [a] -> [a] -> [a]
++ [String
""]
        (Mode a
mode,[String]
args) = forall a. Mode a -> [String] -> (Mode a, [String])
followModes Mode a
mode_ [String]
seen


-- | Given a mode and some arguments, try and drill down into the mode
followModes :: Mode a -> [String] -> (Mode a, [String])
followModes :: forall a. Mode a -> [String] -> (Mode a, [String])
followModes Mode a
m (String
x:[String]
xs) | Just Mode a
m2 <- forall a. (a -> [String]) -> String -> [a] -> Maybe a
pickBy forall a. Mode a -> [String]
modeNames String
x forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [Mode a]
modeModes Mode a
m = 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 :: forall a. (a -> [String]) -> String -> [a] -> Maybe a
pickBy a -> [String]
f String
name [a]
xs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\a
x -> String
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` a -> [String]
f a
x) [a]
xs forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                   forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\a
x -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
name forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) (a -> [String]
f a
x)) [a]
xs


-- | Follow args deals with all seen arguments, then calls on to deal with the next one
followArgs :: Mode a -> [String] -> (String -> [Complete])
followArgs :: forall a. Mode a -> [String] -> String -> [Complete]
followArgs Mode a
m = [String] -> String -> [Complete]
first
    where
        first :: [String] -> String -> [Complete]
first [] = forall a.
[Mode a] -> Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlagMode (forall a. Mode a -> [Mode a]
modeModes Mode a
m) (Int -> Maybe (Arg a)
argsPick Int
0) (forall a. Mode a -> [Flag a]
modeFlags Mode a
m)
        first [String]
xs = Int -> [String] -> String -> [Complete]
norm Int
0 [String]
xs

        -- i is the number of arguments that have gone past
        norm :: Int -> [String] -> String -> [Complete]
norm Int
i [] = forall a. Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlag (Int -> Maybe (Arg a)
argsPick Int
i) (forall a. Mode a -> [Flag a]
modeFlags Mode a
m)
        norm Int
i (String
"--":[String]
xs) = forall a. Maybe (Arg a) -> String -> [Complete]
expectArg forall a b. (a -> b) -> a -> b
$ Int -> Maybe (Arg a)
argsPick (Int
i forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs)
        norm Int
i ((Char
'-':Char
'-':String
x):[String]
xs) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b, forall a. Flag a -> FlagInfo
flagInfo Flag a
flg 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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (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 forall a. Flag a -> FlagInfo
flagInfo Flag a
flg of
            FlagInfo
FlagReq | 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
"=" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
y -> Int -> [String] -> String -> [Complete]
norm Int
i [String]
xs
              | 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
'-'forall a. a -> [a] -> [a]
:String
y)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
iforall a. Num a => a -> a -> a
+Int
1) [String]
xs

        val :: Int -> Flag a -> [String] -> String -> [Complete]
val Int
i Flag a
flg [] = 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) = forall a. Mode a -> ([Arg a], Maybe (Arg a))
modeArgs Mode a
m in if Int
i forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [Arg a]
lst then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Arg a]
lst forall a. [a] -> Int -> a
!! Int
i else Maybe (Arg a)
end

        -- if you can't find the flag, pick one that is FlagNone (has all the right fallback)
        getFlag :: String -> Flag a
getFlag String
x = forall a. a -> Maybe a -> a
fromMaybe (forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [] forall a. a -> a
id String
"") forall a b. (a -> b) -> a -> b
$ forall a. (a -> [String]) -> String -> [a] -> Maybe a
pickBy forall a. Flag a -> [String]
flagNames String
x forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [Flag a]
modeFlags Mode a
m


expectArgFlagMode :: [Mode a] -> Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlagMode :: forall a.
[Mode a] -> Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlagMode [Mode a]
mode Maybe (Arg a)
arg [Flag a]
flag String
x =
    (if String
"-" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then [] else forall a. [Mode a] -> String -> [Complete]
expectMode [Mode a]
mode String
x) forall a. [a] -> [a] -> [a]
++
    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 :: forall a. Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlag Maybe (Arg a)
arg [Flag a]
flag String
x
    | String
"-" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = forall a. [Flag a] -> String -> [Complete]
expectFlag [Flag a]
flag String
x forall a. [a] -> [a] -> [a]
++ [String -> Complete
CompleteValue String
"-" | String
x forall a. Eq a => a -> a -> Bool
== String
"-", forall a. Maybe a -> Bool
isJust Maybe (Arg a)
arg]
    | Bool
otherwise = forall a. Maybe (Arg a) -> String -> [Complete]
expectArg Maybe (Arg a)
arg String
x forall a. [a] -> [a] -> [a]
++ forall a. [Flag a] -> String -> [Complete]
expectFlag [Flag a]
flag String
x

expectMode :: [Mode a] -> String -> [Complete]
expectMode :: forall a. [Mode a] -> String -> [Complete]
expectMode [Mode a]
mode = [[String]] -> String -> [Complete]
expectStrings (forall a b. (a -> b) -> [a] -> [b]
map forall a. Mode a -> [String]
modeNames [Mode a]
mode)

expectArg :: Maybe (Arg a) -> String -> [Complete]
expectArg :: forall a. Maybe (Arg a) -> String -> [Complete]
expectArg Maybe (Arg a)
Nothing String
x = []
expectArg (Just Arg a
arg) String
x = String -> String -> [Complete]
expectFlagHelp (forall a. Arg a -> String
argType Arg a
arg) String
x

expectFlag :: [Flag a] -> String -> [Complete]
expectFlag :: forall a. [Flag a] -> String -> [Complete]
expectFlag [Flag a]
flag String
x
    | (String
a,Char
_:String
b) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'=') String
x = case forall a. (a -> [String]) -> String -> [a] -> Maybe a
pickBy (forall a b. (a -> b) -> [a] -> [b]
map ShowS
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Flag a -> [String]
flagNames) String
a [Flag a]
flag of
        Maybe (Flag a)
Nothing -> []
        Just Flag a
flg -> forall a b. (a -> b) -> [a] -> [b]
map (String -> Complete -> Complete
prepend (String
a forall a. [a] -> [a] -> [a]
++ String
"=")) forall a b. (a -> b) -> a -> b
$ forall a. Flag a -> String -> [Complete]
expectVal Flag a
flg String
b
    | Bool
otherwise = [[String]] -> String -> [Complete]
expectStrings (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map ShowS
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Flag a -> [String]
flagNames) [Flag a]
flag) String
x
    where f :: ShowS
f String
x = String
"-" forall a. [a] -> [a] -> [a]
++ [Char
'-' | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x forall a. Ord a => a -> a -> Bool
> Int
1] forall a. [a] -> [a] -> [a]
++ String
x

expectVal :: Flag a -> String -> [Complete]
expectVal :: forall a. Flag a -> String -> [Complete]
expectVal Flag a
flg = String -> String -> [Complete]
expectFlagHelp (forall a. Flag a -> String
flagType Flag a
flg)

expectStrings :: [[String]] -> String -> [Complete]
expectStrings :: [[String]] -> String -> [Complete]
expectStrings [[String]]
xs String
x = forall a b. (a -> b) -> [a] -> [b]
map String -> Complete
CompleteValue forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (String
x 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
"]" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
s -> String -> String -> [Complete]
expectFlagHelp (forall a. [a] -> [a]
init String
s) String
x
    String
_ -> []


---------------------------------------------------------------------
-- BASH SCRIPT

completeBash :: String -> [String]
completeBash :: String -> [String]
completeBash String
prog =
    [String
"# Completion for " forall a. [a] -> [a] -> [a]
++ String
prog
    ,String
"# Generated by CmdArgs: http://community.haskell.org/~ndm/cmdargs/"
    ,String
"_" forall a. [a] -> [a] -> [a]
++ String
prog 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=`" forall a. [a] -> [a] -> [a]
++ String
prog 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 _" forall a. [a] -> [a] -> [a]
++ String
prog forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
prog
    ]


---------------------------------------------------------------------
-- ZSH SCRIPT

completeZsh :: String -> [String]
completeZsh :: String -> [String]
completeZsh String
_ = [String
"echo TODO: help add Zsh completions to cmdargs programs"]