hail/allocate: implement multi-group support

[ganeti-local] / Ganeti / HTools / Loader.hs

diff --git a/Ganeti/HTools/Loader.hs b/Ganeti/HTools/Loader.hs
index 002b62a..dcaef80 100644 (file)
--- a/Ganeti/HTools/Loader.hs
+++ b/Ganeti/HTools/Loader.hs
@@ -7,7 +7,7 @@ has been loaded from external sources.
 
 {-
 
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2010 Google Inc.
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -37,9 +37,8 @@ module Ganeti.HTools.Loader
     , Request(..)
     ) where
 
-import Data.Function (on)
 import Data.List
-import Data.Maybe (fromJust)
+import qualified Data.Map as M
 import Text.Printf (printf)
 
 import qualified Ganeti.HTools.Container as Container
@@ -76,49 +75,45 @@ data Request = Request RqType Node.List Instance.List [String]
 -- * Functions
 
 -- | Lookups a node into an assoc list.
-lookupNode :: (Monad m) => [(String, Ndx)] -> String -> String -> m Ndx
+lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Ndx
 lookupNode ktn inst node =
-    case lookup node ktn of
+    case M.lookup node ktn of
       Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
       Just idx -> return idx
 
 -- | Lookups an instance into an assoc list.
-lookupInstance :: (Monad m) => [(String, Idx)] -> String -> m Idx
+lookupInstance :: (Monad m) => NameAssoc -> String -> m Idx
 lookupInstance kti inst =
-    case lookup inst kti of
+    case M.lookup inst kti of
       Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
       Just idx -> return idx
 
 -- | Given a list of elements (and their names), assign indices to them.
 assignIndices :: (Element a) =>
                  [(String, a)]
-              -> (NameAssoc, [(Int, a)])
-assignIndices =
-    unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
-          . zip [0..]
-
--- | Assoc element comparator
-assocEqual :: (Eq a) => (a, b) -> (a, b) -> Bool
-assocEqual = (==) `on` fst
+              -> (NameAssoc, Container.Container a)
+assignIndices nodes =
+  let (na, idx_node) =
+          unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
+          . zip [0..] $ nodes
+  in (M.fromList na, Container.fromAssocList idx_node)
 
 -- | For each instance, add its index to its primary and secondary nodes.
-fixNodes :: [(Ndx, Node.Node)]
+fixNodes :: Node.List
          -> Instance.Instance
-         -> [(Ndx, Node.Node)]
+         -> Node.List
 fixNodes accu inst =
     let
         pdx = Instance.pNode inst
         sdx = Instance.sNode inst
-        pold = fromJust $ lookup pdx accu
+        pold = Container.find pdx accu
         pnew = Node.setPri pold inst
-        ac1 = deleteBy assocEqual (pdx, pold) accu
-        ac2 = (pdx, pnew):ac1
+        ac2 = Container.add pdx pnew accu
     in
       if sdx /= Node.noSecondary
-      then let sold = fromJust $ lookup sdx accu
+      then let sold = Container.find sdx accu
                snew = Node.setSec sold inst
-               ac3 = deleteBy assocEqual (sdx, sold) ac2
-           in (sdx, snew):ac3
+           in Container.add sdx snew ac2
       else ac2
 
 -- | Remove non-selected tags from the exclusion list
@@ -153,7 +148,7 @@ extractExTags =
     map (drop (length exTagsPrefix)) .
     filter (isPrefixOf exTagsPrefix)
 
--- | Extracts the common suffix from node/instance names
+-- | Extracts the common suffix from node\/instance names
 commonSuffix :: Node.List -> Instance.List -> String
 commonSuffix nl il =
     let node_names = map Node.name $ Container.elems nl
@@ -165,11 +160,11 @@ commonSuffix nl il =
 mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
           -> [String]             -- ^ Exclusion tags
           -> [String]             -- ^ Untouchable instances
-          -> (Node.AssocList, Instance.AssocList, [String])
+          -> (Node.List, Instance.List, [String])
           -- ^ Data from backends
           -> Result (Node.List, Instance.List, [String])
-mergeData um extags exinsts (nl, il, tags) =
-  let il2 = Container.fromAssocList il
+mergeData um extags exinsts (nl, il2, tags) =
+  let il = Container.elems il2
       il3 = foldl' (\im (name, n_util) ->
                         case Container.findByName im name of
                           Nothing -> im -- skipping unknown instance
@@ -181,10 +176,9 @@ mergeData um extags exinsts (nl, il, tags) =
       il4 = Container.map (filterExTags allextags .
                            updateMovable exinsts) il3
       nl2 = foldl' fixNodes nl (Container.elems il4)
-      nl3 = Container.fromAssocList
-            (map (\ (k, v) -> (k, Node.buildPeers v il4)) nl2)
-      node_names = map (Node.name . snd) nl
-      inst_names = map (Instance.name . snd) il
+      nl3 = Container.map (\node -> Node.buildPeers node il4) nl2
+      node_names = map Node.name (Container.elems nl)
+      inst_names = map Instance.name il
       common_suffix = longestDomain (node_names ++ inst_names)
       snl = Container.map (computeAlias common_suffix) nl3
       sil = Container.map (computeAlias common_suffix) il4