> 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. 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
