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: Iustin Pop <iustin@google.com>
Reviewed-by: René Nussbaumer <rn@google.com>

htools/Ganeti/HTools/CLI.hs

@@ -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