From 75d1edf8fcba55aca62007190f016c2578a7c5c2 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Sat, 23 May 2009 01:34:54 +0100
Subject: [PATCH] Introduce a class for CLI options
This patch generalizes a little the CLI handling by not passing in a
special function for help and such, but instead requiring that the
options object supports some common functionality.
---
Ganeti/HTools/CLI.hs | 34 +++++++++++++++++-----------------
hail.hs | 10 +++++-----
hbal.hs | 11 +++++------
hn1.hs | 10 +++++-----
hscan.hs | 10 +++++-----
5 files changed, 37 insertions(+), 38 deletions(-)
diff --git a/Ganeti/HTools/CLI.hs b/Ganeti/HTools/CLI.hs
index 3d14b4df5..618eb1ef8 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 bcaeb5e32..b375e1669 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 4e09e080f..ca3c6ae3c 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 3643e8dd1..b55249f5e 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 ec8202309..061e19eb9 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
--
GitLab