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