Commit fd22ce8e authored by Iustin Pop's avatar Iustin Pop
Browse files

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.
parent 0944090a
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment