Currently, the node pairs used for allocation are a simple [(primary,
secondary)] list of tuples, as this is how they were used before the
previous patch. However, for that patch, we use them separately per
primary node, and we have to unpack this list right after generation.
Therefore it makes sense to directly generate the list in the correct
form, and remove the split from tryAlloc. This should not be slower
than the previous patch, at least, possibly even faster.
---
htools/Ganeti/HTools/Cluster.hs | 24 ++++++++++++------------
1 files changed, 12 insertions(+), 12 deletions(-)
diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs
index d19df58..15eaecf 100644
--- a/htools/Ganeti/HTools/Cluster.hs
+++ b/htools/Ganeti/HTools/Cluster.hs
@@ -74,12 +74,10 @@ module Ganeti.HTools.Cluster
) where
import qualified Data.IntSet as IntSet
-import Data.Function (on)
import Data.List
import Data.Maybe (fromJust, isNothing)
import Data.Ord (comparing)
import Text.Printf (printf)
-import Control.Monad
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
@@ -119,7 +117,7 @@ type AllocResult = (FailStats, Node.List, Instance.List,
-- For a one-node allocation, this will be a @Left ['Node.Node']@,
-- whereas for a two-node allocation, this will be a @Right
-- [('Node.Node', 'Node.Node')]@.
-type AllocNodes = Either [Ndx] [(Ndx, Ndx)]
+type AllocNodes = Either [Ndx] [(Ndx, [Ndx])]
-- | The empty solution we start with when computing allocations.
emptyAllocSolution :: AllocSolution
@@ -682,12 +680,14 @@ genAllocNodes gl nl count drop_unalloc =
flip Container.find gl . Node.group)
else id
all_nodes = filter_fn $ getOnline nl
- all_pairs = liftM2 (,) all_nodes all_nodes
- ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y &&
- Node.group x == Node.group y) all_pairs
+ all_pairs = [(Node.idx p,
+ [Node.idx s | s <- all_nodes,
+ Node.idx p /= Node.idx s,
+ Node.group p == Node.group s]) |
+ p <- all_nodes]
in case count of
1 -> Ok (Left (map Node.idx all_nodes))
- 2 -> Ok (Right (map (\(p, s) -> (Node.idx p, Node.idx s)) ok_pairs))
+ 2 -> Ok (Right (filter (not . null . snd) all_pairs))
_ -> Bad "Unsupported number of nodes, only one or two supported"
-- | Try to allocate an instance on the cluster.
@@ -698,11 +698,11 @@ tryAlloc :: (Monad m) =>
-> AllocNodes -- ^ The allocation targets
-> m AllocSolution -- ^ Possible solution list
tryAlloc nl _ inst (Right ok_pairs) =
- let pgroups = groupBy ((==) `on` fst) ok_pairs
- psols = parMap rwhnf (foldl' (\cstate (p, s) ->
- concatAllocs cstate $
- allocateOnPair nl inst p s)
- emptyAllocSolution) pgroups
+ let psols = parMap rwhnf (\(p, ss) ->
+ foldl' (\cstate ->
+ concatAllocs cstate .
+ allocateOnPair nl inst p)
+ emptyAllocSolution ss) ok_pairs
sols = foldl' sumAllocs emptyAllocSolution psols
in if null ok_pairs -- means we have just one node
then fail "Not enough online nodes"
--
1.7.3.1
