+ -- utility functions
+ let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
+ (rspecCpu spx) "ADMIN_down" [] (-1) (-1)
+ exitifbad val = (case val of
+ Bad s -> do
+ hPrintf stderr "Failure: %s\n" s :: IO ()
+ exitWith $ ExitFailure 1
+ Ok x -> return x)
+
+
+ let reqinst = iofspec ispec
+
+ -- Run the tiered allocation, if enabled
+
+ (case optTieredSpec opts of
+ Nothing -> return ()
+ Just tspec -> do
+ let tresu = tieredAlloc nl il (iofspec tspec) req_nodes []
+ (_, trl_nl, trl_ixes) <- exitifbad tresu
+ 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]
+
+ when (verbose > 1) $ do
+ hPutStrLn stderr "Tiered allocation map"
+ hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
+ formatTable (map (printInstance trl_nl) fin_trl_ixes)
+ [False, False, False, True, True, True]
+
+ when (isJust shownodes) $ do
+ hPutStrLn stderr ""
+ hPutStrLn stderr "Tiered allocation status:"
+ hPutStrLn stderr $ Cluster.printNodes trl_nl (fromJust shownodes)
+
+ printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
+ printKeys [("TSPEC", intercalate " " spec_map')]
+ printAllocationStats nl trl_nl)
+
+ -- Run the standard (avg-mode) allocation
+
+ let result = iterateDepth nl il reqinst req_nodes []
+ (ereason, fin_nl, ixes) <- exitifbad result