diff --git a/htools/Ganeti/HTools/Program/Hail.hs b/htools/Ganeti/HTools/Program/Hail.hs index bb8f1fb699476778c463e7c32414eb2769645cf1..426def4babaa1ea705a3f71a93a43ff9cfa7c34f 100644 --- a/htools/Ganeti/HTools/Program/Hail.hs +++ b/htools/Ganeti/HTools/Program/Hail.hs @@ -4,7 +4,7 @@ {- -Copyright (C) 2009, 2010, 2011 Google Inc. +Copyright (C) 2009, 2010, 2011, 2012 Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -23,11 +23,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} -module Ganeti.HTools.Program.Hail (main) where +module Ganeti.HTools.Program.Hail (main, options) where import Control.Monad import Data.Maybe (fromMaybe) -import System.Environment (getArgs) import System.IO import qualified Ganeti.HTools.Cluster as Cluster @@ -50,11 +49,8 @@ options = ] -- | Main function. -main :: IO () -main = do - cmd_args <- getArgs - (opts, args) <- parseOpts cmd_args "hail" options - +main :: Options -> [String] -> IO () +main opts args = do let shownodes = optShowNodes opts verbose = optVerbose opts savecluster = optSaveCluster opts diff --git a/htools/Ganeti/HTools/Program/Hbal.hs b/htools/Ganeti/HTools/Program/Hbal.hs index 689e8aae3e59396f7d9f327d58be5e2d46dee367..30c3d61e8302bdebdf3bc3b43c96afe1abe40ae7 100644 --- a/htools/Ganeti/HTools/Program/Hbal.hs +++ b/htools/Ganeti/HTools/Program/Hbal.hs @@ -4,7 +4,7 @@ {- -Copyright (C) 2009, 2010, 2011 Google Inc. +Copyright (C) 2009, 2010, 2011, 2012 Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -23,7 +23,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} -module Ganeti.HTools.Program.Hbal (main) where +module Ganeti.HTools.Program.Hbal (main, options) where import Control.Concurrent (threadDelay) import Control.Exception (bracket) @@ -31,7 +31,6 @@ import Control.Monad import Data.List import Data.Maybe (isJust, isNothing, fromJust) import Data.IORef -import System.Environment (getArgs) import System.Exit import System.IO import System.Posix.Process @@ -338,11 +337,8 @@ checkNeedRebalance opts ini_cv = do exitWith ExitSuccess -- | Main function. -main :: IO () -main = do - cmd_args <- getArgs - (opts, args) <- parseOpts cmd_args "hbal" options - +main :: Options -> [String] -> IO () +main opts args = do unless (null args) $ do hPutStrLn stderr "Error: this program doesn't take any arguments." exitWith $ ExitFailure 1 diff --git a/htools/Ganeti/HTools/Program/Hscan.hs b/htools/Ganeti/HTools/Program/Hscan.hs index cac708f38c394fd8dfc7feb9ee25bdbd87f95d35..1324bd66198433ea6345ccc10630762e6bb1b2de 100644 --- a/htools/Ganeti/HTools/Program/Hscan.hs +++ b/htools/Ganeti/HTools/Program/Hscan.hs @@ -4,7 +4,7 @@ {- -Copyright (C) 2009, 2010, 2011 Google Inc. +Copyright (C) 2009, 2010, 2011, 2012 Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -23,7 +23,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} -module Ganeti.HTools.Program.Hscan (main) where +module Ganeti.HTools.Program.Hscan (main, options) where import Control.Monad import Data.Maybe (isJust, fromJust, fromMaybe) @@ -125,10 +125,8 @@ writeDataInner nlen name opts cdata fixdata = do return True -- | Main function. -main :: IO () -main = do - cmd_args <- getArgs - (opts, clusters) <- parseOpts cmd_args "hscan" options +main :: Options -> [String] -> IO () +main opts clusters = do let local = "LOCAL" let nlen = if null clusters diff --git a/htools/Ganeti/HTools/Program/Hspace.hs b/htools/Ganeti/HTools/Program/Hspace.hs index 48c6066c744effea170a094296158cc887a2b165..f4bd0d587ec47f83d14ec1e84c166e7cb3c476f0 100644 --- a/htools/Ganeti/HTools/Program/Hspace.hs +++ b/htools/Ganeti/HTools/Program/Hspace.hs @@ -23,7 +23,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} -module Ganeti.HTools.Program.Hspace (main) where +module Ganeti.HTools.Program.Hspace (main, options) where import Control.Monad import Data.Char (toUpper, isAlphaNum, toLower) @@ -33,7 +33,6 @@ import Data.Maybe (fromMaybe) import Data.Ord (comparing) import System.Exit import System.IO -import System.Environment (getArgs) import Text.Printf (printf, hPrintf) @@ -392,11 +391,8 @@ instFromSpec spx disk_template = (rspecCpu spx) Running [] True (-1) (-1) disk_template -- | Main function. -main :: IO () -main = do - cmd_args <- getArgs - (opts, args) <- parseOpts cmd_args "hspace" options - +main :: Options -> [String] -> IO () +main opts args = do unless (null args) $ do hPutStrLn stderr "Error: this program doesn't take any arguments." exitWith $ ExitFailure 1 diff --git a/htools/htools.hs b/htools/htools.hs index cf2e4a264c49055dbb3e8f895ff927d5af901f09..d33b96150aa5dfad9927bd3e6171055f63d92dde 100644 --- a/htools/htools.hs +++ b/htools/htools.hs @@ -4,7 +4,7 @@ {- -Copyright (C) 2011 Google Inc. +Copyright (C) 2011, 2012 Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -31,17 +31,18 @@ import System.Exit import System.IO import Ganeti.HTools.Utils +import Ganeti.HTools.CLI (OptType, Options, parseOpts) import qualified Ganeti.HTools.Program.Hail as Hail import qualified Ganeti.HTools.Program.Hbal as Hbal import qualified Ganeti.HTools.Program.Hscan as Hscan import qualified Ganeti.HTools.Program.Hspace as Hspace -- | Supported binaries. -personalities :: [(String, IO ())] -personalities = [ ("hail", Hail.main) - , ("hbal", Hbal.main) - , ("hscan", Hscan.main) - , ("hspace", Hspace.main) +personalities :: [(String, (Options -> [String] -> IO (), [OptType]))] +personalities = [ ("hail", (Hail.main, Hail.options)) + , ("hbal", (Hbal.main, Hbal.options)) + , ("hscan", (Hscan.main, Hscan.options)) + , ("hspace", (Hspace.main, Hspace.options)) ] -- | Display usage and exit. @@ -59,5 +60,10 @@ main :: IO () main = do binary <- getEnv "HTOOLS" `catch` const getProgName let name = map toLower binary - boolnames = map (\(x, y) -> (x == name, y)) personalities - select (usage name) boolnames + boolnames = map (\(x, y) -> (x == name, Just y)) personalities + case select Nothing boolnames of + Nothing -> usage name + Just (fn, options) -> do + cmd_args <- getArgs + (opts, args) <- parseOpts cmd_args name options + fn opts args