Revision a8038349 htools/Ganeti/HTools/Cluster.hs
| b/htools/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 517 | 517 |
let Table ini_nl ini_il _ ini_plc = ini_tbl |
| 518 | 518 |
tmp_resu = applyMove ini_nl target move |
| 519 | 519 |
in case tmp_resu of |
| 520 |
OpFail _ -> cur_tbl
|
|
| 521 |
OpGood (upd_nl, new_inst, pri_idx, sec_idx) ->
|
|
| 520 |
Bad _ -> cur_tbl
|
|
| 521 |
Ok (upd_nl, new_inst, pri_idx, sec_idx) ->
|
|
| 522 | 522 |
let tgt_idx = Instance.idx target |
| 523 | 523 |
upd_cvar = compCV upd_nl |
| 524 | 524 |
upd_il = Container.add tgt_idx new_inst ini_il |
| ... | ... | |
| 665 | 665 |
-- | Update current Allocation solution and failure stats with new |
| 666 | 666 |
-- elements. |
| 667 | 667 |
concatAllocs :: AllocSolution -> OpResult Node.AllocElement -> AllocSolution |
| 668 |
concatAllocs as (OpFail reason) = as { asFailures = reason : asFailures as }
|
|
| 668 |
concatAllocs as (Bad reason) = as { asFailures = reason : asFailures as }
|
|
| 669 | 669 |
|
| 670 |
concatAllocs as (OpGood ns) =
|
|
| 670 |
concatAllocs as (Ok ns) =
|
|
| 671 | 671 |
let -- Choose the old or new solution, based on the cluster score |
| 672 | 672 |
cntok = asAllocs as |
| 673 | 673 |
osols = asSolution as |
| ... | ... | |
| 1039 | 1039 |
-> EvacInnerState -- ^ New best solution |
| 1040 | 1040 |
evacOneNodeInner nl inst gdx op_fn accu ndx = |
| 1041 | 1041 |
case applyMove nl inst (op_fn ndx) of |
| 1042 |
OpFail fm -> let fail_msg = "Node " ++ Container.nameOf nl ndx ++
|
|
| 1043 |
" failed: " ++ show fm
|
|
| 1044 |
in either (const $ Left fail_msg) (const accu) accu
|
|
| 1045 |
OpGood (nl', inst', _, _) ->
|
|
| 1042 |
Bad fm -> let fail_msg = "Node " ++ Container.nameOf nl ndx ++
|
|
| 1043 |
" failed: " ++ show fm |
|
| 1044 |
in either (const $ Left fail_msg) (const accu) accu |
|
| 1045 |
Ok (nl', inst', _, _) ->
|
|
| 1046 | 1046 |
let nodes = Container.elems nl' |
| 1047 | 1047 |
-- The fromJust below is ugly (it can fail nastily), but |
| 1048 | 1048 |
-- at this point we should have any internal mismatches, |
Also available in: Unified diff