diff --git a/Ganeti/HTools/CLI.hs b/Ganeti/HTools/CLI.hs
index 3d14b4df5dc50d385d2c74cb4851fa14fdeccda4..618eb1ef845bba6693d047bb1b780c97a7c61be9 100644
--- a/Ganeti/HTools/CLI.hs
+++ b/Ganeti/HTools/CLI.hs
@@ -7,10 +7,9 @@ and this is more IO oriented.
-}
module Ganeti.HTools.CLI
- (
- parseOpts
+ ( CLIOptions(..)
+ , parseOpts
, parseEnv
- , showVersion
, shTemplate
) where
@@ -25,23 +24,33 @@ import qualified Data.Version
import qualified Ganeti.HTools.Version as Version(version)
+-- | Class for types which support show help and show version
+class CLIOptions a where
+ showHelp :: a -> Bool
+ showVersion :: a -> Bool
+
-- | Command line parser, using the 'options' structure.
-parseOpts :: [String] -- ^ The command line arguments
+parseOpts :: (CLIOptions b) =>
+ [String] -- ^ The command line arguments
-> String -- ^ The program name
-> [OptDescr (b -> b)] -- ^ The supported command line options
-> b -- ^ The default options record
- -> (b -> Bool) -- ^ The function which given the options
- -- tells us whether we need to show help
-> IO (b, [String]) -- ^ The resulting options a leftover
-- arguments
-parseOpts argv progname options defaultOptions fn =
+parseOpts argv progname options defaultOptions =
case getOpt Permute options argv of
(o, n, []) ->
do
let resu@(po, _) = (foldl (flip id) defaultOptions o, n)
- when (fn po) $ do
+ when (showHelp po) $ do
putStr $ usageInfo header options
exitWith ExitSuccess
+ when (showVersion po) $ do
+ printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
+ progname Version.version
+ compilerName (Data.Version.showVersion compilerVersion)
+ os arch
+ exitWith ExitSuccess
return resu
(_, _, errs) ->
ioError (userError (concat errs ++ usageInfo header options))
@@ -56,15 +65,6 @@ parseEnv () = do
b <- getEnvDefault "HTOOLS_INSTANCES" "instances"
return (a, b)
--- | Return a version string for the program
-showVersion :: String -- ^ The program name
- -> String -- ^ The formatted version and other information data
-showVersion name =
- printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
- name Version.version
- compilerName (Data.Version.showVersion compilerVersion)
- os arch
-
-- | A shell script template for autogenerated scripts
shTemplate :: String
shTemplate =
diff --git a/hail.hs b/hail.hs
index bcaeb5e32d734f92b903fbe96cfaf6b732e7b85b..b375e16690b8b9596c4612c6afeb92b1b271300c 100644
--- a/hail.hs
+++ b/hail.hs
@@ -41,6 +41,10 @@ data Options = Options
, optShowHelp :: Bool -- ^ Just show the help
} deriving Show
+instance CLI.CLIOptions Options where
+ showVersion = optShowVer
+ showHelp = optShowHelp
+
-- | Default values for the command line options.
defaultOptions :: Options
defaultOptions = Options
@@ -163,11 +167,7 @@ main :: IO ()
main = do
cmd_args <- System.getArgs
(opts, args) <- CLI.parseOpts cmd_args "hail" options
- defaultOptions optShowHelp
-
- when (optShowVer opts) $ do
- putStr $ CLI.showVersion "hbal"
- exitWith ExitSuccess
+ defaultOptions
when (null args) $ do
hPutStrLn stderr "Error: this program needs an input file."
diff --git a/hbal.hs b/hbal.hs
index 4e09e080f37ad6c53bf0a186c1cab8dc9fa4f752..ca3c6ae3c7adb05aabfa8ebed1c5f4a9863be122 100644
--- a/hbal.hs
+++ b/hbal.hs
@@ -44,6 +44,10 @@ data Options = Options
, optShowHelp :: Bool -- ^ Just show the help
} deriving Show
+instance CLI.CLIOptions Options where
+ showVersion = optShowVer
+ showHelp = optShowHelp
+
-- | Default values for the command line options.
defaultOptions :: Options
defaultOptions = Options
@@ -165,17 +169,12 @@ formatOneline ini_cv plc_len fin_cv =
main :: IO ()
main = do
cmd_args <- System.getArgs
- (opts, args) <- CLI.parseOpts cmd_args "hbal" options
- defaultOptions optShowHelp
+ (opts, args) <- CLI.parseOpts cmd_args "hbal" options defaultOptions
unless (null args) $ do
hPutStrLn stderr "Error: this program doesn't take any arguments."
exitWith $ ExitFailure 1
- when (optShowVer opts) $ do
- putStr $ CLI.showVersion "hbal"
- exitWith ExitSuccess
-
(env_node, env_inst) <- CLI.parseEnv ()
let nodef = if optNodeSet opts then optNodef opts
else env_node
diff --git a/hn1.hs b/hn1.hs
index 3643e8dd1b556db819820ca1515be79ae2e44a98..b55249f5e6a73a6e60155c16d7fbe1454a9fde42 100644
--- a/hn1.hs
+++ b/hn1.hs
@@ -40,6 +40,10 @@ data Options = Options
, optShowHelp :: Bool -- ^ Just show the help
} deriving Show
+instance CLI.CLIOptions Options where
+ showVersion = optShowVer
+ showHelp = optShowHelp
+
-- | Default values for the command line options.
defaultOptions :: Options
defaultOptions = Options
@@ -130,16 +134,12 @@ main :: IO ()
main = do
cmd_args <- System.getArgs
(opts, args) <- CLI.parseOpts cmd_args "hn1" options
- defaultOptions optShowHelp
+ defaultOptions
unless (null args) $ do
hPutStrLn stderr "Error: this program doesn't take any arguments."
exitWith $ ExitFailure 1
- when (optShowVer opts) $ do
- putStr $ CLI.showVersion "hn1"
- exitWith ExitSuccess
-
(env_node, env_inst) <- CLI.parseEnv ()
let nodef = if optNodeSet opts then optNodef opts
else env_node
diff --git a/hscan.hs b/hscan.hs
index ec82023099de3b976499c4768b26d0b2fa50564d..061e19eb9cac41e1d11027285b1ee8ae1546840f 100644
--- a/hscan.hs
+++ b/hscan.hs
@@ -35,6 +35,10 @@ data Options = Options
, optShowHelp :: Bool -- ^ Just show the help
} deriving Show
+instance CLI.CLIOptions Options where
+ showVersion = optShowVer
+ showHelp = optShowHelp
+
-- | Default values for the command line options.
defaultOptions :: Options
defaultOptions = Options
@@ -141,11 +145,7 @@ main :: IO ()
main = do
cmd_args <- System.getArgs
(opts, clusters) <- CLI.parseOpts cmd_args "hscan" options
- defaultOptions optShowHelp
-
- when (optShowVer opts) $ do
- putStr $ CLI.showVersion "hscan"
- exitWith ExitSuccess
+ defaultOptions
let odir = optOutPath opts
nlen = maximum . map length $ clusters