From 42afc23559030a2cf42bccb9407dba451b4cff30 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dato=20Sim=C3=B3?= <dato@google.com>
Date: Wed, 7 Nov 2012 19:40:01 +0000
Subject: [PATCH] Hbal.hs: use Result (), not Bool, as return value for exec*
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Previously, functions in Hbal.hs related to execution of jobsets were
returning only IO Bool, and printing any errors they found directly to
stderr on their own.

I'm going to be moving some of these functions to a library module in
future commits, and it makes sense that they won't print to stderr, but
rather return an error condition. To make diffs more readable, I change the
return value in Hbal.hs itself, so that the next commit deals only with the
move. It's now `main` that prints any Bad result to stderr.

Signed-off-by: Dato SimΓ³ <dato@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>
---
 htools/Ganeti/HTools/Program/Hbal.hs | 43 ++++++++++++----------------
 1 file changed, 18 insertions(+), 25 deletions(-)

diff --git a/htools/Ganeti/HTools/Program/Hbal.hs b/htools/Ganeti/HTools/Program/Hbal.hs
index c7345a87d..2493bf497 100644
--- a/htools/Ganeti/HTools/Program/Hbal.hs
+++ b/htools/Ganeti/HTools/Program/Hbal.hs
@@ -41,7 +41,7 @@ import System.IO
 import System.Posix.Process
 import System.Posix.Signals
 
-import Text.Printf (printf, hPrintf)
+import Text.Printf (printf)
 
 import qualified Ganeti.HTools.Container as Container
 import qualified Ganeti.HTools.Cluster as Cluster
@@ -194,21 +194,19 @@ checkJobsStatus = all (== JOB_STATUS_SUCCESS)
 
 -- | Wrapper over execJobSet checking for early termination via an IORef.
 execCancelWrapper :: String -> Node.List
-                  -> Instance.List -> IORef Int -> [JobSet] -> IO Bool
-execCancelWrapper _      _  _  _    [] = return True
+                  -> Instance.List -> IORef Int -> [JobSet] -> IO (Result ())
+execCancelWrapper _      _  _  _    [] = return $ Ok ()
 execCancelWrapper master nl il cref alljss = do
   cancel <- readIORef cref
   if cancel > 0
-    then do
-      hPrintf stderr "Exiting early due to user request, %d\
-                     \ jobset(s) remaining." (length alljss)::IO ()
-      return True
+    then return . Bad $ "Exiting early due to user request, " ++
+                        show (length alljss) ++ " jobset(s) remaining."
     else execJobSet master nl il cref alljss
 
 -- | Execute an entire jobset.
 execJobSet :: String -> Node.List
-           -> Instance.List -> IORef Int -> [JobSet] -> IO Bool
-execJobSet _      _  _  _    [] = return True
+           -> Instance.List -> IORef Int -> [JobSet] -> IO (Result ())
+execJobSet _      _  _  _    [] = return $ Ok ()
 execJobSet master nl il cref (js:jss) = do
   -- map from jobset (htools list of positions) to [[opcodes]]
   let jobs = map (\(_, idx, move, _) ->
@@ -227,16 +225,12 @@ execJobSet master nl il cref (js:jss) = do
                 waitForJobs client x
          )
   case jrs of
-    Bad x -> do
-      hPutStrLn stderr x
-      return False
+    Bad x -> return $ Bad x
     Ok x -> if checkJobsStatus x
               then execCancelWrapper master nl il cref jss
-              else do
-                hPutStrLn stderr $ "Not all jobs completed successfully: " ++
-                          show x
-                hPutStrLn stderr "Aborting."
-                return False
+              else return . Bad . unlines $ [
+                "Not all jobs completed successfully: " ++ show x,
+                "Aborting."]
 
 -- | Executes the jobs, if possible and desired.
 maybeExecJobs :: Options
@@ -244,15 +238,14 @@ maybeExecJobs :: Options
               -> Node.List
               -> Instance.List
               -> [JobSet]
-              -> IO Bool
+              -> IO (Result ())
 maybeExecJobs opts ord_plc fin_nl il cmd_jobs =
   if optExecJobs opts && not (null ord_plc)
     then (case optLuxi opts of
-            Nothing -> do
-              hPutStrLn stderr "Execution of commands possible only on LUXI"
-              return False
+            Nothing -> return $
+                       Bad "Execution of commands possible only on LUXI"
             Just master -> execWithCancel master fin_nl il cmd_jobs)
-    else return True
+    else return $ Ok ()
 
 -- | Signal handler for graceful termination.
 handleSigInt :: IORef Int -> IO ()
@@ -271,7 +264,8 @@ handleSigTerm cref = do
 
 -- | Prepares to run a set of jobsets with handling of signals and early
 -- termination.
-execWithCancel :: String -> Node.List -> Instance.List -> [JobSet] -> IO Bool
+execWithCancel :: String -> Node.List -> Instance.List -> [JobSet]
+               -> IO (Result ())
 execWithCancel master fin_nl il cmd_jobs = do
   cref <- newIORef 0
   mapM_ (\(hnd, sig) -> installHandler sig (Catch (hnd cref)) Nothing)
@@ -438,5 +432,4 @@ main opts args = do
 
   when (verbose > 3) $ printStats nl fin_nl
 
-  eval <- maybeExecJobs opts ord_plc fin_nl il cmd_jobs
-  unless eval (exitWith (ExitFailure 1))
+  exitIfBad "hbal" =<< maybeExecJobs opts ord_plc fin_nl il cmd_jobs
-- 
GitLab