Revision 3ce8009a hspace.hs
| b/hspace.hs | ||
|---|---|---|
| 117 | 117 |
, ("VCPU", printf "%d" . Cluster.csVcpu)
|
| 118 | 118 |
] |
| 119 | 119 |
|
| 120 |
-- | Recursively place instances on the cluster until we're out of space |
|
| 121 |
iterateDepth :: Node.List |
|
| 122 |
-> Instance.List |
|
| 123 |
-> Instance.Instance |
|
| 124 |
-> Int |
|
| 125 |
-> [Instance.Instance] |
|
| 126 |
-> Result (FailStats, Node.List, [Instance.Instance]) |
|
| 127 |
iterateDepth nl il newinst nreq ixes = |
|
| 128 |
let depth = length ixes |
|
| 129 |
newname = printf "new-%d" depth::String |
|
| 130 |
newidx = length (Container.elems il) + depth |
|
| 131 |
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx |
|
| 132 |
in case Cluster.tryAlloc nl il newi2 nreq of |
|
| 133 |
Bad s -> Bad s |
|
| 134 |
Ok (errs, _, sols3) -> |
|
| 135 |
case sols3 of |
|
| 136 |
[] -> Ok (Cluster.collapseFailures errs, nl, ixes) |
|
| 137 |
(_, (xnl, xi, _)):[] -> |
|
| 138 |
iterateDepth xnl il newinst nreq $! (xi:ixes) |
|
| 139 |
_ -> Bad "Internal error: multiple solutions for single\ |
|
| 140 |
\ allocation" |
|
| 141 |
|
|
| 142 |
tieredAlloc :: Node.List |
|
| 143 |
-> Instance.List |
|
| 144 |
-> Instance.Instance |
|
| 145 |
-> Int |
|
| 146 |
-> [Instance.Instance] |
|
| 147 |
-> Result (FailStats, Node.List, [Instance.Instance]) |
|
| 148 |
tieredAlloc nl il newinst nreq ixes = |
|
| 149 |
case iterateDepth nl il newinst nreq ixes of |
|
| 150 |
Bad s -> Bad s |
|
| 151 |
Ok (errs, nl', ixes') -> |
|
| 152 |
case Instance.shrinkByType newinst . fst . last $ |
|
| 153 |
sortBy (comparing snd) errs of |
|
| 154 |
Bad _ -> Ok (errs, nl', ixes') |
|
| 155 |
Ok newinst' -> |
|
| 156 |
tieredAlloc nl' il newinst' nreq ixes' |
|
| 157 |
|
|
| 158 |
|
|
| 159 | 120 |
-- | Function to print stats for a given phase |
| 160 | 121 |
printStats :: Phase -> Cluster.CStats -> [(String, String)] |
| 161 | 122 |
printStats ph cs = |
| ... | ... | |
| 320 | 281 |
(_, trl_nl, trl_ixes) <- |
| 321 | 282 |
if stop_allocation |
| 322 | 283 |
then return result_noalloc |
| 323 |
else exitifbad (tieredAlloc nl il (iofspec tspec) req_nodes []) |
|
| 284 |
else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec) |
|
| 285 |
req_nodes []) |
|
| 324 | 286 |
let fin_trl_ixes = reverse trl_ixes |
| 325 | 287 |
ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes |
| 326 | 288 |
spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs)) |
| ... | ... | |
| 350 | 312 |
(ereason, fin_nl, ixes) <- |
| 351 | 313 |
if stop_allocation |
| 352 | 314 |
then return result_noalloc |
| 353 |
else exitifbad (iterateDepth nl il reqinst req_nodes [])
|
|
| 315 |
else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [])
|
|
| 354 | 316 |
|
| 355 | 317 |
let allocs = length ixes |
| 356 | 318 |
fin_ixes = reverse ixes |
Also available in: Unified diff