On Thu, Feb 26, 2015 at 01:47:15PM +0100, Klaus Aehlig wrote:
LGTM
A suggestion for discussion: Adding the 'Bool' parameters obscures a
bit the code, as it needs to be dealt with at various places. What
about using
WriterT All IO a
(perhaps as a type alias for easier refactoring, if needed) instead of
IO (a, Bool)
? Reporting a failure is then just calling `tell (All False)` and a
lot of the existing code (foldM etc) would remain unchanged, without
needing to explicitly process the boolean part, making the &&
implicit. On the other hand, it requires adding liftIO at a few
places and also at the place where the whole query is run.
I was thinking about this when writing the patch as well, as this is
the more idiomatic type. But I decided that the additional increase
in patch sizes is not worth the nicer type. Below is the total
interdiff (over the whole patch series), which sums up as
Backend/MonD.hs | 33 +++++++++++++++++----------------
ExtLoader.hs | 11 +++++++----
Program/Hail.hs | 7 ++++---
3 files changed, 28 insertions(+), 23 deletions(-)
I can distribute that to the appropriate patches if you think the
improvement in type justifies the additional complication.
LGTM, thank you. Please do, I believe it won't make them that much longer,
and if we'll need to change the logic in the future some other way, we'll
already have the `liftIO`s in place.
commit e289a15522c85be10d2164a2d28e22147d9b70d3
Author: Klaus Aehlig <[email protected]>
Date: Thu Feb 26 13:41:50 2015 +0100
Discussion: WriterT
diff --git a/src/Ganeti/HTools/Backend/MonD.hs
b/src/Ganeti/HTools/Backend/MonD.hs
index fb684ee..f323ab3 100644
--- a/src/Ganeti/HTools/Backend/MonD.hs
+++ b/src/Ganeti/HTools/Backend/MonD.hs
@@ -44,6 +44,7 @@ module Ganeti.HTools.Backend.MonD
) where
import Control.Monad
+import Control.Monad.Writer
import qualified Data.List as L
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
@@ -268,39 +269,39 @@ queryAMonD m dc node =
-- | Query all MonDs for a single Data Collector. Return the updated
-- cluster, as well as a bit inidicating wether the collector succeeded.
queryAllMonDs :: Maybe MapMonDData -> (Node.List, Instance.List)
- -> DataCollector -> IO ((Node.List, Instance.List), Bool)
+ -> DataCollector -> WriterT All IO (Node.List, Instance.List)
queryAllMonDs m (nl, il) dc = do
- elems <- mapM (queryAMonD m dc) (Container.elems nl)
+ elems <- liftIO $ mapM (queryAMonD m dc) (Container.elems nl)
let elems' = catMaybes elems
if length elems == length elems'
then
let results = zip (Container.elems nl) elems'
in case dUse dc results (nl, il) of
- Ok (nl', il') -> return ((nl', il'), True)
+ Ok (nl', il') -> return (nl', il')
Bad s -> do
- logWarning s
- return ((nl, il), False)
+ liftIO $ logWarning s
+ tell $ All False
+ return (nl, il)
else do
- logWarning $ "Didn't receive an answer by all MonDs, " ++ dName dc
- ++ "'s data will be ignored."
- return ((nl,il), False)
+ liftIO . logWarning
+ $ "Didn't receive an answer by all MonDs, " ++ dName dc
+ ++ "'s data will be ignored."
+ tell $ All False
+ return (nl,il)
-- | Query all MonDs for all Data Collector. Return the cluster enriched
-- by dynamic data, as well as a bit indicating wether all collectors
-- could be queried successfully.
-queryAllMonDDCs :: ClusterData -> Options -> IO (ClusterData, Bool)
+queryAllMonDDCs :: ClusterData -> Options -> WriterT All IO ClusterData
queryAllMonDDCs cdata opts = do
map_mDD <-
case optMonDFile opts of
Nothing -> return Nothing
Just fp -> do
- monDData_contents <- readFile fp
- monDData <- exitIfBad "can't parse MonD data"
+ monDData_contents <- liftIO $ readFile fp
+ monDData <- liftIO . exitIfBad "can't parse MonD data"
. pMonDData $ monDData_contents
return . Just $ Map.fromList monDData
- let query (cluster, ok) collector = do
- (cluster', ok') <- queryAllMonDs map_mDD cluster collector
- return (cluster', ok && ok')
let (ClusterData _ nl il _ _) = cdata
- ((nl', il'), ok) <- foldM query ((nl, il), True) (collectors opts)
- return (cdata {cdNodes = nl', cdInstances = il'}, ok)
+ (nl', il') <- foldM (queryAllMonDs map_mDD) (nl, il) (collectors opts)
+ return $ cdata {cdNodes = nl', cdInstances = il'}
diff --git a/src/Ganeti/HTools/ExtLoader.hs b/src/Ganeti/HTools/ExtLoader.hs
index a922d54..cae481a 100644
--- a/src/Ganeti/HTools/ExtLoader.hs
+++ b/src/Ganeti/HTools/ExtLoader.hs
@@ -43,8 +43,10 @@ module Ganeti.HTools.ExtLoader
) where
import Control.Monad
+import Control.Monad.Writer (runWriterT)
import Control.Exception
import Data.Maybe (isJust, fromJust)
+import Data.Monoid (getAll)
import System.FilePath
import System.IO
import System.Time (getClockTime)
@@ -124,10 +126,11 @@ loadExternalData opts = do
ldresult = input_data >>= (if ignoreDynU then clearDynU else return)
>>= mergeData eff_u exTags selInsts exInsts now
cdata <- exitIfBad "failed to load data, aborting" ldresult
- (cdata', ok) <- if optMonD opts
- then MonD.queryAllMonDDCs cdata opts
- else return (cdata, True)
- exitWhen (optMonDExitMissing opts && not ok) "Not all required data
available"
+ (cdata', ok) <- runWriterT $ if optMonD opts
+ then MonD.queryAllMonDDCs cdata opts
+ else return cdata
+ exitWhen (optMonDExitMissing opts && not (getAll ok))
+ "Not all required data available"
let (fix_msgs, nl) = checkData (cdNodes cdata') (cdInstances cdata')
unless (optVerbose opts == 0) $ maybeShowWarnings fix_msgs
diff --git a/src/Ganeti/HTools/Program/Hail.hs
b/src/Ganeti/HTools/Program/Hail.hs
index 1d57f17..db1be29 100644
--- a/src/Ganeti/HTools/Program/Hail.hs
+++ b/src/Ganeti/HTools/Program/Hail.hs
@@ -39,6 +39,7 @@ module Ganeti.HTools.Program.Hail
) where
import Control.Monad
+import Control.Monad.Writer (runWriterT)
import Data.Maybe (fromMaybe, isJust)
import System.IO
@@ -87,9 +88,9 @@ wrapReadRequest opts args = do
return $ Request rqt cdata
else do
let Request rqt cdata = r1
- (cdata', _) <- if optMonD opts
- then MonD.queryAllMonDDCs cdata opts
- else return (cdata, True)
+ (cdata', _) <- runWriterT $ if optMonD opts
+ then MonD.queryAllMonDDCs cdata opts
+ else return cdata
return $ Request rqt cdata'
-- | Main function.
--
Klaus Aehlig
Google Germany GmbH, Dienerstr. 12, 80331 Muenchen
Registergericht und -nummer: Hamburg, HRB 86891
Sitz der Gesellschaft: Hamburg
Geschaeftsfuehrer: Graham Law, Christine Elizabeth Flores
