From fd22ce8ef81cf23858a0446dcc0c4781a9427b65 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Thu, 21 May 2009 00:07:24 +0100
Subject: [PATCH] Convert Cluster.loadData to Result return

This patch changes Cluster.loadData to return a Result, instead of
directly the values; this will allow us to return meaningful error
values (e.g. when an instances lives on unknown node) rather than simply
abort. Currently the result is always an Ok, the actual signalling of
errors will come later.

Its callers are changed to accommodate for the new return type and to
display errors as needed.
---
 Ganeti/HTools/Cluster.hs |  8 ++++----
 hbal.hs                  |  9 ++++++++-
 hn1.hs                   | 12 +++++++++---
 hscan.hs                 | 37 +++++++++++++++++--------------------
 4 files changed, 38 insertions(+), 28 deletions(-)

diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index 4bbed2eab..73060a1f5 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -746,9 +746,9 @@ stripSuffix suffix lst =
     and massages it into the correct format. -}
 loadData :: String -- ^ Node data in text format
          -> String -- ^ Instance data in text format
-         -> (Container.Container Node.Node,
-             Container.Container Instance.Instance,
-             String, NameList, NameList)
+         -> Result (Container.Container Node.Node,
+                    Container.Container Instance.Instance,
+                    String, NameList, NameList)
 loadData ndata idata =
     let
     {- node file: name t_mem n_mem f_mem t_disk f_disk -}
@@ -781,7 +781,7 @@ loadData ndata idata =
         stn = stripSuffix common_suffix xtn
         sti = stripSuffix common_suffix xti
     in
-      (nl3, il3, common_suffix, stn, sti)
+      Ok (nl3, il3, common_suffix, stn, sti)
 
 -- | Compute the amount of memory used by primary instances on a node.
 nodeImem :: Node.Node -> InstanceList -> Int
diff --git a/hbal.hs b/hbal.hs
index 425a6d6d3..a69622a12 100644
--- a/hbal.hs
+++ b/hbal.hs
@@ -186,7 +186,14 @@ main = do
             host -> (getNodes host >>= readData,
                      getInstances host >>= readData)
 
-  (loaded_nl, il, csf, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
+  ldresult <- liftM2 Cluster.loadData node_data inst_data
+  (loaded_nl, il, csf, ktn, kti) <-
+      (case ldresult of
+         Ok x -> return x
+         Bad s -> do
+           printf "Error: failed to load data. Details:\n%s\n" s
+           exitWith $ ExitFailure 1
+      )
   let (fix_msgs, fixed_nl) = Cluster.checkData loaded_nl il ktn kti
 
   unless (null fix_msgs || verbose == 0) $ do
diff --git a/hn1.hs b/hn1.hs
index 133b4c967..adef634d5 100644
--- a/hn1.hs
+++ b/hn1.hs
@@ -135,7 +135,7 @@ main = do
          exitWith $ ExitFailure 1
 
   when (optShowVer opts) $ do
-         printf $ CLI.showVersion "hn1"
+         putStr $ CLI.showVersion "hn1"
          exitWith ExitSuccess
 
   (env_node, env_inst) <- CLI.parseEnv ()
@@ -151,8 +151,14 @@ main = do
             host -> (getNodes host >>= readData,
                      getInstances host >>= readData)
 
-  (loaded_nl, il, csf, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
-
+  ldresult <- liftM2 Cluster.loadData node_data inst_data
+  (loaded_nl, il, csf, ktn, kti) <-
+      (case ldresult of
+         Ok x -> return x
+         Bad s -> do
+           printf "Error: failed to load data. Details:\n%s\n" s
+           exitWith $ ExitFailure 1
+      )
   let (fix_msgs, nl) = Cluster.checkData loaded_nl il ktn kti
 
   unless (null fix_msgs) $ do
diff --git a/hscan.hs b/hscan.hs
index 228998768..21c249ea0 100644
--- a/hscan.hs
+++ b/hscan.hs
@@ -154,29 +154,26 @@ main = do
                 "Name" "Nodes" "Inst" "BNode" "BInst" "t_mem" "f_mem"
                 "t_disk" "f_disk" "Score"
 
-  mapM (\ name ->
+  mapM_ (\ name ->
             do
               printf "%-*s " nlen name
               hFlush stdout
               node_data <- getNodes name
               inst_data <- getInstances name
-              (case node_data of
-                 Bad err -> putStrLn err
-                 Ok ndata ->
-                     case inst_data of
-                       Bad err -> putStrLn err
-                       Ok idata ->
-                           do
-                             let  (nl, il, csf, ktn, kti) =
-                                      Cluster.loadData ndata idata
-                                  (_, fix_nl) = Cluster.checkData nl il ktn kti
-                             putStrLn $ printCluster fix_nl il ktn kti
-                             when (optShowNodes opts) $ do
-                                      putStr $ Cluster.printNodes ktn fix_nl
-                             let ndata = serializeNodes nl csf ktn
-                                 idata = serializeInstances il csf ktn kti
-                                 oname = odir </> (fixSlash name)
-                             writeFile (oname <.> "nodes") ndata
-                             writeFile (oname <.> "instances") idata)
+              let ldresult = join $
+                             liftM2 Cluster.loadData node_data inst_data
+              (case ldresult of
+                 Bad err -> printf "\nError: failed to load data. \
+                                   \Details:\n%s\n" err
+                 Ok x -> do
+                   let (nl, il, csf, ktn, kti) = x
+                       (_, fix_nl) = Cluster.checkData nl il ktn kti
+                   putStrLn $ printCluster fix_nl il ktn kti
+                   when (optShowNodes opts) $ do
+                           putStr $ Cluster.printNodes ktn fix_nl
+                   let ndata = serializeNodes nl csf ktn
+                       idata = serializeInstances il csf ktn kti
+                       oname = odir </> (fixSlash name)
+                   writeFile (oname <.> "nodes") ndata
+                   writeFile (oname <.> "instances") idata)
        ) clusters
-  exitWith ExitSuccess
-- 
GitLab