Revision 51c3d88f htools/Ganeti/HTools/CLI.hs
b/htools/Ganeti/HTools/CLI.hs | ||
---|---|---|
31 | 31 |
( Options(..) |
32 | 32 |
, OptType |
33 | 33 |
, parseOpts |
34 |
, parseOptsInner |
|
34 | 35 |
, parseYesNo |
35 | 36 |
, parseISpecString |
36 | 37 |
, shTemplate |
... | ... | |
427 | 428 |
usageInfo (printf "%s %s\nUsage: %s [OPTION...]" |
428 | 429 |
progname Version.version progname) |
429 | 430 |
|
431 |
-- | Show the program version info. |
|
432 |
versionInfo :: String -> String |
|
433 |
versionInfo progname = |
|
434 |
printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n" |
|
435 |
progname Version.version compilerName |
|
436 |
(Data.Version.showVersion compilerVersion) |
|
437 |
os arch |
|
438 |
|
|
430 | 439 |
-- | Command line parser, using the 'Options' structure. |
431 | 440 |
parseOpts :: [String] -- ^ The command line arguments |
432 | 441 |
-> String -- ^ The program name |
... | ... | |
434 | 443 |
-> IO (Options, [String]) -- ^ The resulting options and leftover |
435 | 444 |
-- arguments |
436 | 445 |
parseOpts argv progname options = |
446 |
case parseOptsInner argv progname options of |
|
447 |
Left (code, msg) -> do |
|
448 |
hPutStr (if code == 0 then stdout else stderr) msg |
|
449 |
exitWith (if code == 0 then ExitSuccess else ExitFailure code) |
|
450 |
Right result -> |
|
451 |
return result |
|
452 |
|
|
453 |
-- | Inner parse options. The arguments are similar to 'parseOpts', |
|
454 |
-- but it returns either a 'Left' composed of exit code and message, |
|
455 |
-- or a 'Right' for the success case. |
|
456 |
parseOptsInner :: [String] -> String -> [OptType] |
|
457 |
-> Either (Int, String) (Options, [String]) |
|
458 |
parseOptsInner argv progname options = |
|
437 | 459 |
case getOpt Permute options argv of |
438 | 460 |
(o, n, []) -> |
439 |
do |
|
440 |
let (pr, args) = (foldM (flip id) defaultOptions o, n) |
|
441 |
po <- case pr of |
|
442 |
Bad msg -> do |
|
443 |
hPutStrLn stderr "Error while parsing command\ |
|
444 |
\line arguments:" |
|
445 |
hPutStrLn stderr msg |
|
446 |
exitWith $ ExitFailure 1 |
|
447 |
Ok val -> return val |
|
448 |
when (optShowHelp po) $ do |
|
449 |
putStr $ usageHelp progname options |
|
450 |
exitWith ExitSuccess |
|
451 |
when (optShowVer po) $ do |
|
452 |
printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n" |
|
453 |
progname Version.version |
|
454 |
compilerName (Data.Version.showVersion compilerVersion) |
|
455 |
os arch :: IO () |
|
456 |
exitWith ExitSuccess |
|
457 |
return (po, args) |
|
458 |
(_, _, errs) -> do |
|
459 |
hPutStrLn stderr $ "Command line error: " ++ concat errs |
|
460 |
hPutStrLn stderr $ usageHelp progname options |
|
461 |
exitWith $ ExitFailure 2 |
|
461 |
let (pr, args) = (foldM (flip id) defaultOptions o, n) |
|
462 |
in case pr of |
|
463 |
Bad msg -> Left (1, "Error while parsing command\ |
|
464 |
\line arguments:\n" ++ msg ++ "\n") |
|
465 |
Ok po -> |
|
466 |
select (Right (po, args)) |
|
467 |
[ (optShowHelp po, Left (0, usageHelp progname options)) |
|
468 |
, (optShowVer po, Left (0, versionInfo progname)) |
|
469 |
] |
|
470 |
(_, _, errs) -> |
|
471 |
Left (2, "Command line error: " ++ concat errs ++ "\n" ++ |
|
472 |
usageHelp progname options) |
|
462 | 473 |
|
463 | 474 |
-- | A shell script template for autogenerated scripts. |
464 | 475 |
shTemplate :: String |
Also available in: Unified diff