diff --git a/src/Cluster.hs b/src/Cluster.hs index c45f9b93cca7c32ff92297b80f37815ec9bc0e11..1ba22c55dd040598911e684c1ff6853f7d8f704d 100644 --- a/src/Cluster.hs +++ b/src/Cluster.hs @@ -394,29 +394,43 @@ checkMove :: Table -- ^ The current solution -> [Instance.Instance] -- ^ List of instances still to move -> Table -- ^ The new solution checkMove ini_tbl victims = - let target = head victims - opdx = Instance.pnode target - osdx = Instance.snode target - vtail = tail victims - have_tail = (length vtail) > 0 - Table ini_nl _ _ _ = ini_tbl - nodes = filter (\node -> let idx = Node.idx node - in idx /= opdx && idx /= osdx) - $ Container.elems ini_nl - aft_failover = checkSingleStep ini_tbl target ini_tbl Failover - next_tbl = - foldl' - (\ accu_p new_node -> - let - new_idx = Node.idx new_node - pmoves = [ReplacePrimary new_idx, - ReplaceSecondary new_idx] - in - foldl' (checkSingleStep ini_tbl target) accu_p pmoves - ) aft_failover nodes - in if have_tail then checkMove next_tbl vtail - else next_tbl - + let Table ini_nl _ _ ini_plc = ini_tbl + best_tbl = + foldl -- iterate over all instances, computing the best move + (\ step_tbl target -> + let + opdx = Instance.pnode target + osdx = Instance.snode target + nodes = filter (\node -> let idx = Node.idx node + in idx /= opdx && idx /= osdx) + $ Container.elems ini_nl + aft_failover = checkSingleStep ini_tbl + target ini_tbl Failover + next_tbl = -- iterate over the possible nodes for + -- this instance + foldl' + (\ accu_p new_node -> + let + new_idx = Node.idx new_node + pmoves = [ReplacePrimary new_idx, + ReplaceSecondary new_idx] + in + foldl' -- while doing both possible moves + (checkSingleStep ini_tbl target) accu_p pmoves + ) aft_failover nodes + in + compareTables step_tbl next_tbl + ) ini_tbl victims + in let + Table _ _ _ best_plc = best_tbl + (target, _, _) = head best_plc + vtail = filter (\inst -> Instance.idx inst /= target) victims + in + if length best_plc == length ini_plc then -- no advancement + ini_tbl + else + if null vtail then best_tbl + else checkMove best_tbl vtail {- | Auxiliary function for solution computation.