Revision 20d2476e
| b/src/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 78 | 78 |
|
| 79 | 79 |
import qualified Data.IntSet as IntSet |
| 80 | 80 |
import Data.List |
| 81 |
import Data.Maybe (fromJust, isNothing) |
|
| 81 |
import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
|
|
| 82 | 82 |
import Data.Ord (comparing) |
| 83 | 83 |
import Text.Printf (printf) |
| 84 | 84 |
|
| ... | ... | |
| 1279 | 1279 |
newlimit newinst allocnodes (xi:ixes) |
| 1280 | 1280 |
(totalResources xnl:cstats) |
| 1281 | 1281 |
|
| 1282 |
-- | Predicate whether shrinking a single resource can lead to a valid |
|
| 1283 |
-- allocation. |
|
| 1284 |
sufficesShrinking :: (Instance.Instance -> AllocSolution) -> Instance.Instance |
|
| 1285 |
-> FailMode -> Bool |
|
| 1286 |
sufficesShrinking allocFn inst fm = any isJust . map (asSolution . allocFn) $ |
|
| 1287 |
iterateOk (`Instance.shrinkByType` fm) inst |
|
| 1288 |
|
|
| 1282 | 1289 |
-- | Tiered allocation method. |
| 1283 | 1290 |
-- |
| 1284 | 1291 |
-- This places instances on the cluster, and decreases the spec until |
| ... | ... | |
| 1294 | 1301 |
(stop, newlimit) = case limit of |
| 1295 | 1302 |
Nothing -> (False, Nothing) |
| 1296 | 1303 |
Just n -> (n <= ixes_cnt, |
| 1297 |
Just (n - ixes_cnt)) in |
|
| 1298 |
if stop then newsol else |
|
| 1299 |
case Instance.shrinkByType newinst . fst . last $ |
|
| 1300 |
sortBy (comparing snd) errs of |
|
| 1304 |
Just (n - ixes_cnt)) |
|
| 1305 |
sortedErrs = map fst $ sortBy (comparing snd) errs |
|
| 1306 |
suffShrink = sufficesShrinking (fromMaybe emptyAllocSolution |
|
| 1307 |
. flip (tryAlloc nl' il') allocnodes) |
|
| 1308 |
newinst |
|
| 1309 |
in if stop then newsol else |
|
| 1310 |
case Instance.shrinkByType newinst . last $ |
|
| 1311 |
sortedErrs ++ filter suffShrink sortedErrs of |
|
| 1301 | 1312 |
Bad _ -> newsol |
| 1302 | 1313 |
Ok newinst' -> tieredAlloc nl' il' newlimit |
| 1303 | 1314 |
newinst' allocnodes ixes' cstats' |
Also available in: Unified diff