1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
{-# 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 (Eq,Ord)
instance Show Complete where
show (CompleteValue a) = "VALUE " ++ a
show (CompleteFile a b) = "FILE " ++ a ++ " " ++ b
show (CompleteDir a b) = "DIR " ++ a ++ " " ++ b
showList xs = showString $ unlines (map show xs)
prepend :: String -> Complete -> Complete
prepend a (CompleteFile b c) = CompleteFile (a++b) c
prepend a (CompleteDir b c) = CompleteDir (a++b) c
prepend a (CompleteValue b) = CompleteValue (a++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 mode_ args_ (i,_) = nub $ followArgs mode args now
where
(seen,next) = splitAt i args_
now = head $ next ++ [""]
(mode,args) = followModes mode_ seen
-- | Given a mode and some arguments, try and drill down into the mode
followModes :: Mode a -> [String] -> (Mode a, [String])
followModes m (x:xs) | Just m2 <- pickBy modeNames x $ modeModes m = followModes m2 xs
followModes m xs = (m,xs)
pickBy :: (a -> [String]) -> String -> [a] -> Maybe a
pickBy f name xs = find (\x -> name `elem` f x) xs `mplus`
find (\x -> any (name `isPrefixOf`) (f x)) xs
-- | Follow args deals with all seen arguments, then calls on to deal with the next one
followArgs :: Mode a -> [String] -> (String -> [Complete])
followArgs m = first
where
first [] = expectArgFlagMode (modeModes m) (argsPick 0) (modeFlags m)
first xs = norm 0 xs
-- i is the number of arguments that have gone past
norm i [] = expectArgFlag (argsPick i) (modeFlags m)
norm i ("--":xs) = expectArg $ argsPick (i + length xs)
norm i (('-':'-':x):xs) | null b, flagInfo flg == FlagReq = val i flg xs
| otherwise = norm i xs
where (a,b) = break (== '=') x
flg = getFlag a
norm i (('-':x:y):xs) = case flagInfo flg of
FlagReq | null y -> val i flg xs
| otherwise -> norm i xs
FlagOpt{} -> norm i xs
_ | "=" `isPrefixOf` y -> norm i xs
| null y -> norm i xs
| otherwise -> norm i (('-':y):xs)
where flg = getFlag [x]
norm i (x:xs) = norm (i+1) xs
val i flg [] = expectVal flg
val i flg (x:xs) = norm i xs
argsPick i = let (lst,end) = modeArgs m in if i < length lst then Just $ lst !! i else end
-- if you can't find the flag, pick one that is FlagNone (has all the right fallback)
getFlag x = fromMaybe (flagNone [] id "") $ pickBy flagNames x $ modeFlags m
expectArgFlagMode :: [Mode a] -> Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlagMode mode arg flag x =
(if "-" `isPrefixOf` x then [] else expectMode mode x) ++
expectArgFlag arg flag x
expectArgFlag :: Maybe (Arg a) -> [Flag a] -> String -> [Complete]
expectArgFlag arg flag x
| "-" `isPrefixOf` x = expectFlag flag x ++ [CompleteValue "-" | x == "-", isJust arg]
| otherwise = expectArg arg x ++ expectFlag flag x
expectMode :: [Mode a] -> String -> [Complete]
expectMode mode = expectStrings (map modeNames mode)
expectArg :: Maybe (Arg a) -> String -> [Complete]
expectArg Nothing x = []
expectArg (Just arg) x = expectFlagHelp (argType arg) x
expectFlag :: [Flag a] -> String -> [Complete]
expectFlag flag x
| (a,_:b) <- break (== '=') x = case pickBy (map f . flagNames) a flag of
Nothing -> []
Just flg -> map (prepend (a ++ "=")) $ expectVal flg b
| otherwise = expectStrings (map (map f . flagNames) flag) x
where f x = "-" ++ ['-' | length x > 1] ++ x
expectVal :: Flag a -> String -> [Complete]
expectVal flg = expectFlagHelp (flagType flg)
expectStrings :: [[String]] -> String -> [Complete]
expectStrings xs x = map CompleteValue $ concatMap (take 1 . filter (x `isPrefixOf`)) xs
expectFlagHelp :: FlagHelp -> String -> [Complete]
expectFlagHelp typ x = case typ of
"FILE" -> [CompleteFile "" x]
"DIR" -> [CompleteDir "" x]
"FILE/DIR" -> [CompleteFile "" x, CompleteDir "" x]
"DIR/FILE" -> [CompleteDir "" x, CompleteFile "" x]
'[':s | "]" `isSuffixOf` s -> expectFlagHelp (init s) x
_ -> []
---------------------------------------------------------------------
-- BASH SCRIPT
completeBash :: String -> [String]
completeBash prog =
["# Completion for " ++ prog
,"# Generated by CmdArgs: http://community.haskell.org/~ndm/cmdargs/"
,"_" ++ prog ++ "()"
,"{"
," # 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=`" ++ prog ++ " ${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 _" ++ prog ++ " " ++ prog
]
---------------------------------------------------------------------
-- ZSH SCRIPT
completeZsh :: String -> [String]
completeZsh _ = ["echo TODO: help add Zsh completions to cmdargs programs"]
|
