This defines the arguments supported and then modifies the --help-completion output to include them too.
Signed-off-by: Iustin Pop <[email protected]> --- htest/Test/Ganeti/Common.hs | 13 +++++++------ htest/Test/Ganeti/Daemon.hs | 2 +- htest/Test/Ganeti/HTools/CLI.hs | 4 ++-- htools/Ganeti/Common.hs | 11 +++++++---- htools/Ganeti/Daemon.hs | 2 +- htools/Ganeti/HTools/CLI.hs | 1 + htools/Ganeti/HTools/Program.hs | 16 +++++++++------- htools/Ganeti/HTools/Program/Hail.hs | 11 ++++++++++- htools/Ganeti/HTools/Program/Hbal.hs | 14 ++++++++++---- htools/Ganeti/HTools/Program/Hcheck.hs | 11 ++++++++++- htools/Ganeti/HTools/Program/Hinfo.hs | 11 ++++++++++- htools/Ganeti/HTools/Program/Hscan.hs | 11 ++++++++++- htools/Ganeti/HTools/Program/Hspace.hs | 11 ++++++++++- htools/htools.hs | 5 +++-- 14 files changed, 91 insertions(+), 32 deletions(-) diff --git a/htest/Test/Ganeti/Common.hs b/htest/Test/Ganeti/Common.hs index 37d975d..4f0f1ae 100644 --- a/htest/Test/Ganeti/Common.hs +++ b/htest/Test/Ganeti/Common.hs @@ -64,7 +64,7 @@ checkOpt repr defaults failfn eqcheck valfn cmdarg:_ -> case parseOptsInner defaults ["--" ++ cmdarg ++ maybe "" ("=" ++) (repr val)] - "prog" [opt] of + "prog" [opt] [] of Left e -> failfn $ "Failed to parse option '" ++ cmdarg ++ ": " ++ show e Right (options, _) -> eqcheck ("Wrong value in option " ++ @@ -83,8 +83,8 @@ passFailOpt defaults failfn passfn let prefix = "--" ++ head longs ++ "=" good_cmd = prefix ++ good bad_cmd = prefix ++ bad in - case (parseOptsInner defaults [bad_cmd] "prog" [opt], - parseOptsInner defaults [good_cmd] "prog" [opt]) of + case (parseOptsInner defaults [bad_cmd] "prog" [opt] [], + parseOptsInner defaults [good_cmd] "prog" [opt] []) of (Left _, Right _) -> passfn (Right _, Right _) -> failfn $ "Command line '" ++ bad_cmd ++ "' succeeded when it shouldn't" @@ -97,10 +97,11 @@ passFailOpt defaults failfn passfn -- | Helper to test that a given option is accepted OK with quick exit. checkEarlyExit :: (StandardOptions a) => - a -> String -> [GenericOptType a] -> Assertion -checkEarlyExit defaults name options = + a -> String -> [GenericOptType a] -> [ArgCompletion] + -> Assertion +checkEarlyExit defaults name options arguments = mapM_ (\param -> - case parseOptsInner defaults [param] name options of + case parseOptsInner defaults [param] name options arguments of Left (code, _) -> assertEqual ("Program " ++ name ++ " returns invalid code " ++ show code ++ diff --git a/htest/Test/Ganeti/Daemon.hs b/htest/Test/Ganeti/Daemon.hs index b2c6688..e883e39 100644 --- a/htest/Test/Ganeti/Daemon.hs +++ b/htest/Test/Ganeti/Daemon.hs @@ -76,7 +76,7 @@ case_wrong_arg = -- | Test that the option list supports some common options. case_stdopts :: Assertion case_stdopts = - checkEarlyExit defaultOptions "prog" [oShowHelp, oShowVer] + checkEarlyExit defaultOptions "prog" [oShowHelp, oShowVer] [] testSuite "Daemon" [ 'prop_string_arg diff --git a/htest/Test/Ganeti/HTools/CLI.hs b/htest/Test/Ganeti/HTools/CLI.hs index 78b6fa5..bfcd451 100644 --- a/htest/Test/Ganeti/HTools/CLI.hs +++ b/htest/Test/Ganeti/HTools/CLI.hs @@ -118,8 +118,8 @@ case_wrong_arg = -- | Test that all binaries support some common options. case_stdopts :: Assertion case_stdopts = - mapM_ (\(name, (_, o)) -> checkEarlyExit defaultOptions name - (o ++ genericOpts)) Program.personalities + mapM_ (\(name, (_, o, a)) -> checkEarlyExit defaultOptions name + (o ++ genericOpts) a) Program.personalities testSuite "HTools/CLI" [ 'prop_parseISpec diff --git a/htools/Ganeti/Common.hs b/htools/Ganeti/Common.hs index 1485a91..94e256d 100644 --- a/htools/Ganeti/Common.hs +++ b/htools/Ganeti/Common.hs @@ -183,10 +183,11 @@ parseOpts :: (StandardOptions a) => -> [String] -- ^ The command line arguments -> String -- ^ The program name -> [GenericOptType a] -- ^ The supported command line options + -> [ArgCompletion] -- ^ The supported command line arguments -> IO (a, [String]) -- ^ The resulting options and -- leftover arguments -parseOpts defaults argv progname options = - case parseOptsInner defaults argv progname options of +parseOpts defaults argv progname options arguments = + case parseOptsInner defaults argv progname options arguments of Left (code, msg) -> do hPutStr (if code == ExitSuccess then stdout else stderr) msg exitWith code @@ -201,8 +202,9 @@ parseOptsInner :: (StandardOptions a) => -> [String] -> String -> [GenericOptType a] + -> [ArgCompletion] -> Either (ExitCode, String) (a, [String]) -parseOptsInner defaults argv progname options = +parseOptsInner defaults argv progname options arguments = case getOpt Permute (map fst options) argv of (opts, args, []) -> case foldM (flip id) defaults opts of @@ -216,7 +218,8 @@ parseOptsInner defaults argv progname options = , (verRequested parsed, Left (ExitSuccess, versionInfo progname)) , (compRequested parsed, - Left (ExitSuccess, completionInfo progname options [])) + Left (ExitSuccess, completionInfo progname options + arguments)) ] (_, _, errs) -> Left (ExitFailure 2, "Command line error: " ++ concat errs ++ "\n" ++ diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs index 1a53086..43187ed 100644 --- a/htools/Ganeti/Daemon.hs +++ b/htools/Ganeti/Daemon.hs @@ -176,7 +176,7 @@ genericOpts = [ oShowHelp parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String]) parseArgs cmd options = do cmd_args <- getArgs - parseOpts defaultOptions cmd_args cmd $ options ++ genericOpts + parseOpts defaultOptions cmd_args cmd (options ++ genericOpts) [] -- * Daemon-related functions -- | PID file mode. diff --git a/htools/Ganeti/HTools/CLI.hs b/htools/Ganeti/HTools/CLI.hs index 67b51a1..542a584 100644 --- a/htools/Ganeti/HTools/CLI.hs +++ b/htools/Ganeti/HTools/CLI.hs @@ -526,6 +526,7 @@ genericOpts = [ oShowVer parseOpts :: [String] -- ^ The command line arguments -> String -- ^ The program name -> [OptType] -- ^ The supported command line options + -> [ArgCompletion] -- ^ The supported command line arguments -> IO (Options, [String]) -- ^ The resulting options and leftover -- arguments parseOpts = Common.parseOpts defaultOptions diff --git a/htools/Ganeti/HTools/Program.hs b/htools/Ganeti/HTools/Program.hs index 75870e6..fff678c 100644 --- a/htools/Ganeti/HTools/Program.hs +++ b/htools/Ganeti/HTools/Program.hs @@ -27,6 +27,7 @@ module Ganeti.HTools.Program ( personalities ) where +import Ganeti.Common (ArgCompletion) import Ganeti.HTools.CLI (OptType, Options) import qualified Ganeti.HTools.Program.Hail as Hail @@ -37,11 +38,12 @@ import qualified Ganeti.HTools.Program.Hspace as Hspace import qualified Ganeti.HTools.Program.Hinfo as Hinfo -- | Supported binaries. -personalities :: [(String, (Options -> [String] -> IO (), [OptType]))] -personalities = [ ("hail", (Hail.main, Hail.options)) - , ("hbal", (Hbal.main, Hbal.options)) - , ("hcheck", (Hcheck.main, Hcheck.options)) - , ("hscan", (Hscan.main, Hscan.options)) - , ("hspace", (Hspace.main, Hspace.options)) - , ("hinfo", (Hinfo.main, Hinfo.options)) +personalities :: [(String, + (Options -> [String] -> IO (), [OptType], [ArgCompletion]))] +personalities = [ ("hail", (Hail.main, Hail.options, Hail.arguments)) + , ("hbal", (Hbal.main, Hbal.options, Hbal.arguments)) + , ("hcheck", (Hcheck.main, Hcheck.options, Hcheck.arguments)) + , ("hscan", (Hscan.main, Hscan.options, Hscan.arguments )) + , ("hspace", (Hspace.main, Hspace.options, Hspace.arguments)) + , ("hinfo", (Hinfo.main, Hinfo.options, Hinfo.arguments)) ] diff --git a/htools/Ganeti/HTools/Program/Hail.hs b/htools/Ganeti/HTools/Program/Hail.hs index 3bc5e2c..cb334f1 100644 --- a/htools/Ganeti/HTools/Program/Hail.hs +++ b/htools/Ganeti/HTools/Program/Hail.hs @@ -23,7 +23,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} -module Ganeti.HTools.Program.Hail (main, options) where +module Ganeti.HTools.Program.Hail + ( main + , options + , arguments + ) where import Control.Monad import Data.Maybe (fromMaybe, isJust) @@ -32,6 +36,7 @@ import System.Exit import qualified Ganeti.HTools.Cluster as Cluster +import Ganeti.Common import Ganeti.HTools.CLI import Ganeti.HTools.IAlloc import Ganeti.HTools.Loader (Request(..), ClusterData(..)) @@ -47,6 +52,10 @@ options = , oVerbose ] +-- | The list of arguments supported by the program. +arguments :: [ArgCompletion] +arguments = [ArgCompletion OptComplFile 1 (Just 1)] + wrapReadRequest :: Options -> [String] -> IO Request wrapReadRequest opts args = do when (null args) $ do diff --git a/htools/Ganeti/HTools/Program/Hbal.hs b/htools/Ganeti/HTools/Program/Hbal.hs index 90a056e..9c68e57 100644 --- a/htools/Ganeti/HTools/Program/Hbal.hs +++ b/htools/Ganeti/HTools/Program/Hbal.hs @@ -24,10 +24,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} module Ganeti.HTools.Program.Hbal - ( main - , options - , iterateDepth - ) where + ( main + , options + , arguments + , iterateDepth + ) where import Control.Concurrent (threadDelay) import Control.Exception (bracket) @@ -48,6 +49,7 @@ import qualified Ganeti.HTools.Group as Group import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Instance as Instance +import Ganeti.Common import Ganeti.HTools.CLI import Ganeti.HTools.ExtLoader import Ganeti.HTools.Types @@ -88,6 +90,10 @@ options = , oSaveCluster ] +-- | The list of arguments supported by the program. +arguments :: [ArgCompletion] +arguments = [] + {- | Start computing the solution at the given depth and recurse until we find a valid solution or we exceed the maximum depth. diff --git a/htools/Ganeti/HTools/Program/Hcheck.hs b/htools/Ganeti/HTools/Program/Hcheck.hs index a400d7f..260a0df 100644 --- a/htools/Ganeti/HTools/Program/Hcheck.hs +++ b/htools/Ganeti/HTools/Program/Hcheck.hs @@ -23,7 +23,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} -module Ganeti.HTools.Program.Hcheck (main, options) where +module Ganeti.HTools.Program.Hcheck + ( main + , options + , arguments + ) where import Control.Monad import Data.List (transpose) @@ -39,6 +43,7 @@ import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.Program.Hbal as Hbal +import Ganeti.Common import Ganeti.HTools.CLI import Ganeti.HTools.ExtLoader import Ganeti.HTools.Loader @@ -71,6 +76,10 @@ options = , oVerbose ] +-- | The list of arguments supported by the program. +arguments :: [ArgCompletion] +arguments = [] + -- | Check phase - are we before (initial) or after rebalance. data Phase = Initial | Rebalanced diff --git a/htools/Ganeti/HTools/Program/Hinfo.hs b/htools/Ganeti/HTools/Program/Hinfo.hs index 2c5200e..b2b47b4 100644 --- a/htools/Ganeti/HTools/Program/Hinfo.hs +++ b/htools/Ganeti/HTools/Program/Hinfo.hs @@ -23,7 +23,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} -module Ganeti.HTools.Program.Hinfo (main, options) where +module Ganeti.HTools.Program.Hinfo + ( main + , options + , arguments + ) where import Control.Monad import Data.List @@ -38,6 +42,7 @@ import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Group as Group import qualified Ganeti.HTools.Instance as Instance +import Ganeti.Common import Ganeti.HTools.CLI import Ganeti.HTools.ExtLoader import Ganeti.HTools.Loader @@ -57,6 +62,10 @@ options = , oOfflineNode ] +-- | The list of arguments supported by the program. +arguments :: [ArgCompletion] +arguments = [] + -- | Group information data-type. data GroupInfo = GroupInfo { giName :: String , giNodeCount :: Int diff --git a/htools/Ganeti/HTools/Program/Hscan.hs b/htools/Ganeti/HTools/Program/Hscan.hs index 44a9559..b160e5d 100644 --- a/htools/Ganeti/HTools/Program/Hscan.hs +++ b/htools/Ganeti/HTools/Program/Hscan.hs @@ -23,7 +23,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} -module Ganeti.HTools.Program.Hscan (main, options) where +module Ganeti.HTools.Program.Hscan + ( main + , options + , arguments + ) where import Control.Monad import Data.Maybe (isJust, fromJust, fromMaybe) @@ -43,6 +47,7 @@ import qualified Ganeti.Path as Path import Ganeti.HTools.Loader (checkData, mergeData, ClusterData(..)) import Ganeti.HTools.Text (serializeCluster) +import Ganeti.Common import Ganeti.HTools.CLI import Ganeti.HTools.Types @@ -56,6 +61,10 @@ options = , oNoHeaders ] +-- | The list of arguments supported by the program. +arguments :: [ArgCompletion] +arguments = [ArgCompletion OptComplHost 0 Nothing] + -- | Return a one-line summary of cluster state. printCluster :: Node.List -> Instance.List -> String diff --git a/htools/Ganeti/HTools/Program/Hspace.hs b/htools/Ganeti/HTools/Program/Hspace.hs index 605b4ff..33e7e94 100644 --- a/htools/Ganeti/HTools/Program/Hspace.hs +++ b/htools/Ganeti/HTools/Program/Hspace.hs @@ -23,7 +23,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} -module Ganeti.HTools.Program.Hspace (main, options) where +module Ganeti.HTools.Program.Hspace + (main + , options + , arguments + ) where import Control.Monad import Data.Char (toUpper, toLower) @@ -40,6 +44,7 @@ import qualified Ganeti.HTools.Cluster as Cluster import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Instance as Instance +import Ganeti.Common import Ganeti.HTools.Types import Ganeti.HTools.CLI import Ganeti.HTools.ExtLoader @@ -69,6 +74,10 @@ options = , oSaveCluster ] +-- | The list of arguments supported by the program. +arguments :: [ArgCompletion] +arguments = [] + -- | The allocation phase we're in (initial, after tiered allocs, or -- after regular allocation). data Phase = PInitial diff --git a/htools/htools.hs b/htools/htools.hs index 216fe3f..f90b676 100644 --- a/htools/htools.hs +++ b/htools/htools.hs @@ -57,7 +57,8 @@ main = do boolnames = map (\(x, y) -> (x == name, Just y)) personalities case select Nothing boolnames of Nothing -> usage name - Just (fn, options) -> do + Just (fn, options, arguments) -> do cmd_args <- getArgs - (opts, args) <- parseOpts cmd_args name $ options ++ genericOpts + (opts, args) <- parseOpts cmd_args name (options ++ genericOpts) + arguments fn opts args -- 1.7.10.4
