Revision a947a583
| b/src/Ganeti/HTools/Program/Hroller.hs | ||
|---|---|---|
| 108 | 108 |
locateInstances idxs ndxs conf = |
| 109 | 109 |
foldM (\ cf idx -> locateInstance idx ndxs cf) conf idxs |
| 110 | 110 |
|
| 111 |
-- | Greedily move the non-redundant instances away from a list of nodes. |
|
| 112 |
-- The arguments are the list of nodes to be cleared, a list of nodes the |
|
| 113 |
-- instances can be moved to, and an initial configuration. Returned is a |
|
| 114 |
-- list of nodes that can be cleared simultaneously and the configuration |
|
| 115 |
-- after these nodes are cleared. |
|
| 116 |
clearNodes :: [Ndx] -> [Ndx] -> (Node.List, Instance.List) |
|
| 117 |
-> Result ([Ndx], (Node.List, Instance.List)) |
|
| 118 |
clearNodes [] _ conf = return ([], conf) |
|
| 119 |
clearNodes (ndx:ndxs) targets conf@(nl, _) = |
|
| 111 |
|
|
| 112 |
-- | Greedily clear a node of a kind of instances by a given relocation method. |
|
| 113 |
-- The arguments are a function providing the list of instances to be cleared, |
|
| 114 |
-- the relocation function, the list of nodes to be cleared, a list of nodes |
|
| 115 |
-- that can be relocated to, and the initial configuration. Returned is a list |
|
| 116 |
-- of nodes that can be cleared simultaneously and the configuration after |
|
| 117 |
-- clearing these nodes. |
|
| 118 |
greedyClearNodes :: ((Node.List, Instance.List) -> Ndx -> [Idx]) |
|
| 119 |
-> ([Idx] -> [Ndx] -> (Node.List, Instance.List) |
|
| 120 |
-> Result (Node.List, Instance.List)) |
|
| 121 |
-> [Ndx] -> [Ndx] -> (Node.List, Instance.List) |
|
| 122 |
-> Result ([Ndx], (Node.List, Instance.List)) |
|
| 123 |
greedyClearNodes _ _ [] _ conf = return ([], conf) |
|
| 124 |
greedyClearNodes getInstances relocate (ndx:ndxs) targets conf@(nl, _) = |
|
| 120 | 125 |
withFirst `mplus` withoutFirst where |
| 121 | 126 |
withFirst = do |
| 122 | 127 |
let othernodes = delete ndx targets |
| 123 | 128 |
grp = Node.group $ Container.find ndx nl |
| 124 | 129 |
othernodesSameGroup = |
| 125 | 130 |
filter ((==) grp . Node.group . flip Container.find nl) othernodes |
| 126 |
conf' <- locateInstances (nonRedundant conf ndx) othernodesSameGroup conf |
|
| 127 |
(ndxs', conf'') <- clearNodes ndxs othernodes conf' |
|
| 131 |
conf' <- relocate (getInstances conf ndx) othernodesSameGroup conf |
|
| 132 |
(ndxs', conf'') <- greedyClearNodes getInstances relocate |
|
| 133 |
ndxs othernodes conf' |
|
| 128 | 134 |
return (ndx:ndxs', conf'') |
| 129 |
withoutFirst = clearNodes ndxs targets conf |
|
| 135 |
withoutFirst = greedyClearNodes getInstances relocate ndxs targets conf |
|
| 136 |
|
|
| 137 |
-- | Greedily move the non-redundant instances away from a list of nodes. |
|
| 138 |
-- Returns a list of ndoes that can be cleared simultaneously and the |
|
| 139 |
-- configuration after clearing these nodes. |
|
| 140 |
clearNodes :: [Ndx] -> [Ndx] -> (Node.List, Instance.List) |
|
| 141 |
-> Result ([Ndx], (Node.List, Instance.List)) |
|
| 142 |
clearNodes = greedyClearNodes nonRedundant locateInstances |
|
| 130 | 143 |
|
| 131 | 144 |
-- | Parition a list of nodes into chunks according cluster capacity. |
| 132 | 145 |
partitionNonRedundant :: [Ndx] -> [Ndx] -> (Node.List, Instance.List) |
Also available in: Unified diff