Revision f2280553 hail.hs
| b/hail.hs | ||
|---|---|---|
| 27 | 27 |
|
| 28 | 28 |
import Data.List |
| 29 | 29 |
import Data.Function |
| 30 |
import Data.Maybe (isJust, fromJust) |
|
| 31 | 30 |
import Monad |
| 32 | 31 |
import System |
| 33 | 32 |
import System.IO |
| ... | ... | |
| 43 | 42 |
import Ganeti.HTools.IAlloc |
| 44 | 43 |
import Ganeti.HTools.Types |
| 45 | 44 |
import Ganeti.HTools.Loader (RqType(..), Request(..)) |
| 46 |
import Ganeti.HTools.Utils |
|
| 47 | 45 |
|
| 48 | 46 |
-- | Command line options structure. |
| 49 | 47 |
data Options = Options |
| ... | ... | |
| 74 | 72 |
] |
| 75 | 73 |
|
| 76 | 74 |
|
| 77 |
filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])] |
|
| 75 |
filterFails :: (Monad m) => [(OpResult Node.List, |
|
| 76 |
Instance.Instance, [Node.Node])] |
|
| 78 | 77 |
-> m [(Node.List, [Node.Node])] |
| 79 | 78 |
filterFails sols = |
| 80 | 79 |
if null sols then fail "No nodes onto which to allocate at all" |
| 81 |
else let sols' = filter (isJust . fst3) sols |
|
| 82 |
in if null sols' then |
|
| 83 |
fail "No valid allocation solutions" |
|
| 84 |
else |
|
| 85 |
return $ map (\(x, _, y) -> (fromJust x, y)) sols' |
|
| 80 |
else let sols' = concat . map (\ (onl, _, nn) -> |
|
| 81 |
case onl of |
|
| 82 |
OpFail _ -> [] |
|
| 83 |
OpGood gnl -> [(gnl, nn)] |
|
| 84 |
) $ sols |
|
| 85 |
in |
|
| 86 |
if null sols' then |
|
| 87 |
fail "No valid allocation solutions" |
|
| 88 |
else |
|
| 89 |
return sols' |
|
| 86 | 90 |
|
| 87 | 91 |
processResults :: (Monad m) => [(Node.List, [Node.Node])] |
| 88 | 92 |
-> m (String, [Node.Node]) |
| ... | ... | |
| 98 | 102 |
in return (info, w) |
| 99 | 103 |
|
| 100 | 104 |
-- | Process a request and return new node lists |
| 101 |
processRequest :: |
|
| 102 |
Request |
|
| 103 |
-> Result [(Maybe Node.List, Instance.Instance, [Node.Node])] |
|
| 105 |
processRequest :: Request |
|
| 106 |
-> Result [(OpResult Node.List, Instance.Instance, [Node.Node])] |
|
| 104 | 107 |
processRequest request = |
| 105 | 108 |
let Request rqtype nl il _ = request |
| 106 | 109 |
in case rqtype of |
Also available in: Unified diff