diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs index 7d11ddb0a24592901596a96d560d5f00146b000b..66d87526b3ad075a4f6e2e11639f58b202af0499 100644 --- a/Ganeti/HTools/Cluster.hs +++ b/Ganeti/HTools/Cluster.hs @@ -625,16 +625,16 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \ "), only two supported" -- | Given a group/result, describe it as a nice (list of) messages -solutionDescription :: (GroupID, Result AllocSolution) -> [String] +solutionDescription :: (Gdx, Result AllocSolution) -> [String] solutionDescription (groupId, result) = case result of - Ok solution -> map (printf "Group %s: %s" groupId) (asLog solution) - Bad message -> [printf "Group %s: error %s" groupId message] + Ok solution -> map (printf "Group %d: %s" groupId) (asLog solution) + Bad message -> [printf "Group %d: error %s" groupId message] -- | From a list of possibly bad and possibly empty solutions, filter -- only the groups with a valid result -filterMGResults :: [(GroupID, Result AllocSolution)] -> - [(GroupID, AllocSolution)] +filterMGResults :: [(Gdx, Result AllocSolution)] -> + [(Gdx, AllocSolution)] filterMGResults = filter (not . null . asSolutions . snd) . map (\(y, Ok x) -> (y, x)) . @@ -651,7 +651,7 @@ tryMGAlloc mgnl mgil inst cnt = -- TODO: currently we consider all groups preferred sols = map (\(gid, (nl, il)) -> (gid, tryAlloc nl il inst cnt)) groups:: - [(GroupID, Result AllocSolution)] + [(Gdx, Result AllocSolution)] all_msgs = concatMap solutionDescription sols goodSols = filterMGResults sols extractScore = \(_, _, _, x) -> x @@ -660,7 +660,7 @@ tryMGAlloc mgnl mgil inst cnt = in if null sortedSols then Bad $ intercalate ", " all_msgs else let (final_group, final_sol) = head sortedSols - selmsg = "Selected group: " ++ final_group + selmsg = "Selected group: " ++ show final_group in Ok $ final_sol { asLog = selmsg:all_msgs } -- | Try to relocate an instance on the cluster. @@ -925,19 +925,19 @@ iMoveToJob nl il idx move = FailoverAndReplace ns -> [ opF, opR ns ] -- | Computes the group of an instance -instanceGroup :: Node.List -> Instance.Instance -> Result GroupID +instanceGroup :: Node.List -> Instance.Instance -> Result Gdx instanceGroup nl i = let sidx = Instance.sNode i pnode = Container.find (Instance.pNode i) nl snode = if sidx == Node.noSecondary then pnode else Container.find sidx nl - puuid = Node.group pnode - suuid = Node.group snode - in if puuid /= suuid - then fail ("Instance placed accross two node groups, primary " ++ puuid ++ - ", secondary " ++ suuid) - else return puuid + pgroup = Node.group pnode + sgroup = Node.group snode + in if pgroup /= sgroup + then fail ("Instance placed accross two node groups, primary " ++ + show pgroup ++ ", secondary " ++ show sgroup) + else return pgroup -- | Compute the list of badly allocated instances (split across node -- groups) @@ -947,7 +947,7 @@ findSplitInstances nl il = -- | Splits a cluster into the component node groups splitCluster :: Node.List -> Instance.List -> - [(GroupID, (Node.List, Instance.List))] + [(Gdx, (Node.List, Instance.List))] splitCluster nl il = let ngroups = Node.computeGroups (Container.elems nl) in map (\(guuid, nodes) -> diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs index 4117fd478f52503971f728c1eb28a8a9e7dbe698..f015f9d42f0a0436f9cbe925e8a368480797e897 100644 --- a/Ganeti/HTools/IAlloc.hs +++ b/Ganeti/HTools/IAlloc.hs @@ -75,15 +75,17 @@ parseInstance ktn n a = do return (n, Instance.setBoth (snd base) pidx sidx) -- | Parses a node as found in the cluster node list. -parseNode :: String -- ^ The node's name +parseNode :: NameAssoc -- ^ The group association + -> String -- ^ The node's name -> [(String, JSValue)] -- ^ The JSON object -> Result (String, Node.Node) -parseNode n a = do +parseNode ktg n a = do offline <- fromObj "offline" a drained <- fromObj "drained" a guuid <- fromObj "group" a + gidx <- lookupGroup ktg n guuid node <- (if offline || drained - then return $ Node.create n 0 0 0 0 0 0 True guuid + then return $ Node.create n 0 0 0 0 0 0 True gidx else do mtotal <- fromObj "total_memory" a mnode <- fromObj "reserved_memory" a @@ -92,7 +94,7 @@ parseNode n a = do dfree <- fromObj "free_disk" a ctotal <- fromObj "total_cpus" a return $ Node.create n mtotal mnode mfree - dtotal dfree ctotal False guuid) + dtotal dfree ctotal False gidx) return (n, node) -- | Parses a group as found in the cluster group list. @@ -114,10 +116,11 @@ parseData body = do -- existing group parsing glist <- liftM fromJSObject (fromObj "nodegroups" obj) gobj <- mapM (\(x, y) -> asJSObject y >>= parseGroup x . fromJSObject) glist - let (_, gl) = assignIndices gobj + let (ktg, gl) = assignIndices gobj -- existing node parsing nlist <- liftM fromJSObject (fromObj "nodes" obj) - nobj <- mapM (\(x,y) -> asJSObject y >>= parseNode x . fromJSObject) nlist + nobj <- mapM (\(x,y) -> + asJSObject y >>= parseNode ktg x . fromJSObject) nlist let (ktn, nl) = assignIndices nobj -- existing instance parsing ilist <- fromObj "instances" obj diff --git a/Ganeti/HTools/Luxi.hs b/Ganeti/HTools/Luxi.hs index c5b93437c22fe2be99f8b5216c9d498428f51a34..88c22849db2acd828eb7ef8ec5eddf0d4f0451ac 100644 --- a/Ganeti/HTools/Luxi.hs +++ b/Ganeti/HTools/Luxi.hs @@ -120,22 +120,22 @@ parseInstance ktn (JSArray [ name, disk, mem, vcpus parseInstance _ v = fail ("Invalid instance query result: " ++ show v) -- | Parse a node list in JSON format. -getNodes :: JSValue -> Result [(String, Node.Node)] -getNodes arr = toArray arr >>= mapM parseNode +getNodes :: NameAssoc -> JSValue -> Result [(String, Node.Node)] +getNodes ktg arr = toArray arr >>= mapM (parseNode ktg) -- | Construct a node from a JSON object. -parseNode :: JSValue -> Result (String, Node.Node) -parseNode (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree - , ctotal, offline, drained, vm_capable, g_uuid ]) +parseNode :: NameAssoc -> JSValue -> Result (String, Node.Node) +parseNode ktg (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree + , ctotal, offline, drained, vm_capable, g_uuid ]) = do xname <- annotateResult "Parsing new node" (fromJVal name) let convert v = annotateResult ("Node '" ++ xname ++ "'") (fromJVal v) xoffline <- convert offline xdrained <- convert drained xvm_capable <- convert vm_capable - xguuid <- convert g_uuid + xgdx <- convert g_uuid >>= lookupGroup ktg xname node <- (if xoffline || xdrained || not xvm_capable - then return $ Node.create xname 0 0 0 0 0 0 True xguuid + then return $ Node.create xname 0 0 0 0 0 0 True xgdx else do xmtotal <- convert mtotal xmnode <- convert mnode @@ -144,10 +144,10 @@ parseNode (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree xdfree <- convert dfree xctotal <- convert ctotal return $ Node.create xname xmtotal xmnode xmfree - xdtotal xdfree xctotal False xguuid) + xdtotal xdfree xctotal False xgdx) return (xname, node) -parseNode v = fail ("Invalid node query result: " ++ show v) +parseNode _ v = fail ("Invalid node query result: " ++ show v) getClusterTags :: JSValue -> Result [String] getClusterTags v = do @@ -188,8 +188,8 @@ parseData :: (Result JSValue, Result JSValue, Result JSValue, Result JSValue) -> Result (Group.List, Node.List, Instance.List, [String]) parseData (groups, nodes, instances, cinfo) = do group_data <- groups >>= getGroups - let (_, group_idx) = assignIndices group_data - node_data <- nodes >>= getNodes + let (group_names, group_idx) = assignIndices group_data + node_data <- nodes >>= getNodes group_names let (node_names, node_idx) = assignIndices node_data inst_data <- instances >>= getInstances node_names let (_, inst_idx) = assignIndices inst_data diff --git a/Ganeti/HTools/Node.hs b/Ganeti/HTools/Node.hs index 5fd331d7b0650c7ee8c38fb9d2567316fc6762b6..73162e6ea5fc94129f7753b9c0599c8302323cd4 100644 --- a/Ganeti/HTools/Node.hs +++ b/Ganeti/HTools/Node.hs @@ -121,7 +121,7 @@ data Node = Node , utilPool :: T.DynUtil -- ^ Total utilisation capacity , utilLoad :: T.DynUtil -- ^ Sum of instance utilisation , pTags :: TagMap -- ^ Map of primary instance tags and their count - , group :: T.GroupID -- ^ The node's group (as UUID) + , group :: T.Gdx -- ^ The node's group (index) } deriving (Show, Eq) instance T.Element Node where @@ -185,7 +185,7 @@ conflictingPrimaries (Node { pTags = t }) = Foldable.sum t - Map.size t -- The index and the peers maps are empty, and will be need to be -- update later via the 'setIdx' and 'buildPeers' functions. create :: String -> Double -> Int -> Int -> Double - -> Int -> Double -> Bool -> String -> Node + -> Int -> Double -> Bool -> T.Gdx -> Node create name_init mem_t_init mem_n_init mem_f_init dsk_t_init dsk_f_init cpu_t_init offline_init group_init = Node { name = name_init @@ -487,7 +487,6 @@ showField t field = "ptags" -> intercalate "," . map (\(k, v) -> printf "%s=%d" k v) . Map.toList $ pTags t "peermap" -> show $ peers t - "group.uuid" -> group t _ -> T.unknownField where T.DynUtil { T.cpuWeight = uC, T.memWeight = uM, @@ -526,7 +525,7 @@ showHeader field = "nload" -> ("lNet", True) "ptags" -> ("PrimaryTags", False) "peermap" -> ("PeerMap", False) - "group.uuid" -> ("GroupUUID", False) + -- TODO: add node fields (group.uuid, group) _ -> (T.unknownField, False) -- | String converter for the node list functionality. @@ -543,7 +542,7 @@ defaultFields = -- | Split a list of nodes into a list of (node group UUID, list of -- associated nodes) -computeGroups :: [Node] -> [(T.GroupID, [Node])] +computeGroups :: [Node] -> [(T.Gdx, [Node])] computeGroups nodes = let nodes' = sortBy (comparing group) nodes nodes'' = groupBy (\a b -> group a == group b) nodes' diff --git a/Ganeti/HTools/QC.hs b/Ganeti/HTools/QC.hs index bf83fcc412781769c8a40fa1a9abb4bf8a458664..536d1bf2dc2449e479259910adfc80e836cbdf3c 100644 --- a/Ganeti/HTools/QC.hs +++ b/Ganeti/HTools/QC.hs @@ -56,6 +56,7 @@ import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.Loader as Loader import qualified Ganeti.HTools.Luxi import qualified Ganeti.HTools.Node as Node +import qualified Ganeti.HTools.Group as Group import qualified Ganeti.HTools.PeerMap as PeerMap import qualified Ganeti.HTools.Rapi import qualified Ganeti.HTools.Simu @@ -78,6 +79,17 @@ maxDsk = 1024 * 1024 * 8 maxCpu :: Int maxCpu = 1024 +defGroup :: Group.Group +defGroup = flip Group.setIdx 0 $ + Group.create "default" Utils.defaultGroupID + Types.AllocPreferred + +defGroupList :: Group.List +defGroupList = Container.fromAssocList [(Group.idx defGroup, defGroup)] + +defGroupAssoc :: Data.Map.Map String Types.Gdx +defGroupAssoc = Data.Map.singleton (Group.uuid defGroup) (Group.idx defGroup) + -- * Helper functions -- | Simple checker for whether OpResult is fail or pass @@ -187,7 +199,7 @@ instance Arbitrary Node.Node where offl <- arbitrary let n = Node.create name (fromIntegral mem_t) mem_n mem_f (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl - Utils.defaultGroupID + 0 n' = Node.buildPeers n Container.empty return n' @@ -483,7 +495,9 @@ prop_Text_Load_Node name tm nm fm td fd tc fo = then "Y" else "N" any_broken = any (< 0) [tm, nm, fm, td, fd, tc] - in case Text.loadNode [name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s] of + gid = Group.uuid defGroup + in case Text.loadNode defGroupAssoc + [name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s, gid] of Nothing -> False Just (name', node) -> if fo || any_broken @@ -498,11 +512,11 @@ prop_Text_Load_Node name tm nm fm td fd tc fo = Node.tCpu node == fromIntegral tc prop_Text_Load_NodeFail fields = - length fields /= 8 ==> isNothing $ Text.loadNode fields + length fields /= 8 ==> isNothing $ Text.loadNode Data.Map.empty fields prop_Text_NodeLSIdempotent node = - (Text.loadNode . - Utils.sepSplit '|' . Text.serializeNode) n == + (Text.loadNode defGroupAssoc. + Utils.sepSplit '|' . Text.serializeNode defGroupList) n == Just (Node.name n, n) -- override failN1 to what loadNode returns by default where n = node { Node.failN1 = True, Node.offline = False } @@ -750,7 +764,7 @@ prop_ClusterAllocBalance node = prop_ClusterCheckConsistency node inst = let nl = makeSmallCluster node 3 [node1, node2, node3] = Container.elems nl - node3' = node3 { Node.group = "other-uuid" } + node3' = node3 { Node.group = 1 } nl' = Container.add (Node.idx node3') node3' nl inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2) inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs index 5b6b3f2957c12af840be082b71ef016cd4f9f8ea..1d33214b56b60b22a46861395f045455636ea113 100644 --- a/Ganeti/HTools/Rapi.hs +++ b/Ganeti/HTools/Rapi.hs @@ -71,9 +71,9 @@ getInstances ktn body = mapM (parseInstance ktn . fromJSObject) -- | Parse a node list in JSON format. -getNodes :: String -> Result [(String, Node.Node)] -getNodes body = loadJSArray "Parsing node data" body >>= - mapM (parseNode . fromJSObject) +getNodes :: NameAssoc -> String -> Result [(String, Node.Node)] +getNodes ktg body = loadJSArray "Parsing node data" body >>= + mapM (parseNode ktg . fromJSObject) -- | Parse a group list in JSON format. getGroups :: String -> Result [(String, Group.Group)] @@ -105,13 +105,13 @@ parseInstance ktn a = do return (name, inst) -- | Construct a node from a JSON object. -parseNode :: [(String, JSValue)] -> Result (String, Node.Node) -parseNode a = do +parseNode :: NameAssoc -> [(String, JSValue)] -> Result (String, Node.Node) +parseNode ktg a = do name <- tryFromObj "Parsing new node" a "name" let extract s = tryFromObj ("Node '" ++ name ++ "'") a s offline <- extract "offline" drained <- extract "drained" - guuid <- extract "group.uuid" + guuid <- extract "group.uuid" >>= lookupGroup ktg name node <- (if offline || drained then return $ Node.create name 0 0 0 0 0 0 True guuid else do @@ -149,8 +149,8 @@ parseData :: (Result String, Result String, Result String, Result String) -> Result (Group.List, Node.List, Instance.List, [String]) parseData (group_body, node_body, inst_body, tags_body) = do group_data <- group_body >>= getGroups - let (_, group_idx) = assignIndices group_data - node_data <- node_body >>= getNodes + let (group_names, group_idx) = assignIndices group_data + node_data <- node_body >>= getNodes group_names let (node_names, node_idx) = assignIndices node_data inst_data <- inst_body >>= getInstances node_names let (_, inst_idx) = assignIndices inst_data diff --git a/Ganeti/HTools/Simu.hs b/Ganeti/HTools/Simu.hs index 503394e221c6654b3f3c3b4fce3bd679ed86c42e..f2a71d9a346212e418e05df72aa164ae987a0c6e 100644 --- a/Ganeti/HTools/Simu.hs +++ b/Ganeti/HTools/Simu.hs @@ -62,7 +62,7 @@ parseData ndata = do let n = Node.create (printf "node%03d" idx) (fromIntegral mem) 0 mem (fromIntegral disk) disk - (fromIntegral cpu) False defaultGroupID + (fromIntegral cpu) False 0 in (idx, Node.setIdx n idx) ) [1..cnt] return (Container.fromAssocList [(0, Group.setIdx defgroup 0)], diff --git a/Ganeti/HTools/Text.hs b/Ganeti/HTools/Text.hs index e49e30a5da37ba4fd4769f422375fafda4c89e0b..2b2c725ff2fb5c3d084a187e80441f7931084903 100644 --- a/Ganeti/HTools/Text.hs +++ b/Ganeti/HTools/Text.hs @@ -52,17 +52,18 @@ import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Instance as Instance -- | Serialize a single node -serializeNode :: Node.Node -> String -serializeNode node = +serializeNode :: Group.List -> Node.Node -> String +serializeNode gl node = printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s" (Node.name node) (Node.tMem node) (Node.nMem node) (Node.fMem node) (Node.tDsk node) (Node.fDsk node) (Node.tCpu node) (if Node.offline node then 'Y' else 'N') - (Node.group node) + (Group.uuid grp) + where grp = Container.find (Node.group node) gl -- | Generate node file data from node objects -serializeNodes :: Node.List -> String -serializeNodes = unlines . map serializeNode . Container.elems +serializeNodes :: Group.List -> Node.List -> String +serializeNodes gl = unlines . map (serializeNode gl) . Container.elems -- | Serialize a single instance serializeInstance :: Node.List -> Instance.Instance -> String @@ -86,9 +87,9 @@ serializeInstances nl = unlines . map (serializeInstance nl) . Container.elems -- | Generate complete cluster data from node and instance lists -serializeCluster :: Node.List -> Instance.List -> String -serializeCluster nl il = - let ndata = serializeNodes nl +serializeCluster :: Group.List -> Node.List -> Instance.List -> String +serializeCluster gl nl il = + let ndata = serializeNodes gl nl idata = serializeInstances nl il in ndata ++ ['\n'] ++ idata @@ -100,14 +101,12 @@ loadGroup [name, gid] = loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'" -- | Load a node from a field list. -loadNode :: (Monad m) => [String] -> m (String, Node.Node) --- compatibility wrapper for old text files -loadNode [name, tm, nm, fm, td, fd, tc, fo] = - loadNode [name, tm, nm, fm, td, fd, tc, fo, defaultGroupID] -loadNode [name, tm, nm, fm, td, fd, tc, fo, gu] = do +loadNode :: (Monad m) => NameAssoc -> [String] -> m (String, Node.Node) +loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] = do + gdx <- lookupGroup ktg name gu new_node <- if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then - return $ Node.create name 0 0 0 0 0 0 True gu + return $ Node.create name 0 0 0 0 0 0 True gdx else do vtm <- tryRead name tm vnm <- tryRead name nm @@ -115,9 +114,9 @@ loadNode [name, tm, nm, fm, td, fd, tc, fo, gu] = do vtd <- tryRead name td vfd <- tryRead name fd vtc <- tryRead name tc - return $ Node.create name vtm vnm vfm vtd vfd vtc False gu + return $ Node.create name vtm vnm vfm vtd vfd vtc False gdx 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) => @@ -168,9 +167,9 @@ parseData fdata = do [] -> Bad "Invalid format of the input file (no instance data)" _:xs -> Ok xs {- group file: name uuid -} - (_, gl) <- loadTabular glines loadGroup + (ktg, gl) <- loadTabular glines loadGroup {- node file: name t_mem n_mem f_mem t_disk f_disk -} - (ktn, nl) <- loadTabular nfixed loadNode + (ktn, nl) <- loadTabular nfixed (loadNode ktg) {- instance file: name mem disk status pnode snode -} (_, il) <- loadTabular ifixed (loadInst ktn) return (gl, nl, il, []) diff --git a/hbal.hs b/hbal.hs index 68a391f4c137e243a42bcbefb94e8b0f52ea796e..47ad6b1126a16da1ab1c9405a10d45b45bbb8de5 100644 --- a/hbal.hs +++ b/hbal.hs @@ -41,6 +41,7 @@ import Text.Printf (printf, hPrintf) import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Cluster as Cluster +import qualified Ganeti.HTools.Group as Group import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Instance as Instance @@ -226,7 +227,7 @@ main = do verbose = optVerbose opts shownodes = optShowNodes opts - (_, fixed_nl, ilf, ctags) <- loadExternalData opts + (gl, fixed_nl, ilf, ctags) <- loadExternalData opts let offline_names = optOffline opts all_nodes = Container.elems fixed_nl @@ -270,7 +271,7 @@ main = do let ngroups = Cluster.splitCluster nlf ilf when (length ngroups > 1 && isNothing (optGroup opts)) $ do hPutStrLn stderr "Found multiple node groups:" - mapM_ (hPutStrLn stderr . (" " ++) . fst ) ngroups + mapM_ (hPutStrLn stderr . (" " ++) . show . fst ) ngroups hPutStrLn stderr "Aborting." exitWith $ ExitFailure 1 @@ -278,22 +279,32 @@ main = do (Container.size nlf) (Container.size ilf) - (guuid, (nl, il)) <- case optGroup opts of - Nothing -> return $ head ngroups - Just g -> case lookup g ngroups of + (gname, (nl, il)) <- case optGroup opts of + Nothing -> do + let (gidx, cdata) = head ngroups + grp = Container.find gidx gl + return (Group.name grp, cdata) + Just g -> case Container.findByName gl g of Nothing -> do hPutStrLn stderr $ "Node group " ++ g ++ " not found. Node group list is:" - mapM_ (hPutStrLn stderr . (" " ++) . fst ) ngroups + mapM_ (hPutStrLn stderr . (" " ++) . Group.name ) (Container.elems gl) hPutStrLn stderr "Aborting." exitWith $ ExitFailure 1 - Just cdata -> return (g, cdata) + Just grp -> + case lookup (Group.idx grp) ngroups of + Nothing -> do + -- TODO: while this is unlikely to happen, log here the + -- actual group data to help debugging + hPutStrLn stderr $ "Internal failure, missing group idx" + exitWith $ ExitFailure 1 + Just cdata -> return (Group.name grp, cdata) unless oneline $ printf "Group size %d nodes, %d instances\n" (Container.size nl) (Container.size il) - putStrLn $ "Selected node group: " ++ guuid + putStrLn $ "Selected node group: " ++ gname when (length csf > 0 && not oneline && verbose > 1) $ printf "Note: Stripping common suffix of '%s' from names\n" csf @@ -379,7 +390,7 @@ main = do when (isJust $ optSaveCluster opts) $ do let out_path = fromJust $ optSaveCluster opts - adata = serializeCluster fin_nl fin_il + adata = serializeCluster gl fin_nl fin_il writeFile out_path adata printf "The cluster state has been written to file '%s'\n" out_path diff --git a/hscan.hs b/hscan.hs index 9e187776039a07599db2f94fc3b65caf6be5b284..5c8dbda9096ec986fef19cffbeff4a17b4bb11a6 100644 --- a/hscan.hs +++ b/hscan.hs @@ -95,7 +95,7 @@ processData :: Result (Group.List, Node.List, Instance.List, [String]) processData input_data = do (gl, nl, il, _) <- input_data >>= Loader.mergeData [] [] [] let (_, fix_nl) = Loader.checkData nl il - adata = serializeCluster nl il + adata = serializeCluster gl nl il return (gl, fix_nl, il, adata) -- | Writes cluster data out diff --git a/hspace.hs b/hspace.hs index 189b0ba981402a121401ff9c4a4d9d25d91d0898..103a63088a9650ba5ce038a593346fa762ae9fd7 100644 --- a/hspace.hs +++ b/hspace.hs @@ -207,7 +207,7 @@ main = do ispec = optISpec opts shownodes = optShowNodes opts - (_, fixed_nl, il, _) <- loadExternalData opts + (gl, fixed_nl, il, _) <- loadExternalData opts printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ] @@ -312,7 +312,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 writeFile out_path adata hPrintf stderr "The cluster state after tiered allocation\ \ has been written to file '%s'\n" @@ -346,7 +346,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 writeFile out_path adata hPrintf stderr "The cluster state after standard allocation\ \ has been written to file '%s'\n"