Revision 262a08a2 hail.hs
| b/hail.hs | ||
|---|---|---|
| 51 | 51 |
"show help" |
| 52 | 52 |
] |
| 53 | 53 |
|
| 54 |
-- | Compute online nodes from a NodeList |
|
| 55 |
getOnline :: NodeList -> [Node.Node] |
|
| 54 |
-- | Compute online nodes from a Node.List
|
|
| 55 |
getOnline :: Node.List -> [Node.Node]
|
|
| 56 | 56 |
getOnline = filter (not . Node.offline) . Container.elems |
| 57 | 57 |
|
| 58 | 58 |
-- | Try to allocate an instance on the cluster |
| 59 | 59 |
tryAlloc :: (Monad m) => |
| 60 |
NodeList |
|
| 61 |
-> InstanceList |
|
| 60 |
Node.List
|
|
| 61 |
-> Instance.List
|
|
| 62 | 62 |
-> Instance.Instance |
| 63 | 63 |
-> Int |
| 64 |
-> m [(Maybe NodeList, [Node.Node])] |
|
| 64 |
-> m [(Maybe Node.List, [Node.Node])]
|
|
| 65 | 65 |
tryAlloc nl _ inst 2 = |
| 66 | 66 |
let all_nodes = getOnline nl |
| 67 | 67 |
all_pairs = liftM2 (,) all_nodes all_nodes |
| ... | ... | |
| 83 | 83 |
|
| 84 | 84 |
-- | Try to allocate an instance on the cluster |
| 85 | 85 |
tryReloc :: (Monad m) => |
| 86 |
NodeList |
|
| 87 |
-> InstanceList |
|
| 86 |
Node.List
|
|
| 87 |
-> Instance.List
|
|
| 88 | 88 |
-> Int |
| 89 | 89 |
-> Int |
| 90 | 90 |
-> [Int] |
| 91 |
-> m [(Maybe NodeList, [Node.Node])] |
|
| 91 |
-> m [(Maybe Node.List, [Node.Node])]
|
|
| 92 | 92 |
tryReloc nl il xid 1 ex_idx = |
| 93 | 93 |
let all_nodes = getOnline nl |
| 94 | 94 |
inst = Container.find xid il |
| 95 | 95 |
ex_idx' = (Instance.pnode inst):ex_idx |
| 96 |
valid_nodes = filter (not . flip elem ex_idx' . idx) all_nodes |
|
| 96 |
valid_nodes = filter (not . flip elem ex_idx' . idxOf) all_nodes
|
|
| 97 | 97 |
valid_idxes = map Node.idx valid_nodes |
| 98 | 98 |
sols1 = map (\x -> let (mnl, _, _, _) = |
| 99 | 99 |
Cluster.applyMove nl inst |
| ... | ... | |
| 106 | 106 |
\destinations required (" ++ (show reqn) ++
|
| 107 | 107 |
"), only one supported" |
| 108 | 108 |
|
| 109 |
filterFails :: (Monad m) => [(Maybe NodeList, [Node.Node])] |
|
| 110 |
-> m [(NodeList, [Node.Node])] |
|
| 109 |
filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])]
|
|
| 110 |
-> m [(Node.List, [Node.Node])]
|
|
| 111 | 111 |
filterFails sols = |
| 112 | 112 |
if null sols then fail "No nodes onto which to allocate at all" |
| 113 | 113 |
else let sols' = filter (isJust . fst) sols |
| ... | ... | |
| 116 | 116 |
else |
| 117 | 117 |
return $ map (\(x, y) -> (fromJust x, y)) sols' |
| 118 | 118 |
|
| 119 |
processResults :: (Monad m) => [(NodeList, [Node.Node])] |
|
| 119 |
processResults :: (Monad m) => [(Node.List, [Node.Node])]
|
|
| 120 | 120 |
-> m (String, [Node.Node]) |
| 121 | 121 |
processResults sols = |
| 122 | 122 |
let sols' = map (\(nl', ns) -> (Cluster.compCV nl', ns)) sols |
| ... | ... | |
| 156 | 156 |
let sols = new_nodes >>= filterFails >>= processResults |
| 157 | 157 |
let (ok, info, rn) = case sols of |
| 158 | 158 |
Ok (info, sn) -> (True, "Request successful: " ++ info, |
| 159 |
map ((++ csf) . name) sn) |
|
| 159 |
map ((++ csf) . Node.name) sn)
|
|
| 160 | 160 |
Bad s -> (False, "Request failed: " ++ s, []) |
| 161 | 161 |
resp = formatResponse ok info rn |
| 162 | 162 |
putStrLn resp |
Also available in: Unified diff