Revision f828f4aa htools/Ganeti/HTools/Cluster.hs
| b/htools/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 74 | 74 |
) where |
| 75 | 75 |
|
| 76 | 76 |
import qualified Data.IntSet as IntSet |
| 77 |
import Data.Function (on) |
|
| 77 | 78 |
import Data.List |
| 78 | 79 |
import Data.Maybe (fromJust, isNothing) |
| 79 | 80 |
import Data.Ord (comparing) |
| ... | ... | |
| 627 | 628 |
-- elements of the tuple |
| 628 | 629 |
in nsols `seq` nsuc `seq` as { asAllocs = nsuc, asSolution = nsols }
|
| 629 | 630 |
|
| 631 |
-- | Sums two 'AllocSolution' structures. |
|
| 632 |
sumAllocs :: AllocSolution -> AllocSolution -> AllocSolution |
|
| 633 |
sumAllocs (AllocSolution aFails aAllocs aSols aLog) |
|
| 634 |
(AllocSolution bFails bAllocs bSols bLog) = |
|
| 635 |
-- note: we add b first, since usually it will be smaller; when |
|
| 636 |
-- fold'ing, a will grow and grow whereas b is the per-group |
|
| 637 |
-- result, hence smaller |
|
| 638 |
let nFails = bFails ++ aFails |
|
| 639 |
nAllocs = aAllocs + bAllocs |
|
| 640 |
nSols = bestAllocElement aSols bSols |
|
| 641 |
nLog = bLog ++ aLog |
|
| 642 |
in AllocSolution nFails nAllocs nSols nLog |
|
| 643 |
|
|
| 630 | 644 |
-- | Given a solution, generates a reasonable description for it. |
| 631 | 645 |
describeSolution :: AllocSolution -> String |
| 632 | 646 |
describeSolution as = |
| ... | ... | |
| 684 | 698 |
-> AllocNodes -- ^ The allocation targets |
| 685 | 699 |
-> m AllocSolution -- ^ Possible solution list |
| 686 | 700 |
tryAlloc nl _ inst (Right ok_pairs) = |
| 687 |
let sols = foldl' (\cstate (p, s) -> |
|
| 688 |
concatAllocs cstate $ allocateOnPair nl inst p s |
|
| 689 |
) emptyAllocSolution ok_pairs |
|
| 690 |
|
|
| 701 |
let pgroups = groupBy ((==) `on` fst) ok_pairs |
|
| 702 |
psols = parMap rwhnf (foldl' (\cstate (p, s) -> |
|
| 703 |
concatAllocs cstate $ |
|
| 704 |
allocateOnPair nl inst p s) |
|
| 705 |
emptyAllocSolution) pgroups |
|
| 706 |
sols = foldl' sumAllocs emptyAllocSolution psols |
|
| 691 | 707 |
in if null ok_pairs -- means we have just one node |
| 692 | 708 |
then fail "Not enough online nodes" |
| 693 | 709 |
else return $ annotateSolution sols |
Also available in: Unified diff