| 42 |
42 |
, parseYesNo
|
| 43 |
43 |
, parseOpts
|
| 44 |
44 |
, parseOptsInner
|
|
45 |
, parseOptsCmds
|
|
46 |
, genericMainCmds
|
| 45 |
47 |
) where
|
| 46 |
48 |
|
| 47 |
49 |
import Control.Monad (foldM)
|
| 48 |
50 |
import Data.Char (toLower)
|
| 49 |
|
import Data.List (intercalate, stripPrefix)
|
|
51 |
import Data.List (intercalate, stripPrefix, sortBy)
|
| 50 |
52 |
import Data.Maybe (fromMaybe)
|
|
53 |
import Data.Ord (comparing)
|
| 51 |
54 |
import qualified Data.Version
|
| 52 |
55 |
import System.Console.GetOpt
|
|
56 |
import System.Environment
|
| 53 |
57 |
import System.Exit
|
| 54 |
58 |
import System.Info
|
| 55 |
59 |
import System.IO
|
| 56 |
60 |
import Text.Printf (printf)
|
| 57 |
61 |
|
| 58 |
62 |
import Ganeti.BasicTypes
|
|
63 |
import qualified Ganeti.Constants as C
|
| 59 |
64 |
import qualified Ganeti.Version as Version (version)
|
| 60 |
65 |
|
| 61 |
66 |
-- | Parameter type.
|
| ... | ... | |
| 189 |
194 |
parsed_value <- conversion_fn string_opt
|
| 190 |
195 |
updater_fn parsed_value opts)
|
| 191 |
196 |
|
|
197 |
-- | Max command length when formatting command list output.
|
|
198 |
maxCmdLen :: Int
|
|
199 |
maxCmdLen = 60
|
|
200 |
|
|
201 |
-- | Formats usage for a multi-personality program.
|
|
202 |
formatCmdUsage :: (StandardOptions a) => String -> PersonalityList a -> String
|
|
203 |
formatCmdUsage prog personalities =
|
|
204 |
let mlen = min maxCmdLen . maximum $ map (length . fst) personalities
|
|
205 |
sorted = sortBy (comparing fst) personalities
|
|
206 |
header = [ printf "Usage: %s {command} [options...] [argument...]" prog
|
|
207 |
, printf "%s <command> --help to see details, or man %s"
|
|
208 |
prog prog
|
|
209 |
, ""
|
|
210 |
, "Commands:"
|
|
211 |
]
|
|
212 |
rows = map (\(cmd, _) ->
|
|
213 |
printf " %-*s" mlen cmd::String) sorted
|
|
214 |
in unlines $ header ++ rows
|
|
215 |
|
|
216 |
-- | Displays usage for a program and exits.
|
|
217 |
showCmdUsage :: (StandardOptions a) =>
|
|
218 |
String -- ^ Program name
|
|
219 |
-> PersonalityList a -- ^ Personality list
|
|
220 |
-> Bool -- ^ Whether the exit code is success or not
|
|
221 |
-> IO b
|
|
222 |
showCmdUsage prog personalities success = do
|
|
223 |
let usage = formatCmdUsage prog personalities
|
|
224 |
putStr usage
|
|
225 |
if success
|
|
226 |
then exitSuccess
|
|
227 |
else exitWith $ ExitFailure C.exitFailure
|
|
228 |
|
| 192 |
229 |
-- | Command line parser, using a generic 'Options' structure.
|
| 193 |
230 |
parseOpts :: (StandardOptions a) =>
|
| 194 |
231 |
a -- ^ The default options
|
| ... | ... | |
| 206 |
243 |
Right result ->
|
| 207 |
244 |
return result
|
| 208 |
245 |
|
|
246 |
-- | Command line parser, for programs with sub-commands.
|
|
247 |
parseOptsCmds :: (StandardOptions a) =>
|
|
248 |
a -- ^ The default options
|
|
249 |
-> [String] -- ^ The command line arguments
|
|
250 |
-> String -- ^ The program name
|
|
251 |
-> PersonalityList a -- ^ The supported commands
|
|
252 |
-> [GenericOptType a] -- ^ Generic options
|
|
253 |
-> IO (a, [String], a -> [String] -> IO ())
|
|
254 |
-- ^ The resulting options and leftover arguments
|
|
255 |
parseOptsCmds defaults argv progname personalities genopts = do
|
|
256 |
let usage = showCmdUsage progname personalities
|
|
257 |
check c = case c of
|
|
258 |
-- hardcoded option strings here!
|
|
259 |
"--version" -> putStrLn (versionInfo progname) >> exitSuccess
|
|
260 |
"--help" -> usage True
|
|
261 |
_ -> return c
|
|
262 |
(cmd, cmd_args) <- case argv of
|
|
263 |
cmd:cmd_args -> do
|
|
264 |
cmd' <- check cmd
|
|
265 |
return (cmd', cmd_args)
|
|
266 |
[] -> usage False
|
|
267 |
case cmd `lookup` personalities of
|
|
268 |
Nothing -> usage False
|
|
269 |
Just (mainfn, optdefs, argdefs) -> do
|
|
270 |
optdefs' <- optdefs
|
|
271 |
(opts, args) <- parseOpts defaults cmd_args progname
|
|
272 |
(optdefs' ++ genopts) argdefs
|
|
273 |
return (opts, args, mainfn)
|
|
274 |
|
| 209 |
275 |
-- | Inner parse options. The arguments are similar to 'parseOpts',
|
| 210 |
276 |
-- but it returns either a 'Left' composed of exit code and message,
|
| 211 |
277 |
-- or a 'Right' for the success case.
|
| ... | ... | |
| 236 |
302 |
(_, _, errs) ->
|
| 237 |
303 |
Left (ExitFailure 2, "Command line error: " ++ concat errs ++ "\n" ++
|
| 238 |
304 |
usageHelp progname options)
|
|
305 |
|
|
306 |
-- | Parse command line options and execute the main function of a
|
|
307 |
-- multi-personality binary.
|
|
308 |
genericMainCmds :: (StandardOptions a) =>
|
|
309 |
a
|
|
310 |
-> PersonalityList a
|
|
311 |
-> [GenericOptType a]
|
|
312 |
-> IO ()
|
|
313 |
genericMainCmds defaults personalities genopts = do
|
|
314 |
cmd_args <- getArgs
|
|
315 |
prog <- getProgName
|
|
316 |
(opts, args, fn) <-
|
|
317 |
parseOptsCmds defaults cmd_args prog personalities genopts
|
|
318 |
fn opts args
|