+ in case Cluster.tryAlloc nl il newi2 nreq of
+ Bad s -> Bad s
+ Ok (errs, _, sols3) ->
+ case sols3 of
+ [] -> Ok (Cluster.collapseFailures errs, nl, ixes)
+ (_, (xnl, xi, _)):[] ->
+ iterateDepth xnl il newinst nreq $! (xi:ixes)
+ _ -> Bad "Internal error: multiple solutions for single\
+ \ allocation"
+
+tieredAlloc :: Node.List
+ -> Instance.List
+ -> Instance.Instance
+ -> Int
+ -> [Instance.Instance]
+ -> Result (FailStats, Node.List, [Instance.Instance])
+tieredAlloc nl il newinst nreq ixes =
+ case iterateDepth nl il newinst nreq ixes of
+ Bad s -> Bad s
+ Ok (errs, nl', ixes') ->
+ case Instance.shrinkByType newinst . fst . last $
+ sortBy (comparing snd) errs of
+ Bad _ -> Ok (errs, nl', ixes')
+ Ok newinst' ->
+ tieredAlloc nl' il newinst' nreq ixes'
+
+
+-- | Function to print stats for a given phase
+printStats :: Phase -> Cluster.CStats -> [(String, String)]
+printStats ph cs =
+ map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
+ where kind = case ph of
+ PInitial -> "INI"
+ PFinal -> "FIN"
+ PTiered -> "TRL"
+
+-- | Print final stats and related metrics
+printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
+printResults fin_nl num_instances allocs sreason = do
+ let fin_stats = Cluster.totalResources fin_nl
+ fin_instances = num_instances + allocs
+
+ when (num_instances + allocs /= Cluster.csNinst fin_stats) $
+ do
+ hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
+ \ != counted (%d)\n" (num_instances + allocs)
+ (Cluster.csNinst fin_stats) :: IO ()
+ exitWith $ ExitFailure 1
+
+ printKeys $ printStats PFinal fin_stats
+ printKeys [ ("ALLOC_USAGE", printf "%.8f"
+ ((fromIntegral num_instances::Double) /
+ fromIntegral fin_instances))
+ , ("ALLOC_INSTANCES", printf "%d" allocs)
+ , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
+ ]
+ printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
+ printf "%d" y)) sreason
+ -- this should be the final entry
+ printKeys [("OK", "1")]
+
+formatRSpec :: String -> RSpec -> [(String, String)]
+formatRSpec s r =
+ [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
+ , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
+ , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
+ ]