diff --git a/Ganeti/HTools/CLI.hs b/Ganeti/HTools/CLI.hs index 578237b7593aaeb8a67bdeedbe331977d28d7928..972d4a2fa2adc50e4b84378d3690e51c1489b5c0 100644 --- a/Ganeti/HTools/CLI.hs +++ b/Ganeti/HTools/CLI.hs @@ -78,9 +78,9 @@ class EToolOptions a where -- | Usage info usageHelp :: (CLIOptions a) => String -> [OptDescr (a -> a)] -> String -usageHelp progname options = +usageHelp progname = usageInfo (printf "%s %s\nUsage: %s [OPTION...]" - progname Version.version progname) options + progname Version.version progname) -- | Command line parser, using the 'options' structure. parseOpts :: (CLIOptions b) => @@ -158,6 +158,6 @@ loadExternalData opts = do unless (null fix_msgs || silent opts) $ do putStrLn "Warning: cluster has inconsistent data:" - putStrLn . unlines . map (\s -> printf " - %s" s) $ fix_msgs + putStrLn . unlines . map (printf " - %s") $ fix_msgs return (fixed_nl, il, csf) diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs index 4eb07c362b02c5ab50194e63817c7f1ed4d0fa01..1afbc0ce6bfacae4c1db4ef09ba57f7cab69e25d 100644 --- a/Ganeti/HTools/Cluster.hs +++ b/Ganeti/HTools/Cluster.hs @@ -104,7 +104,7 @@ data CStats = CStats { cs_fmem :: Int -- ^ Cluster free mem -- | Verifies the N+1 status and return the affected nodes. verifyN1 :: [Node.Node] -> [Node.Node] -verifyN1 nl = filter Node.failN1 nl +verifyN1 = filter Node.failN1 {-| Computes the pair of bad nodes and instances. @@ -117,9 +117,9 @@ computeBadItems :: Node.List -> Instance.List -> ([Node.Node], [Instance.Instance]) computeBadItems nl il = let bad_nodes = verifyN1 $ getOnline nl - bad_instances = map (\idx -> Container.find idx il) $ - sort $ nub $ concat $ - map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes + bad_instances = map (\idx -> Container.find idx il) . + sort . nub $ + concatMap (\ n -> Node.slist n ++ Node.plist n) bad_nodes in (bad_nodes, bad_instances) @@ -140,11 +140,11 @@ updateCStats cs node = cs_amem = x_amem, cs_acpu = x_acpu, cs_adsk = x_adsk, cs_mmem = x_mmem, cs_mdsk = x_mdsk, cs_mcpu = x_mcpu } = cs - inc_amem = (Node.f_mem node) - (Node.r_mem node) + inc_amem = Node.f_mem node - Node.r_mem node inc_amem' = if inc_amem > 0 then inc_amem else 0 inc_adsk = Node.availDisk node - in CStats { cs_fmem = x_fmem + (Node.f_mem node) - , cs_fdsk = x_fdsk + (Node.f_dsk node) + in CStats { cs_fmem = x_fmem + Node.f_mem node + , cs_fdsk = x_fdsk + Node.f_dsk node , cs_amem = x_amem + inc_amem' , cs_adsk = x_adsk + inc_adsk , cs_acpu = x_acpu @@ -168,16 +168,16 @@ compDetailedCV nl = mem_cv = varianceCoeff mem_l dsk_cv = varianceCoeff dsk_l n1_l = length $ filter Node.failN1 nodes - n1_score = ((fromIntegral n1_l) / - (fromIntegral $ length nodes))::Double + n1_score = fromIntegral n1_l / + fromIntegral (length nodes)::Double res_l = map Node.p_rem nodes res_cv = varianceCoeff res_l offline_inst = sum . map (\n -> (length . Node.plist $ n) + (length . Node.slist $ n)) $ offline online_inst = sum . map (\n -> (length . Node.plist $ n) + (length . Node.slist $ n)) $ nodes - off_score = ((fromIntegral offline_inst) / - (fromIntegral $ online_inst + offline_inst))::Double + off_score = fromIntegral offline_inst / + fromIntegral (online_inst + offline_inst)::Double cpu_l = map Node.p_cpu nodes cpu_cv = varianceCoeff cpu_l in (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv) @@ -233,7 +233,7 @@ applyMove nl inst (ReplacePrimary new_pdx) = let tmp_s' = Node.removePri tmp_s inst new_p <- Node.addPri tgt_n inst new_s <- Node.addSec tmp_s' inst new_pdx - return $ Container.add new_pdx new_p $ + return . Container.add new_pdx new_p $ Container.addTwo old_pdx int_p old_sdx new_s nl in (new_nl, Instance.setPri inst new_pdx, new_pdx, old_sdx) @@ -261,7 +261,7 @@ applyMove nl inst (ReplaceAndFailover new_pdx) = new_nl = do -- Maybe monad new_p <- Node.addPri tgt_n inst new_s <- Node.addSec int_p inst new_pdx - return $ Container.add new_pdx new_p $ + return . Container.add new_pdx new_p $ Container.addTwo old_pdx new_s old_sdx int_s nl in (new_nl, Instance.setBoth inst new_pdx old_pdx, new_pdx, old_pdx) @@ -277,7 +277,7 @@ applyMove nl inst (FailoverAndReplace new_sdx) = new_nl = do -- Maybe monad new_p <- Node.addPri int_s inst new_s <- Node.addSec tgt_n inst old_sdx - return $ Container.add new_sdx new_s $ + return . Container.add new_sdx new_s $ Container.addTwo old_sdx new_p old_pdx int_p nl in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx) @@ -406,7 +406,7 @@ tryAlloc nl _ inst 1 = in return sols tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \ - \destinations required (" ++ (show reqn) ++ + \destinations required (" ++ show reqn ++ "), only two supported" -- | Try to allocate an instance on the cluster. @@ -420,7 +420,7 @@ tryReloc :: (Monad m) => tryReloc nl il xid 1 ex_idx = let all_nodes = getOnline nl inst = Container.find xid il - ex_idx' = (Instance.pnode inst):ex_idx + ex_idx' = Instance.pnode inst:ex_idx valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes valid_idxes = map Node.idx valid_nodes sols1 = map (\x -> let (mnl, i, _, _) = @@ -430,7 +430,7 @@ tryReloc nl il xid 1 ex_idx = in return sols1 tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \ - \destinations required (" ++ (show reqn) ++ + \destinations required (" ++ show reqn ++ "), only one supported" -- * Formatting functions @@ -499,8 +499,8 @@ printSolutionLine nl il nmlen imlen plc pos = opri = Container.nameOf nl $ Instance.pnode inst osec = Container.nameOf nl $ Instance.snode inst (moves, cmds) = computeMoves inam opri osec npri nsec - ostr = (printf "%s:%s" opri osec)::String - nstr = (printf "%s:%s" npri nsec)::String + ostr = printf "%s:%s" opri osec::String + nstr = printf "%s:%s" npri nsec::String in (printf " %3d. %-*s %-*s => %-*s %.8f a=%s" pos imlen inam pmlen ostr @@ -510,13 +510,14 @@ printSolutionLine nl il nmlen imlen plc pos = -- | Given a list of commands, prefix them with @gnt-instance@ and -- also beautify the display a little. formatCmds :: [[String]] -> String -formatCmds cmd_strs = - unlines $ - concat $ map (\(a, b) -> - (printf "echo step %d" (a::Int)): - (printf "check"): - (map ("gnt-instance " ++) b)) $ - zip [1..] cmd_strs +formatCmds = + unlines . + concatMap (\(a, b) -> + printf "echo step %d" (a::Int): + printf "check": + map ("gnt-instance " ++) b + ) . + zip [1..] -- | Converts a solution to string format. printSolution :: Node.List @@ -528,8 +529,7 @@ printSolution nl il sol = nmlen = Container.maxNameLen nl imlen = Container.maxNameLen il in - unzip $ map (uncurry $ printSolutionLine nl il nmlen imlen) $ - zip sol [1..] + unzip $ zipWith (printSolutionLine nl il nmlen imlen) sol [1..] -- | Print the node list. printNodes :: Node.List -> String @@ -537,14 +537,14 @@ printNodes nl = let snl = sortBy (compare `on` Node.idx) (Container.elems nl) m_name = maximum . map (length . Node.name) $ snl helper = Node.list m_name - header = (printf - "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %4s %4s \ - \%3s %3s %6s %6s %5s" - " F" m_name "Name" - "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem" - "t_dsk" "f_dsk" "pcpu" "vcpu" - "pri" "sec" "p_fmem" "p_fdsk" "r_cpu")::String - in unlines $ (header:map helper snl) + header = printf + "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %4s %4s \ + \%3s %3s %6s %6s %5s" + " F" m_name "Name" + "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem" + "t_dsk" "f_dsk" "pcpu" "vcpu" + "pri" "sec" "p_fmem" "p_fdsk" "r_cpu"::String + in unlines (header:map helper snl) -- | Shows statistics for a given node list. printStats :: Node.List -> String diff --git a/Ganeti/HTools/Container.hs b/Ganeti/HTools/Container.hs index 20072e03a9077549c4437bf045830cecbe79f146..0313cb40f7946aa4af1252e54874f4457c870876 100644 --- a/Ganeti/HTools/Container.hs +++ b/Ganeti/HTools/Container.hs @@ -73,7 +73,7 @@ find k c = c IntMap.! k -- | Add or update one element to the map. add :: Key -> a -> Container a -> Container a -add k v c = IntMap.insert k v c +add = IntMap.insert -- | Remove an element from the map. remove :: Key -> Container a -> Container a @@ -93,7 +93,7 @@ fromAssocList = IntMap.fromList -- | Add or update two elements of the map. addTwo :: Key -> a -> Key -> a -> Container a -> Container a -addTwo k1 v1 k2 v2 c = add k1 v1 $ add k2 v2 c +addTwo k1 v1 k2 v2 = add k1 v1 . add k2 v2 -- | Compute the name of an element in a container. nameOf :: (T.Element a) => Container a -> Key -> String @@ -112,7 +112,7 @@ findByName c n = nems = length result in if nems /= 1 then - fail $ "Wrong number of elems (" ++ (show nems) ++ + fail $ "Wrong number of elems (" ++ show nems ++ ") found with name " ++ n else return $ T.idxOf $ head result diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs index 7918e54336aa4600f183973d84d3c5ad3faa7538..801243b9a34c173a7bb07d291840d89b051f35e0 100644 --- a/Ganeti/HTools/IAlloc.hs +++ b/Ganeti/HTools/IAlloc.hs @@ -53,7 +53,7 @@ parseBaseInstance n a = do mem <- fromObj "memory" a vcpus <- fromObj "vcpus" a let running = "running" - return $ (n, Instance.create n mem disk vcpus running 0 0) + return (n, Instance.create n mem disk vcpus running 0 0) -- | Parses an instance as found in the cluster instance list. parseInstance :: NameAssoc -- ^ The node name-to-index association list @@ -67,7 +67,7 @@ parseInstance ktn n a = do pidx <- lookupNode ktn n pnode let snodes = tail nodes sidx <- (if null snodes then return Node.noSecondary - else (readEitherString $ head snodes) >>= lookupNode ktn n) + else readEitherString (head snodes) >>= lookupNode ktn n) return (n, Instance.setBoth (snd base) pidx sidx) -- | Parses a node as found in the cluster node list. @@ -78,17 +78,17 @@ parseNode n a = do let name = n offline <- fromObj "offline" a drained <- fromObj "drained" a - node <- (case offline of - True -> return $ Node.create name 0 0 0 0 0 0 True - _ -> do - mtotal <- fromObj "total_memory" a - mnode <- fromObj "reserved_memory" a - mfree <- fromObj "free_memory" a - dtotal <- fromObj "total_disk" a - dfree <- fromObj "free_disk" a - ctotal <- fromObj "total_cpus" a - return $ Node.create n mtotal mnode mfree - dtotal dfree ctotal (offline || drained)) + node <- (if offline + then return $ Node.create name 0 0 0 0 0 0 True + else do + mtotal <- fromObj "total_memory" a + mnode <- fromObj "reserved_memory" a + mfree <- fromObj "free_memory" a + dtotal <- fromObj "total_disk" a + dfree <- fromObj "free_disk" a + ctotal <- fromObj "total_cpus" a + return $ Node.create n mtotal mnode mfree + dtotal dfree ctotal (offline || drained)) return (name, node) -- | Top-level parser. @@ -103,12 +103,12 @@ parseData body = do -- existing node parsing nlist <- fromObj "nodes" obj let ndata = fromJSObject nlist - nobj <- (mapM (\(x,y) -> asJSObject y >>= parseNode x)) ndata + nobj <- mapM (\(x,y) -> asJSObject y >>= parseNode x) ndata let (ktn, nl) = assignIndices nobj -- existing instance parsing ilist <- fromObj "instances" obj let idata = fromJSObject ilist - iobj <- (mapM (\(x,y) -> asJSObject y >>= parseInstance ktn x)) idata + iobj <- mapM (\(x,y) -> asJSObject y >>= parseInstance ktn x) idata let (kti, il) = assignIndices iobj (map_n, map_i, csf) <- mergeData (nl, il) req_nodes <- fromObj "required_nodes" request @@ -127,7 +127,7 @@ parseData body = do let ex_nodes' = map (stripSuffix $ length csf) ex_nodes ex_idex <- mapM (Container.findByName map_n) ex_nodes' return $ Relocate ridx req_nodes ex_idex - other -> fail $ ("Invalid request type '" ++ other ++ "'") + other -> fail ("Invalid request type '" ++ other ++ "'") return $ Request rqtype map_n map_i csf -- | Formats the response into a valid IAllocator response message. diff --git a/Ganeti/HTools/Loader.hs b/Ganeti/HTools/Loader.hs index 5eab69df0f3695e8426301556624e63256d3ac8a..99f7539462461ec9490efff275f03b8703a4068e 100644 --- a/Ganeti/HTools/Loader.hs +++ b/Ganeti/HTools/Loader.hs @@ -97,7 +97,7 @@ assocEqual = (==) `on` fst fixNodes :: [(Ndx, Node.Node)] -> [(Idx, Instance.Instance)] -> [(Ndx, Node.Node)] -fixNodes nl il = +fixNodes = foldl' (\accu (idx, inst) -> let pdx = Instance.pnode inst @@ -117,7 +117,7 @@ fixNodes nl il = in ac4 else ac2 - ) nl il + ) -- | Compute the longest common suffix of a list of strings that -- | starts with a dot. @@ -131,7 +131,7 @@ longestDomain (x:xs) = -- | Remove tail suffix from a string. stripSuffix :: Int -> String -> String -stripSuffix sflen name = take ((length name) - sflen) name +stripSuffix sflen name = take (length name - sflen) name -- | Initializer function that loads the data from a node and instance -- list and massages it into the correct format. @@ -160,38 +160,37 @@ checkData nl il = Container.mapAccum (\ msgs node -> let nname = Node.name node - nilst = map (flip Container.find $ il) (Node.plist node) + nilst = map (flip Container.find il) (Node.plist node) dilst = filter (not . Instance.running) nilst adj_mem = sum . map Instance.mem $ dilst - delta_mem = (truncate $ Node.t_mem node) - - (Node.n_mem node) - - (Node.f_mem node) - - (nodeImem node il) + delta_mem = truncate (Node.t_mem node) + - Node.n_mem node + - Node.f_mem node + - nodeImem node il + adj_mem - delta_dsk = (truncate $ Node.t_dsk node) - - (Node.f_dsk node) - - (nodeIdsk node il) + delta_dsk = truncate (Node.t_dsk node) + - Node.f_dsk node + - nodeIdsk node il newn = Node.setFmem (Node.setXmem node delta_mem) (Node.f_mem node - adj_mem) - umsg1 = (if delta_mem > 512 || delta_dsk > 1024 - then [printf "node %s is missing %d MB ram \ - \and %d GB disk" - nname delta_mem (delta_dsk `div` 1024)] - else [])::[String] + umsg1 = [printf "node %s is missing %d MB ram \ + \and %d GB disk" + nname delta_mem (delta_dsk `div` 1024) | + delta_mem > 512 || delta_dsk > 1024]::[String] in (msgs ++ umsg1, newn) ) [] nl -- | Compute the amount of memory used by primary instances on a node. nodeImem :: Node.Node -> Instance.List -> Int nodeImem node il = - let rfind = flip Container.find $ il - in sum . map Instance.mem . - map rfind $ Node.plist node + let rfind = flip Container.find il + in sum . map (Instance.mem . rfind) + $ Node.plist node -- | Compute the amount of disk used by instances on a node (either primary -- or secondary). nodeIdsk :: Node.Node -> Instance.List -> Int nodeIdsk node il = - let rfind = flip Container.find $ il - in sum . map Instance.dsk . - map rfind $ (Node.plist node) ++ (Node.slist node) + let rfind = flip Container.find il + in sum . map (Instance.dsk . rfind) + $ Node.plist node ++ Node.slist node diff --git a/Ganeti/HTools/Node.hs b/Ganeti/HTools/Node.hs index dca4ca7af99a0d759e159a64860720548a48d1bf..0c54ba1ef34f7490d45d139ec127530847c6308b 100644 --- a/Ganeti/HTools/Node.hs +++ b/Ganeti/HTools/Node.hs @@ -154,8 +154,8 @@ create name_init mem_t_init mem_n_init mem_f_init idx = -1, peers = PeerMap.empty, r_mem = 0, - p_mem = (fromIntegral mem_f_init) / mem_t_init, - p_dsk = (fromIntegral dsk_f_init) / dsk_t_init, + p_mem = fromIntegral mem_f_init / mem_t_init, + p_dsk = fromIntegral dsk_f_init / dsk_t_init, p_rem = 0, p_cpu = 0, offline = offline_init, @@ -191,15 +191,15 @@ setMdsk :: Node -> Double -> Node setMdsk t val = t { m_dsk = val, lo_dsk = if val == noLimit then noLimitInt - else floor (val * (t_dsk t)) } + else floor (val * t_dsk t) } -- | Sets the max cpu usage ratio setMcpu :: Node -> Double -> Node -setMcpu t val = t { m_cpu = val, hi_cpu = floor (val * (t_cpu t)) } +setMcpu t val = t { m_cpu = val, hi_cpu = floor (val * t_cpu t) } -- | Computes the maximum reserved memory for peers from a peer map. computeMaxRes :: PeerMap.PeerMap -> PeerMap.Elem -computeMaxRes new_peers = PeerMap.maxElem new_peers +computeMaxRes = PeerMap.maxElem -- | Builds the peer map for a given node. buildPeers :: Node -> Instance.List -> Node @@ -210,31 +210,31 @@ buildPeers t il = (slist t) pmap = PeerMap.accumArray (+) mdata new_rmem = computeMaxRes pmap - new_failN1 = (f_mem t) <= new_rmem - new_prem = (fromIntegral new_rmem) / (t_mem t) + new_failN1 = f_mem t <= new_rmem + new_prem = fromIntegral new_rmem / t_mem t in t {peers=pmap, failN1 = new_failN1, r_mem = new_rmem, p_rem = new_prem} -- | Assigns an instance to a node as primary without other updates. setPri :: Node -> T.Idx -> Node -setPri t idx = t { plist = idx:(plist t) } +setPri t idx = t { plist = idx:plist t } -- | Assigns an instance to a node as secondary without other updates. setSec :: Node -> T.Idx -> Node -setSec t idx = t { slist = idx:(slist t) } +setSec t idx = t { slist = idx:slist t } -- | Add primary cpus to a node addCpus :: Node -> Int -> Node addCpus t count = - let new_count = (u_cpu t) + count - in t { u_cpu = new_count, p_cpu = (fromIntegral new_count) / (t_cpu t) } + let new_count = u_cpu t + count + in t { u_cpu = new_count, p_cpu = fromIntegral new_count / t_cpu t } -- * Update functions -- | Sets the free memory. setFmem :: Node -> Int -> Node setFmem t new_mem = - let new_n1 = new_mem <= (r_mem t) - new_mp = (fromIntegral new_mem) / (t_mem t) + let new_n1 = new_mem <= r_mem t + new_mp = fromIntegral new_mem / t_mem t in t { f_mem = new_mem, failN1 = new_n1, p_mem = new_mp } @@ -245,11 +245,11 @@ removePri t inst = new_plist = delete iname (plist t) new_mem = f_mem t + Instance.mem inst new_dsk = f_dsk t + Instance.dsk inst - new_mp = (fromIntegral new_mem) / (t_mem t) - new_dp = (fromIntegral new_dsk) / (t_dsk t) - new_failn1 = new_mem <= (r_mem t) - new_ucpu = (u_cpu t) - (Instance.vcpus inst) - new_rcpu = (fromIntegral new_ucpu) / (t_cpu t) + new_mp = fromIntegral new_mem / t_mem t + new_dp = fromIntegral new_dsk / t_dsk t + new_failn1 = new_mem <= r_mem t + new_ucpu = u_cpu t - Instance.vcpus inst + new_rcpu = fromIntegral new_ucpu / t_cpu t in t {plist = new_plist, f_mem = new_mem, f_dsk = new_dsk, failN1 = new_failn1, p_mem = new_mp, p_dsk = new_dp, u_cpu = new_ucpu, p_cpu = new_rcpu} @@ -263,16 +263,16 @@ removeSec t inst = new_dsk = f_dsk t + Instance.dsk inst old_peers = peers t old_peem = PeerMap.find pnode old_peers - new_peem = old_peem - (Instance.mem inst) + new_peem = old_peem - Instance.mem inst new_peers = PeerMap.add pnode new_peem old_peers old_rmem = r_mem t new_rmem = if old_peem < old_rmem then old_rmem else computeMaxRes new_peers - new_prem = (fromIntegral new_rmem) / (t_mem t) - new_failn1 = (f_mem t) <= new_rmem - new_dp = (fromIntegral new_dsk) / (t_dsk t) + new_prem = fromIntegral new_rmem / t_mem t + new_failn1 = f_mem t <= new_rmem + new_dp = fromIntegral new_dsk / t_dsk t in t {slist = new_slist, f_dsk = new_dsk, peers = new_peers, failN1 = new_failn1, r_mem = new_rmem, p_dsk = new_dp, p_rem = new_prem} @@ -283,18 +283,18 @@ addPri t inst = let iname = Instance.idx inst new_mem = f_mem t - Instance.mem inst new_dsk = f_dsk t - Instance.dsk inst - new_failn1 = new_mem <= (r_mem t) - new_ucpu = (u_cpu t) + (Instance.vcpus inst) - new_pcpu = (fromIntegral new_ucpu) / (t_cpu t) - new_dp = (fromIntegral new_dsk) / (t_dsk t) + new_failn1 = new_mem <= r_mem t + new_ucpu = u_cpu t + Instance.vcpus inst + new_pcpu = fromIntegral new_ucpu / t_cpu t + new_dp = fromIntegral new_dsk / t_dsk t l_cpu = m_cpu t in if new_mem <= 0 then T.OpFail T.FailMem else if new_dsk <= 0 || m_dsk t > new_dp then T.OpFail T.FailDisk - else if (new_failn1 && not (failN1 t)) then T.OpFail T.FailMem + else if new_failn1 && not (failN1 t) then T.OpFail T.FailMem else if l_cpu >= 0 && l_cpu < new_pcpu then T.OpFail T.FailCPU else - let new_plist = iname:(plist t) - new_mp = (fromIntegral new_mem) / (t_mem t) + let new_plist = iname:plist t + new_mp = fromIntegral new_mem / t_mem t r = t { plist = new_plist, f_mem = new_mem, f_dsk = new_dsk, failN1 = new_failn1, p_mem = new_mp, p_dsk = new_dp, u_cpu = new_ucpu, p_cpu = new_pcpu } @@ -310,12 +310,12 @@ addSec t inst pdx = new_peem = PeerMap.find pdx old_peers + Instance.mem inst new_peers = PeerMap.add pdx new_peem old_peers new_rmem = max (r_mem t) new_peem - new_prem = (fromIntegral new_rmem) / (t_mem t) + new_prem = fromIntegral new_rmem / t_mem t new_failn1 = old_mem <= new_rmem - new_dp = (fromIntegral new_dsk) / (t_dsk t) + new_dp = fromIntegral new_dsk / t_dsk t in if new_dsk <= 0 || m_dsk t > new_dp then T.OpFail T.FailDisk - else if (new_failn1 && not (failN1 t)) then T.OpFail T.FailMem - else let new_slist = iname:(slist t) + else if new_failn1 && not (failN1 t) then T.OpFail T.FailMem + else let new_slist = iname:slist t r = t { slist = new_slist, f_dsk = new_dsk, peers = new_peers, failN1 = new_failn1, r_mem = new_rmem, p_dsk = new_dp, @@ -352,7 +352,7 @@ list mname t = nmem = n_mem t xmem = x_mem t fmem = f_mem t - imem = (truncate tmem) - nmem - xmem - fmem + imem = truncate tmem - nmem - xmem - fmem in if off then printf " - %-*s %57s %3d %3d" @@ -362,6 +362,6 @@ list mname t = \ %4.0f %4d %3d %3d %6.4f %6.4f %5.2f" (if off then '-' else if fn then '*' else ' ') mname (name t) tmem nmem imem xmem fmem (r_mem t) - ((t_dsk t) / 1024) ((f_dsk t) `div` 1024) + (t_dsk t / 1024) (f_dsk t `div` 1024) (t_cpu t) (u_cpu t) pl sl mp dp cp diff --git a/Ganeti/HTools/PeerMap.hs b/Ganeti/HTools/PeerMap.hs index 1c22543cb883450d93a176c5397cb3194815463a..765eb4176d436fd0010ccb67d80ef4a50e30b36f 100644 --- a/Ganeti/HTools/PeerMap.hs +++ b/Ganeti/HTools/PeerMap.hs @@ -83,18 +83,18 @@ accumArray fn lst = -- | Returns either the value for a key or zero if not found find :: Key -> PeerMap -> Elem -find k c = fromMaybe 0 $ lookup k c +find k = fromMaybe 0 . lookup k -- | Add an element to a peermap, overwriting the previous value add :: Key -> Elem -> PeerMap -> PeerMap -add k v c = addWith (flip const) k v c +add = addWith (flip const) -- | Remove an element from a peermap remove :: Key -> PeerMap -> PeerMap remove k c = case c of [] -> [] (x@(x', _)):xs -> if k == x' then xs - else x:(remove k xs) + else x:remove k xs -- | Find the maximum element. -- diff --git a/Ganeti/HTools/QC.hs b/Ganeti/HTools/QC.hs index 58efb3436da461157c10516d18fd121943225212..dadffffddf738a89d222d85793b63c83ff1912a1 100644 --- a/Ganeti/HTools/QC.hs +++ b/Ganeti/HTools/QC.hs @@ -168,7 +168,7 @@ test_Instance = -- | Check that an instance add with too high memory or disk will be rejected prop_Node_addPri node inst = (Instance.mem inst >= Node.f_mem node || Instance.dsk inst >= Node.f_dsk node) && - (not $ Node.failN1 node) + not (Node.failN1 node) ==> isNothing(Node.addPri node inst) where _types = (node::Node.Node, inst::Instance.Instance) @@ -178,7 +178,7 @@ prop_Node_addPri node inst = (Instance.mem inst >= Node.f_mem node || prop_Node_addSec node inst pdx = (Instance.mem inst >= (Node.f_mem node - Node.r_mem node) || Instance.dsk inst >= Node.f_dsk node) && - (not $ Node.failN1 node) + not (Node.failN1 node) ==> isNothing(Node.addSec node inst pdx) where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int) diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs index af236f033e3214b0aa7aa28e76379cba0aa1c2b1..fc6a46cb78c462c6624c5b0a6d506ddc93b8de4b 100644 --- a/Ganeti/HTools/Rapi.hs +++ b/Ganeti/HTools/Rapi.hs @@ -62,17 +62,11 @@ formatHost master = getInstances :: NameAssoc -> String -> Result [(String, Instance.Instance)] -getInstances ktn body = do - arr <- loadJSArray body - ilist <- mapM (parseInstance ktn) arr - return ilist +getInstances ktn body = loadJSArray body >>= mapM (parseInstance ktn) -- | Parse a node list in JSON format. getNodes :: String -> Result [(String, Node.Node)] -getNodes body = do - arr <- loadJSArray body - nlist <- mapM parseNode arr - return nlist +getNodes body = loadJSArray body >>= mapM parseNode -- | Construct an instance from a JSON object. parseInstance :: [(String, Ndx)] @@ -96,18 +90,18 @@ parseNode :: JSObject JSValue -> Result (String, Node.Node) parseNode a = do name <- fromObj "name" a offline <- fromObj "offline" a - node <- (case offline of - True -> return $ Node.create name 0 0 0 0 0 0 True - _ -> do - drained <- fromObj "drained" a - mtotal <- fromObj "mtotal" a - mnode <- fromObj "mnode" a - mfree <- fromObj "mfree" a - dtotal <- fromObj "dtotal" a - dfree <- fromObj "dfree" a - ctotal <- fromObj "ctotal" a - return $ Node.create name mtotal mnode mfree - dtotal dfree ctotal (offline || drained)) + node <- (if offline + then return $ Node.create name 0 0 0 0 0 0 True + else do + drained <- fromObj "drained" a + mtotal <- fromObj "mtotal" a + mnode <- fromObj "mnode" a + mfree <- fromObj "mfree" a + dtotal <- fromObj "dtotal" a + dfree <- fromObj "dfree" a + ctotal <- fromObj "ctotal" a + return $ Node.create name mtotal mnode mfree + dtotal dfree ctotal (offline || drained)) return (name, node) -- | Builds the cluster data from an URL. diff --git a/Ganeti/HTools/Text.hs b/Ganeti/HTools/Text.hs index ce2a00863bb40a54355609e6c2ba6b513eb675d1..5e67fac843e6608e641af5b2e8247adf9cb97374 100644 --- a/Ganeti/HTools/Text.hs +++ b/Ganeti/HTools/Text.hs @@ -47,7 +47,7 @@ parseChoices name s _ = fail $ name ++ ": cannot parse string '" ++ s ++ "'" -- | Safe 'read' function returning data encapsulated in a Result. tryRead :: (Monad m, Read a) => String -> String -> m a -tryRead name s = parseChoices name s $ readsPrec 0 s +tryRead name s = parseChoices name s $ reads s -- | Load a node from a field list. loadNode :: (Monad m) => [String] -> m (String, Node.Node) @@ -64,7 +64,7 @@ loadNode (name:tm:nm:fm:td:fd:tc:fo:[]) = do vtc <- tryRead name tc return $ Node.create name vtm vnm vfm vtd vfd vtc False return (name, new_node) -loadNode s = fail $ "Invalid/incomplete node data: '" ++ (show s) ++ "'" +loadNode s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'" -- | Load an instance from a field list. loadInst :: (Monad m) => @@ -80,7 +80,7 @@ loadInst ktn (name:mem:dsk:vcpus:status:pnode:snode:[]) = do " has same primary and secondary node - " ++ pnode let newinst = Instance.create name vmem vdsk vvcpus status pidx sidx return (name, newinst) -loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ (show s) ++ "'" +loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'" -- | Convert newline and delimiter-separated text. -- diff --git a/Ganeti/HTools/Utils.hs b/Ganeti/HTools/Utils.hs index 532aff0df1f7cc4b7d9af8fd2810fef436200139..0bed1d7910542a0ff594433e5beed5ce04bc299d 100644 --- a/Ganeti/HTools/Utils.hs +++ b/Ganeti/HTools/Utils.hs @@ -60,8 +60,8 @@ sepSplit :: Char -> String -> [String] sepSplit sep s | x == "" && xs == [] = [] | xs == [] = [x] - | ys == [] = x:"":[] - | otherwise = x:(sepSplit sep ys) + | ys == [] = [x,""] + | otherwise = x:sepSplit sep ys where (x, xs) = break (== sep) s ys = drop 1 xs @@ -75,7 +75,7 @@ fst3 (a, _, _) = a -- | Mean value of a list. meanValue :: Floating a => [a] -> a -meanValue lst = (sum lst) / (fromIntegral $ length lst) +meanValue lst = sum lst / fromIntegral (length lst) -- | Squaring function square :: (Num a) => a -> a @@ -85,13 +85,13 @@ square = (^ 2) stdDev :: Floating a => [a] -> a stdDev lst = let mv = meanValue lst - av = sum $ map square $ map (\e -> e - mv) lst - bv = sqrt (av / (fromIntegral $ length lst)) + av = sum $ map (square . (\e -> e - mv)) lst + bv = sqrt (av / fromIntegral (length lst)) in bv -- | Coefficient of variation. varianceCoeff :: Floating a => [a] -> a -varianceCoeff lst = (stdDev lst) / (fromIntegral $ length lst) +varianceCoeff lst = stdDev lst / fromIntegral (length lst) -- * JSON-related functions @@ -112,7 +112,7 @@ readEitherString v = -- | Converts a JSON message into an array of JSON objects. loadJSArray :: (Monad m) => String -> m [J.JSObject J.JSValue] -loadJSArray s = fromJResult $ J.decodeStrict s +loadJSArray = fromJResult . J.decodeStrict -- | Reads a the value of a key in a JSON object. fromObj :: (J.JSON a, Monad m) => String -> J.JSObject J.JSValue -> m a @@ -128,4 +128,4 @@ asJSObject _ = fail "not an object" -- | Coneverts a list of JSON values into a list of JSON objects. asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue] -asObjectList = sequence . map asJSObject +asObjectList = mapM asJSObject diff --git a/hail.hs b/hail.hs index 3503b5bf03477bad1e122476a6ce41c1af7c44e7..4befe386dcdb2a71a754fb35fd72669ee170943d 100644 --- a/hail.hs +++ b/hail.hs @@ -77,16 +77,15 @@ filterFails :: (Monad m) => [(OpResult Node.List, -> m [(Node.List, [Node.Node])] filterFails sols = if null sols then fail "No nodes onto which to allocate at all" - else let sols' = concat . map (\ (onl, _, nn) -> - case onl of - OpFail _ -> [] - OpGood gnl -> [(gnl, nn)] - ) $ sols + else let sols' = concatMap (\ (onl, _, nn) -> + case onl of + OpFail _ -> [] + OpGood gnl -> [(gnl, nn)] + ) sols in - if null sols' then - fail "No valid allocation solutions" - else - return sols' + if null sols' + then fail "No valid allocation solutions" + else return sols' processResults :: (Monad m) => [(Node.List, [Node.Node])] -> m (String, [Node.Node]) @@ -95,10 +94,10 @@ processResults sols = sols'' = sortBy (compare `on` fst) sols' (best, w) = head sols'' (worst, l) = last sols'' - info = (printf "Valid results: %d, best score: %.8f for node(s) %s, \ - \worst score: %.8f for node(s) %s" (length sols'') - best (intercalate "/" . map Node.name $ w) - worst (intercalate "/" . map Node.name $ l))::String + info = printf "Valid results: %d, best score: %.8f for node(s) %s, \ + \worst score: %.8f for node(s) %s" (length sols'') + best (intercalate "/" . map Node.name $ w) + worst (intercalate "/" . map Node.name $ l)::String in return (info, w) -- | Process a request and return new node lists diff --git a/hbal.hs b/hbal.hs index e299607ea1a10a3976d4aad2dbde74f47a17b7e8..7e5ab282d5dbbd4a06798c0371ffae0204a65cfc 100644 --- a/hbal.hs +++ b/hbal.hs @@ -73,7 +73,7 @@ instance CLI.EToolOptions Options where instFile = optInstf instSet = optInstSet masterName = optMaster - silent a = (optVerbose a) == 0 + silent a = optVerbose a == 0 -- | Default values for the command line options. defaultOptions :: Options @@ -121,14 +121,14 @@ options = (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS") "collect data via RAPI at the given ADDRESS" , Option ['l'] ["max-length"] - (ReqArg (\ i opts -> opts { optMaxLength = (read i)::Int }) "N") + (ReqArg (\ i opts -> opts { optMaxLength = read i::Int }) "N") "cap the solution at this many moves (useful for very unbalanced \ \clusters)" , Option ['v'] ["verbose"] - (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 })) + (NoArg (\ opts -> opts { optVerbose = optVerbose opts + 1 })) "increase the verbosity level" , Option ['q'] ["quiet"] - (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 })) + (NoArg (\ opts -> opts { optVerbose = optVerbose opts - 1 })) "decrease the verbosity level" , Option ['O'] ["offline"] (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE") @@ -196,7 +196,7 @@ iterateDepth ini_tbl max_rounds nmlen imlen formatOneline :: Double -> Int -> Double -> String formatOneline ini_cv plc_len fin_cv = printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv - (if fin_cv == 0 then 1 else (ini_cv / fin_cv)) + (if fin_cv == 0 then 1 else ini_cv / fin_cv) -- | Main function. main :: IO () @@ -216,7 +216,7 @@ main = do let offline_names = optOffline opts all_nodes = Container.elems fixed_nl all_names = map Node.name all_nodes - offline_wrong = filter (\n -> not $ elem n all_names) offline_names + offline_wrong = filter (flip notElem all_names) offline_names offline_indices = map Node.idx $ filter (\n -> elem (Node.name n) offline_names) all_nodes @@ -243,15 +243,15 @@ main = do (Container.size nl) (Container.size il) - when (length csf > 0 && not oneline && verbose > 1) $ do - printf "Note: Stripping common suffix of '%s' from names\n" csf + when (length csf > 0 && not oneline && verbose > 1) $ + printf "Note: Stripping common suffix of '%s' from names\n" csf let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il unless (oneline || verbose == 0) $ printf "Initial check done: %d bad nodes, %d bad instances.\n" (length bad_nodes) (length bad_instances) - when (length bad_nodes > 0) $ do + when (length bad_nodes > 0) $ putStrLn "Cluster is not N+1 happy, continuing but no guarantee \ \that the cluster will end N+1 happy." @@ -286,14 +286,14 @@ main = do nmlen imlen [] oneline min_cv let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl ord_plc = reverse fin_plc - sol_msg = (if null fin_plc - then printf "No solution found\n" - else (if verbose > 2 - then printf "Final coefficients: overall %.8f, %s\n" - fin_cv (Cluster.printStats fin_nl) - else printf "Cluster score improved from %.8f to %.8f\n" - ini_cv fin_cv - ))::String + sol_msg = if null fin_plc + then printf "No solution found\n" + else if verbose > 2 + then printf "Final coefficients: overall %.8f, %s\n" + fin_cv (Cluster.printStats fin_nl) + else printf "Cluster score improved from %.8f to %.8f\n" + ini_cv fin_cv + ::String unless oneline $ putStr sol_msg diff --git a/hscan.hs b/hscan.hs index 6a30fec25f832bab541728fe695a5869847fc4f0..6e6991268060a0c29b13335dfabd6788292a488d 100644 --- a/hscan.hs +++ b/hscan.hs @@ -80,7 +80,7 @@ options = (ReqArg (\ d opts -> opts { optOutPath = d }) "PATH") "directory in which to write output files" , Option ['v'] ["verbose"] - (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 })) + (NoArg (\ opts -> opts { optVerbose = optVerbose opts + 1 })) "increase the verbosity level" , Option [] ["no-headers"] (NoArg (\ opts -> opts { optNoHeader = True })) @@ -111,11 +111,11 @@ serializeInstance :: String -> Node.List -> Instance.Instance -> String serializeInstance csf nl inst = let iname = Instance.name inst ++ csf - pnode = (Container.nameOf nl $ Instance.pnode inst) ++ csf + pnode = Container.nameOf nl (Instance.pnode inst) ++ csf sidx = Instance.snode inst snode = (if sidx == Node.noSecondary then "" - else (Container.nameOf nl sidx) ++ csf) + else Container.nameOf nl sidx ++ csf) in printf "%s|%d|%d|%d|%s|%s|%s" iname (Instance.mem inst) (Instance.dsk inst) @@ -181,11 +181,11 @@ main = do let (nl, il, csf) = x (_, fix_nl) = Loader.checkData nl il putStrLn $ printCluster fix_nl il - when (optShowNodes opts) $ do - putStr $ Cluster.printNodes fix_nl + when (optShowNodes opts) $ + putStr $ Cluster.printNodes fix_nl let ndata = serializeNodes csf nl idata = serializeInstances csf nl il - oname = odir </> (fixSlash name) + oname = odir </> fixSlash name writeFile (oname <.> "nodes") ndata writeFile (oname <.> "instances") idata) ) clusters diff --git a/hspace.hs b/hspace.hs index a6d458103ad62b7af5db8dd4028f66ff023db7a8..3b301d43c3c596bde6a12b2bef0df508e5fa9ad7 100644 --- a/hspace.hs +++ b/hspace.hs @@ -74,7 +74,7 @@ instance CLI.EToolOptions Options where instFile = optInstf instSet = optInstSet masterName = optMaster - silent a = (optVerbose a) == 0 + silent a = optVerbose a == 0 -- | Default values for the command line options. defaultOptions :: Options @@ -113,10 +113,10 @@ options = (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS") "collect data via RAPI at the given ADDRESS" , Option ['v'] ["verbose"] - (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 })) + (NoArg (\ opts -> opts { optVerbose = optVerbose opts + 1 })) "increase the verbosity level" , Option ['q'] ["quiet"] - (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 })) + (NoArg (\ opts -> opts { optVerbose = optVerbose opts - 1 })) "decrease the verbosity level" , Option ['O'] ["offline"] (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE") @@ -183,10 +183,10 @@ iterateDepth :: Node.List -> ([(FailMode, Int)], Node.List, [Instance.Instance]) iterateDepth nl il newinst nreq ixes = let depth = length ixes - newname = (printf "new-%d" depth)::String - newidx = (length $ Container.elems il) + depth + newname = printf "new-%d" depth::String + newidx = length (Container.elems il) + depth newi2 = Instance.setIdx (Instance.setName newinst newname) newidx - sols = (Cluster.tryAlloc nl il newi2 nreq):: + sols = Cluster.tryAlloc nl il newi2 nreq:: OpResult Cluster.AllocSolution in case sols of OpFail _ -> ([], nl, ixes) @@ -201,12 +201,12 @@ printStats :: String -> Cluster.CStats -> IO () printStats kind cs = do printf "%s free RAM: %d\n" kind (Cluster.cs_fmem cs) printf "%s allocatable RAM: %d\n" kind (Cluster.cs_amem cs) - printf "%s reserved RAM: %d\n" kind ((Cluster.cs_fmem cs) - - (Cluster.cs_amem cs)) + printf "%s reserved RAM: %d\n" kind (Cluster.cs_fmem cs - + Cluster.cs_amem cs) printf "%s free disk: %d\n" kind (Cluster.cs_fdsk cs) printf "%s allocatable disk: %d\n" kind (Cluster.cs_adsk cs) - printf "%s reserved disk: %d\n" kind ((Cluster.cs_fdsk cs) - - (Cluster.cs_adsk cs)) + printf "%s reserved disk: %d\n" kind (Cluster.cs_fdsk cs - + Cluster.cs_adsk cs) printf "%s max node allocatable RAM: %d\n" kind (Cluster.cs_mmem cs) printf "%s max node allocatable disk: %d\n" kind (Cluster.cs_mdsk cs) @@ -228,7 +228,7 @@ main = do let offline_names = optOffline opts all_nodes = Container.elems fixed_nl all_names = map Node.name all_nodes - offline_wrong = filter (\n -> not $ elem n all_names) offline_names + offline_wrong = filter (flip notElem all_names) offline_names offline_indices = map Node.idx $ filter (\n -> elem (Node.name n) offline_names) all_nodes @@ -251,8 +251,8 @@ main = do nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu) nm - when (length csf > 0 && verbose > 1) $ do - printf "Note: Stripping common suffix of '%s' from names\n" csf + when (length csf > 0 && verbose > 1) $ + printf "Note: Stripping common suffix of '%s' from names\n" csf let bad_nodes = fst $ Cluster.computeBadItems nl il when (length bad_nodes > 0) $ do @@ -290,13 +290,13 @@ main = do printf "Final score: %.8f\n" (Cluster.compCV fin_nl) printf "Final instances: %d\n" (num_instances + allocs) printStats "Final" fin_stats - printf "Usage: %.5f\n" (((fromIntegral num_instances)::Double) / - (fromIntegral fin_instances)) + printf "Usage: %.5f\n" ((fromIntegral num_instances::Double) / + fromIntegral fin_instances) printf "Allocations: %d\n" allocs putStr (unlines . map (\(x, y) -> printf "%s: %d" (show x) y) $ sreason) printf "Most likely fail reason: %s\n" (show . fst . head $ sreason) - when (verbose > 1) $ do + when (verbose > 1) $ putStr . unlines . map (\i -> printf "Inst: %*s %-*s %-*s" ix_namelen (Instance.name i) nmlen (Container.nameOf fin_nl $ Instance.pnode i)