On Wed, Dec 1, 2010 at 14:47, Iustin Pop <[email protected]> wrote:
> AllocElement, a type used as a result of allocations, holds the status
> of the nodes after the allocation. In most cases, we'll compare this
> allocation result with others, to see which allocation decision makes
> the most sense. This comparison is done via the cluster score.
>
> However, if we later need to redo this computation, as part of other
> comparisons, we'd need to evaluate it again, etc. So it's easier to just
> compute the score at the place where we compute the node list in the
> initial step.
> ---
> Ganeti/HTools/Cluster.hs | 32 ++++++++++++++++----------------
> Ganeti/HTools/IAlloc.hs | 6 +++---
> Ganeti/HTools/Node.hs | 2 +-
> Ganeti/HTools/QC.hs | 7 +++----
> hail.hs | 2 +-
> 5 files changed, 24 insertions(+), 25 deletions(-)
>
> diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
> index 7172cff..c52093d 100644
> --- a/Ganeti/HTools/Cluster.hs
> +++ b/Ganeti/HTools/Cluster.hs
> @@ -387,9 +387,10 @@ allocateOnSingle :: Node.List -> Instance.Instance ->
> Node.Node
> allocateOnSingle nl inst p =
> let new_pdx = Node.idx p
> new_inst = Instance.setBoth inst new_pdx Node.noSecondary
> - new_nl = Node.addPri p inst >>= \new_p ->
> - return (Container.add new_pdx new_p nl, new_inst,
> [new_p])
> - in new_nl
> + in Node.addPri p inst >>= \new_p -> do
> + let new_nl = Container.add new_pdx new_p nl
> + new_score = compCV nl
> + return (new_nl, new_inst, [new_p], new_score)
>
> -- | Tries to allocate an instance on a given pair of nodes.
> allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node
> @@ -397,13 +398,12 @@ allocateOnPair :: Node.List -> Instance.Instance ->
> Node.Node -> Node.Node
> allocateOnPair nl inst tgt_p tgt_s =
> let new_pdx = Node.idx tgt_p
> new_sdx = Node.idx tgt_s
> - new_nl = do -- Maybe monad
> - new_p <- Node.addPri tgt_p inst
> - new_s <- Node.addSec tgt_s inst new_pdx
> - let new_inst = Instance.setBoth inst new_pdx new_sdx
> - return (Container.addTwo new_pdx new_p new_sdx new_s nl,
> new_inst,
> - [new_p, new_s])
> - in new_nl
> + in do
> + new_p <- Node.addPri tgt_p inst
> + new_s <- Node.addSec tgt_s inst new_pdx
> + let new_inst = Instance.setBoth inst new_pdx new_sdx
> + new_nl = Container.addTwo new_pdx new_p new_sdx new_s nl
> + return (new_nl, new_inst, [new_p, new_s], compCV new_nl)
>
> -- | Tries to perform an instance move and returns the best table
> -- between the original one and the new one.
> @@ -535,9 +535,8 @@ collapseFailures flst =
> concatAllocs :: AllocSolution -> OpResult Node.AllocElement ->
> AllocSolution
> concatAllocs (flst, cntok, sols) (OpFail reason) = (reason:flst, cntok,
> sols)
>
> -concatAllocs (flst, cntok, osols) (OpGood ns@(nl, _, _)) =
> - let nscore = compCV nl
> - -- Choose the old or new solution, based on the cluster score
> +concatAllocs (flst, cntok, osols) (OpGood ns@(_, _, _, nscore)) =
> + let -- Choose the old or new solution, based on the cluster score
> nsols = case osols of
> [] -> [(nscore, ns)]
> (oscore, _):[] ->
> @@ -601,7 +600,8 @@ tryReloc nl il xid 1 ex_idx =
> let em = do
> (mnl, i, _, _) <-
> applyMove nl inst (ReplaceSecondary
> x)
> - return (mnl, i, [Container.find x mnl])
> + return (mnl, i, [Container.find x mnl],
> + compCV mnl)
> in concatAllocs cstate em
> ) ([], 0, []) valid_idxes
> in return sols1
> @@ -624,7 +624,7 @@ tryEvac nl il ex_ndx =
> -- FIXME: hardcoded one node here
> (fm, cs, aes) <- tryReloc nl' il idx 1 ex_ndx
> case aes of
> - csol@(_, (nl'', _, _)):_ ->
> + csol@(_, (nl'', _, _, _)):_ ->
> return (nl'', (fm, cs, csol:rsols))
> _ -> fail $ "Can't evacuate instance " ++
> Instance.name (Container.find idx il)
> @@ -649,7 +649,7 @@ iterateAlloc nl il newinst nreq ixes =
> Ok (errs, _, sols3) ->
> case sols3 of
> [] -> Ok (collapseFailures errs, nl, il, ixes)
> - (_, (xnl, xi, _)):[] ->
> + (_, (xnl, xi, _, _)):[] ->
> iterateAlloc xnl (Container.add newidx xi il)
> newinst nreq $! (xi:ixes)
> _ -> Bad "Internal error: multiple solutions for single\
> diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs
> index d0bfec6..c60e361 100644
> --- a/Ganeti/HTools/IAlloc.hs
> +++ b/Ganeti/HTools/IAlloc.hs
> @@ -4,7 +4,7 @@
>
> {-
>
> -Copyright (C) 2009 Google Inc.
> +Copyright (C) 2009, 2010 Google Inc.
>
> This program is free software; you can redistribute it and/or modify
> it under the terms of the GNU General Public License as published by
> @@ -147,13 +147,13 @@ formatRVal :: RqType -> [Node.AllocElement] ->
> JSValue
> formatRVal _ [] = JSArray []
>
> formatRVal (Evacuate _) elems =
> - let sols = map (\(_, inst, nl) -> Instance.name inst : map Node.name
> nl)
> + let sols = map (\(_, inst, nl, _) -> Instance.name inst : map
> Node.name nl)
> elems
> jsols = map (JSArray . map (JSString . toJSString)) sols
> in JSArray jsols
>
> formatRVal _ elems =
> - let (_, _, nodes) = head elems
> + let (_, _, nodes, _) = head elems
> nodes' = map Node.name nodes
> in JSArray $ map (JSString . toJSString) nodes'
>
> diff --git a/Ganeti/HTools/Node.hs b/Ganeti/HTools/Node.hs
> index 2740d18..5fd331d 100644
> --- a/Ganeti/HTools/Node.hs
> +++ b/Ganeti/HTools/Node.hs
> @@ -139,7 +139,7 @@ type List = Container.Container Node
>
> -- | A simple name for an allocation element (here just for logistic
> -- reasons)
> -type AllocElement = (List, Instance.Instance, [Node])
> +type AllocElement = (List, Instance.Instance, [Node], T.Score)
>
> -- | Constant node index for a non-moveable instance.
> noSecondary :: T.Ndx
> diff --git a/Ganeti/HTools/QC.hs b/Ganeti/HTools/QC.hs
> index 206d86e..f411a8e 100644
> --- a/Ganeti/HTools/QC.hs
> +++ b/Ganeti/HTools/QC.hs
> @@ -676,9 +676,8 @@ prop_ClusterAlloc_sane node inst =
> Types.Ok (_, _, sols3) ->
> case sols3 of
> [] -> False
> - (_, (xnl, xi, _)):[] ->
> - let cv = Cluster.compCV xnl
> - il' = Container.add (Instance.idx xi) xi il
> + (_, (xnl, xi, _, cv)):[] ->
> + let il' = Container.add (Instance.idx xi) xi il
> tbl = Cluster.Table xnl il' cv []
> in not (canBalance tbl True False)
> _ -> False
> @@ -717,7 +716,7 @@ prop_ClusterAllocEvac node inst =
> Types.Ok (_, _, sols3) ->
> case sols3 of
> [] -> False
> - (_, (xnl, xi, _)):[] ->
> + (_, (xnl, xi, _, _)):[] ->
> let sdx = Instance.sNode xi
> il' = Container.add (Instance.idx xi) xi il
> in case Cluster.tryEvac xnl il' [sdx] of
> diff --git a/hail.hs b/hail.hs
> index d67bd68..2f00da2 100644
> --- a/hail.hs
> +++ b/hail.hs
> @@ -59,7 +59,7 @@ processResults (Evacuate _) as@(fstats, successes, sols)
> =
>
> processResults _ as@(fstats, successes, sols) =
> case sols of
> - (best, (_, _, w)):[] ->
> + (best, (_, _, w, _)):[] ->
> let tfails = length fstats
> info = printf "successes %d, failures %d,\
> \ best score: %.8f for node(s) %s"
> --
> 1.7.2.3
>
>
LGTM
