Simulation backend: allow multiple node groups

[ganeti-local] / hspace.hs

diff --git a/hspace.hs b/hspace.hs
index 189b0ba..2678c9d 100644 (file)
--- a/hspace.hs
+++ b/hspace.hs
@@ -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
@@ -207,7 +206,7 @@ main = do
       ispec = optISpec opts
       shownodes = optShowNodes opts
 
-  (_, fixed_nl, il, _) <- loadExternalData opts
+  (gl, fixed_nl, il, ctags) <- loadExternalData opts
 
   printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
   printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
@@ -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
@@ -312,7 +304,7 @@ main = do
        when (isJust $ optSaveCluster opts) $
             do
               let out_path = (fromJust $ optSaveCluster opts) <.> "tiered"
-                  adata = serializeCluster trl_nl trl_il
+                  adata = serializeCluster gl trl_nl trl_il ctags
               writeFile out_path adata
               hPrintf stderr "The cluster state after tiered allocation\
                              \ has been written to file '%s'\n"
@@ -346,7 +338,7 @@ main = do
   when (isJust $ optSaveCluster opts) $
        do
          let out_path = (fromJust $ optSaveCluster opts) <.> "alloc"
-             adata = serializeCluster fin_nl fin_il
+             adata = serializeCluster gl fin_nl fin_il ctags
          writeFile out_path adata
          hPrintf stderr "The cluster state after standard allocation\
                         \ has been written to file '%s'\n"