Make Query operators enforce strictness

[ganeti-local] / htools / Ganeti / HTools / Program / Hbal.hs

diff --git a/htools/Ganeti/HTools/Program/Hbal.hs b/htools/Ganeti/HTools/Program/Hbal.hs
index 8c4136f..fa0728b 100644 (file)
--- 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,47 +49,54 @@ import qualified Ganeti.HTools.Group as Group
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance
 
+import Ganeti.BasicTypes
+import Ganeti.Common
+import Ganeti.Errors
 import Ganeti.HTools.CLI
 import Ganeti.HTools.ExtLoader
-import Ganeti.HTools.Utils
 import Ganeti.HTools.Types
 import Ganeti.HTools.Loader
+import Ganeti.Utils
 
 import qualified Ganeti.Luxi as L
 import Ganeti.Jobs
 
 -- | Options list and functions.
-options :: [OptType]
-options =
-  [ oPrintNodes
-  , oPrintInsts
-  , oPrintCommands
-  , oDataFile
-  , oEvacMode
-  , oRapiMaster
-  , oLuxiSocket
-  , oIAllocSrc
-  , oExecJobs
-  , oGroup
-  , oMaxSolLength
-  , oVerbose
-  , oQuiet
-  , oOfflineNode
-  , oMinScore
-  , oMaxCpu
-  , oMinDisk
-  , oMinGain
-  , oMinGainLim
-  , oDiskMoves
-  , oSelInst
-  , oInstMoves
-  , oDynuFile
-  , oExTags
-  , oExInst
-  , oSaveCluster
-  , oShowVer
-  , oShowHelp
-  ]
+options :: IO [OptType]
+options = do
+  luxi <- oLuxiSocket
+  return
+    [ oPrintNodes
+    , oPrintInsts
+    , oPrintCommands
+    , oDataFile
+    , oEvacMode
+    , oRapiMaster
+    , luxi
+    , oIAllocSrc
+    , oExecJobs
+    , oGroup
+    , oMaxSolLength
+    , oVerbose
+    , oQuiet
+    , oOfflineNode
+    , oMinScore
+    , oMaxCpu
+    , oMinDisk
+    , oMinGain
+    , oMinGainLim
+    , oDiskMoves
+    , oSelInst
+    , oInstMoves
+    , oDynuFile
+    , oExTags
+    , oExInst
+    , 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.
@@ -160,11 +168,11 @@ saveBalanceCommands opts cmd_data = do
 
 -- | Polls a set of jobs at a fixed interval until all are finished
 -- one way or another.
-waitForJobs :: L.Client -> [String] -> IO (Result [JobStatus])
+waitForJobs :: L.Client -> [L.JobId] -> IO (Result [JobStatus])
 waitForJobs client jids = do
   sts <- L.queryJobsStatus client jids
   case sts of
-    Bad x -> return $ Bad x
+    Bad e -> return . Bad $ "Checking job status: " ++ formatError e
     Ok s -> if any (<= JOB_STATUS_RUNNING) s
             then do
               -- TODO: replace hardcoded value with a better thing
@@ -186,7 +194,7 @@ execWrapper master nl il cref alljss = do
     then do
       hPrintf stderr "Exiting early due to user request, %d\
                      \ jobset(s) remaining." (length alljss)::IO ()
-      return False
+      return True
     else execJobSet master nl il cref alljss
 
 -- | Execute an entire jobset.
@@ -203,14 +211,14 @@ execJobSet master nl il cref (js:jss) = do
          (\client -> do
             jids <- L.submitManyJobs client jobs
             case jids of
-              Bad x -> return $ Bad x
+              Bad e -> return . Bad $ "Job submission error: " ++ formatError e
               Ok x -> do
-                putStrLn $ "Got job IDs " ++ commaJoin x
+                putStrLn $ "Got job IDs " ++ commaJoin (map show x)
                 waitForJobs client x
          )
   case jrs of
     Bad x -> do
-      hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
+      hPutStrLn stderr x
       return False
     Ok x -> if checkJobsStatus x
               then execWrapper master nl il cref jss
@@ -268,8 +276,7 @@ selectGroup opts gl nlf ilf = do
     hPutStrLn stderr "Found multiple node groups:"
     mapM_ (hPutStrLn stderr . ("  " ++) . Group.name .
            flip Container.find gl . fst) ngroups
-    hPutStrLn stderr "Aborting."
-    exitWith $ ExitFailure 1
+    exitErr "Aborting."
 
   case optGroup opts of
     Nothing -> do
@@ -281,8 +288,7 @@ selectGroup opts gl nlf ilf = do
         hPutStrLn stderr $ "Node group " ++ g ++
           " not found. Node group list is:"
         mapM_ (hPutStrLn stderr . ("  " ++) . Group.name ) (Container.elems gl)
-        hPutStrLn stderr "Aborting."
-        exitWith $ ExitFailure 1
+        exitErr "Aborting."
       Just grp ->
           case lookup (Group.idx grp) ngroups of
             Nothing ->
@@ -297,7 +303,7 @@ checkCluster verbose nl il = do
   -- nothing to do on an empty cluster
   when (Container.null il) $ do
          printf "Cluster is empty, exiting.\n"::IO ()
-         exitWith ExitSuccess
+         exitSuccess
 
   -- hbal doesn't currently handle split clusters
   let split_insts = Cluster.findSplitInstances nl il
@@ -328,7 +334,7 @@ checkGroup verbose gname nl il = do
              "Initial check done: %d bad nodes, %d bad instances.\n"
              (length bad_nodes) (length bad_instances)
 
-  when (not (null bad_nodes)) $
+  unless (null bad_nodes) $
          putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
                   \that the cluster will end N+1 happy."
 
@@ -340,14 +346,12 @@ checkNeedRebalance opts ini_cv = do
          printf "Cluster is already well balanced (initial score %.6g,\n\
                 \minimum score %.6g).\nNothing to do, exiting\n"
                 ini_cv min_cv:: IO ()
-         exitWith ExitSuccess
+         exitSuccess
 
 -- | Main function.
 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
+  unless (null args) $ exitErr "This program doesn't take any arguments."
 
   let verbose = optVerbose opts
       shownodes = optShowNodes opts
@@ -411,7 +415,7 @@ main opts args = do
 
   let cmd_jobs = Cluster.splitJobs cmd_strs
 
-  when (isJust $ optShowCmds opts) $
+  when (isJust $ optShowCmds opts) .
        saveBalanceCommands opts $ Cluster.formatCmds cmd_jobs
 
   maybeSaveData (optSaveCluster opts) "balanced" "after balancing"