Commit 949397c8 authored by Iustin Pop's avatar Iustin Pop
Browse files

Move some tiered spec functionality to Cluster.hs



This splits out a bit of code from hspace.hs and moves it into its own
function in Cluster.hs.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarBalazs Lecz <leczb@google.com>
parent 73206d0a
......@@ -62,11 +62,14 @@ module Ganeti.HTools.Cluster
-- * Allocation functions
, iterateAlloc
, tieredAlloc
, tieredSpecMap
-- * Node group functions
, instanceGroup
, findSplitInstances
, splitCluster
) where
import Data.Function (on)
import Data.List
import Data.Ord (comparing)
import Text.Printf (printf)
......@@ -762,6 +765,7 @@ iterateAlloc nl il newinst nreq ixes =
_ -> Bad "Internal error: multiple solutions for single\
\ allocation"
-- | The core of the tiered allocation mode
tieredAlloc :: Node.List
-> Instance.List
-> Instance.Instance
......@@ -779,6 +783,18 @@ tieredAlloc nl il newinst nreq ixes =
Ok newinst' ->
tieredAlloc nl' il' newinst' nreq ixes'
-- | Compute the tiered spec string description from a list of
-- allocated instances.
tieredSpecMap :: [Instance.Instance]
-> [String]
tieredSpecMap trl_ixes =
let fin_trl_ixes = reverse trl_ixes
ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
ix_byspec
in map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
(rspecDsk spec) (rspecCpu spec) cnt) spec_map
-- * Formatting functions
-- | Given the original and final nodes, computes the relocation description.
......@@ -941,6 +957,8 @@ iMoveToJob nl il idx move =
ReplaceAndFailover np -> [ opR np, opF ]
FailoverAndReplace ns -> [ opF, opR ns ]
-- * Node group functions
-- | Computes the group of an instance
instanceGroup :: Node.List -> Instance.Instance -> Result Gdx
instanceGroup nl i =
......
......@@ -27,7 +27,6 @@ module Main (main) where
import Data.Char (toUpper, isAlphaNum)
import Data.List
import Data.Function
import Data.Maybe (isJust, fromJust)
import Data.Ord (comparing)
import Monad
......@@ -289,19 +288,12 @@ main = do
then return result_noalloc
else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
req_nodes [])
let fin_trl_ixes = reverse trl_ixes
ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
ix_byspec::[(RSpec, Int)]
spec_map' = map (\(spec, cnt) ->
printf "%d,%d,%d=%d" (rspecMem spec)
(rspecDsk spec) (rspecCpu spec) cnt)
spec_map::[String]
let spec_map' = Cluster.tieredSpecMap trl_ixes
when (verbose > 1) $ do
hPutStrLn stderr "Tiered allocation map"
hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
formatTable (map (printInstance trl_nl) fin_trl_ixes)
formatTable (map (printInstance trl_nl) (reverse trl_ixes))
[False, False, False, True, True, True]
when (isJust shownodes) $ do
......
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