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
|
{-
Sample renderings:
-- ONE MODE
Program description
programname [OPTIONS] FILE1 FILE2 [FILES]
Program to perform some action
-f --flag description
Flag grouping:
-a --another description
-- MANY MODES WITH ONE SHOWN
Program description
programname [COMMAND] [OPTIONS] ...
Program to perform some action
Commands:
[build] Build action here
test Test action here
Flags:
-s --special Special for the root only
Common flags:
-? --help Build action here
-- MANY MODES WITH ALL SHOWN
Program description
programname [COMMAND] [OPTIONS] ...
Program to perform some action
-s --special Special for the root only
Common flags:
-? --help Build action here
programname [build] [OPTIONS] [FILES}
Action to perform here
-}
module System.Console.CmdArgs.Explicit.Help(HelpFormat(..), helpText) where
import System.Console.CmdArgs.Explicit.Type
import System.Console.CmdArgs.Explicit.Complete
import System.Console.CmdArgs.Text
import System.Console.CmdArgs.Default
import Data.List
import Data.Maybe
-- | Specify the format to output the help.
data HelpFormat
= HelpFormatDefault -- ^ Equivalent to 'HelpFormatAll' if there is not too much text, otherwise 'HelpFormatOne'.
| HelpFormatOne -- ^ Display only the first mode.
| HelpFormatAll -- ^ Display all modes.
| HelpFormatBash -- ^ Bash completion information
| HelpFormatZsh -- ^ Z shell completion information
deriving (Read,Show,Enum,Bounded,Eq,Ord)
instance Default HelpFormat where def = HelpFormatDefault
instance Show (Mode a) where
show = show . helpTextDefault
instance Show (Flag a) where
show = show . helpFlag
instance Show (Arg a) where
show = show . argType
-- | Generate a help message from a mode. The first argument is a prefix,
-- which is prepended when not using 'HelpFormatBash' or 'HelpFormatZsh'.
helpText :: [String] -> HelpFormat -> Mode a -> [Text]
helpText pre HelpFormatDefault x = helpPrefix pre ++ helpTextDefault x
helpText pre HelpFormatOne x = helpPrefix pre ++ helpTextOne x
helpText pre HelpFormatAll x = helpPrefix pre ++ helpTextAll x
helpText pre HelpFormatBash x = map Line $ completeBash $ head $ modeNames x ++ ["unknown"]
helpText pre HelpFormatZsh x = map Line $ completeZsh $ head $ modeNames x ++ ["unknown"]
helpPrefix :: [String] -> [Text]
helpPrefix xs = map Line xs ++ [Line "" | not $ null xs]
helpTextDefault x = if length all > 40 then one else all
where all = helpTextAll x
one = helpTextOne x
-- | Help text for all modes
--
-- > <program> [OPTIONS] <file_args>
-- > <options>
-- > <program> MODE [SUBMODE] [OPTIONS] [FLAG]
helpTextAll :: Mode a -> [Text]
helpTextAll = disp . push ""
where
disp m = uncurry (++) (helpTextMode m) ++ concatMap (\x -> Line "" : disp x) (modeModes m)
push s m = m{modeNames = map (s++) $ modeNames m
,modeGroupModes = fmap (push s2) $ modeGroupModes m}
where s2 = s ++ concat (take 1 $ modeNames m) ++ " "
-- | Help text for only this mode
--
-- > <program> [OPTIONS] <file_args>
-- > <options>
-- > <program> MODE [FLAGS]
-- > <options>
helpTextOne :: Mode a -> [Text]
helpTextOne m = pre ++ ms ++ suf
where
(pre,suf) = helpTextMode m
ms = space $ [Line "Commands:" | not $ null $ groupUnnamed $ modeGroupModes m] ++ helpGroup f (modeGroupModes m)
f m = return $ cols [concat $ take 1 $ modeNames m, ' ' : modeHelp m]
helpTextMode :: Mode a -> ([Text], [Text])
helpTextMode x@Mode{modeGroupFlags=flags,modeGroupModes=modes} = (pre,suf)
where
pre = [Line $ unwords $ take 1 (modeNames x) ++
["[COMMAND] ..." | notNullGroup modes] ++
["[OPTIONS]" | not $ null $ fromGroup flags] ++
helpArgs (modeArgs x)] ++
[Line $ " " ++ modeHelp x | not $ null $ modeHelp x]
suf = space
([Line "Flags:" | mixedGroup flags] ++
helpGroup helpFlag (modeGroupFlags x)) ++
space (map Line $ modeHelpSuffix x)
helpGroup :: (a -> [Text]) -> Group a -> [Text]
helpGroup f xs = concatMap f (groupUnnamed xs) ++ concatMap g (groupNamed xs)
where g (a,b) = Line (a ++ ":") : concatMap f b
helpArgs :: ([Arg a], Maybe (Arg a)) -> [String]
helpArgs (ys,y) = [['['|o] ++ argType x ++ [']'|o] | (i,x) <- zip [0..] xs, let o = False && req <= i]
where xs = ys ++ maybeToList y
req = maximum $ 0 : [i | (i,x) <- zip [1..] xs, argRequire x]
helpFlag :: Flag a -> [Text]
helpFlag x = [cols [unwords $ map ("-"++) a2, unwords $ map ("--"++) b2, ' ' : flagHelp x]]
where
(a,b) = partition ((==) 1 . length) $ flagNames x
(a2,b2) = if null b then (add a opt, b) else (a, add b opt)
add x y = if null x then x else (head x ++ y) : tail x
hlp = if null (flagType x) then "ITEM" else flagType x
opt = case flagInfo x of
FlagReq -> '=' : hlp
FlagOpt x -> "[=" ++ hlp ++ "]"
_ -> ""
cols (x:xs) = Cols $ (" "++x) : map (' ':) xs
space xs = [Line "" | not $ null xs] ++ xs
nullGroup x = null (groupUnnamed x) && null (groupNamed x)
notNullGroup = not . nullGroup
mixedGroup x = not $ null (groupUnnamed x) || null (groupNamed x) -- has both unnamed and named
|
