Commit 51c3d88f authored by Iustin Pop's avatar Iustin Pop
Browse files

Split CLI.parseOpts into IO/non-IO parts



This will allow unittesting the CLI options much more easily. The
patch also fixes an inconsistency: usage help was displayed with an
extra new line in the error case (but not in --help).
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarRené Nussbaumer <rn@google.com>
parent a7ea861a
......@@ -31,6 +31,7 @@ module Ganeti.HTools.CLI
( Options(..)
, OptType
, parseOpts
, parseOptsInner
, parseYesNo
, parseISpecString
, shTemplate
......@@ -427,6 +428,14 @@ usageHelp progname =
usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
progname Version.version progname)
-- | Show the program version info.
versionInfo :: String -> String
versionInfo progname =
printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
progname Version.version compilerName
(Data.Version.showVersion compilerVersion)
os arch
-- | Command line parser, using the 'Options' structure.
parseOpts :: [String] -- ^ The command line arguments
-> String -- ^ The program name
......@@ -434,31 +443,33 @@ parseOpts :: [String] -- ^ The command line arguments
-> IO (Options, [String]) -- ^ The resulting options and leftover
-- arguments
parseOpts argv progname options =
case parseOptsInner argv progname options of
Left (code, msg) -> do
hPutStr (if code == 0 then stdout else stderr) msg
exitWith (if code == 0 then ExitSuccess else ExitFailure code)
Right result ->
return result
-- | Inner parse options. The arguments are similar to 'parseOpts',
-- but it returns either a 'Left' composed of exit code and message,
-- or a 'Right' for the success case.
parseOptsInner :: [String] -> String -> [OptType]
-> Either (Int, String) (Options, [String])
parseOptsInner argv progname options =
case getOpt Permute options argv of
(o, n, []) ->
do
let (pr, args) = (foldM (flip id) defaultOptions o, n)
po <- case pr of
Bad msg -> do
hPutStrLn stderr "Error while parsing command\
\line arguments:"
hPutStrLn stderr msg
exitWith $ ExitFailure 1
Ok val -> return val
when (optShowHelp po) $ do
putStr $ usageHelp progname options
exitWith ExitSuccess
when (optShowVer po) $ do
printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
progname Version.version
compilerName (Data.Version.showVersion compilerVersion)
os arch :: IO ()
exitWith ExitSuccess
return (po, args)
(_, _, errs) -> do
hPutStrLn stderr $ "Command line error: " ++ concat errs
hPutStrLn stderr $ usageHelp progname options
exitWith $ ExitFailure 2
let (pr, args) = (foldM (flip id) defaultOptions o, n)
in case pr of
Bad msg -> Left (1, "Error while parsing command\
\line arguments:\n" ++ msg ++ "\n")
Ok po ->
select (Right (po, args))
[ (optShowHelp po, Left (0, usageHelp progname options))
, (optShowVer po, Left (0, versionInfo progname))
]
(_, _, errs) ->
Left (2, "Command line error: " ++ concat errs ++ "\n" ++
usageHelp progname options)
-- | A shell script template for autogenerated scripts.
shTemplate :: String
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment