To avoid danger of passing arguments in the wrong order (which the type checker cannot catch, as they are all Bool), pass the algorithmic options to tryBalance as AlgOptions rather than positional arguments.
Signed-off-by: Klaus Aehlig <[email protected]> --- src/Ganeti/HTools/Cluster.hs | 25 +++++++++++++------------ src/Ganeti/HTools/Program/Hbal.hs | 31 ++++++++++--------------------- src/Ganeti/HTools/Program/Hcheck.hs | 8 ++------ src/Ganeti/HTools/Program/Hsqueeze.hs | 6 ++++-- test/hs/Test/Ganeti/HTools/Cluster.hs | 7 ++++++- 5 files changed, 35 insertions(+), 42 deletions(-) diff --git a/src/Ganeti/HTools/Cluster.hs b/src/Ganeti/HTools/Cluster.hs index 79e2085..84cf49f 100644 --- a/src/Ganeti/HTools/Cluster.hs +++ b/src/Ganeti/HTools/Cluster.hs @@ -89,6 +89,7 @@ import Data.Ord (comparing) import Text.Printf (printf) import Ganeti.BasicTypes +import Ganeti.HTools.AlgorithmParams (AlgorithmOptions(..)) import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.Nic as Nic @@ -727,18 +728,18 @@ doNextBalance ini_tbl max_rounds min_score = in (max_rounds < 0 || ini_plc_len < max_rounds) && ini_cv > min_score -- | Run a balance move. -tryBalance :: Bool -- ^ Ignore soft errors - -> Table -- ^ The starting table - -> Bool -- ^ Allow disk moves - -> Bool -- ^ Allow instance moves - -> Bool -- ^ Only evacuate moves - -> Bool -- ^ Restrict migration - -> Score -- ^ Min gain threshold - -> Score -- ^ Min gain - -> Maybe Table -- ^ The resulting table and commands -tryBalance force ini_tbl disk_moves inst_moves evac_mode rest_mig mg_limit - min_gain = - let Table ini_nl ini_il ini_cv _ = ini_tbl +tryBalance :: AlgorithmOptions -- ^ Algorithmic options for balancing + -> Table -- ^ The starting table + -> Maybe Table -- ^ The resulting table and commands +tryBalance opts ini_tbl = + let force = algIgnoreSoftErrors opts + disk_moves = algDiskMoves opts + inst_moves = algInstanceMoves opts + evac_mode = algEvacMode opts + rest_mig = algRestrictedMigration opts + mg_limit = algMinGainLimit opts + min_gain = algMinGain opts + Table ini_nl ini_il ini_cv _ = ini_tbl all_inst = Container.elems ini_il all_nodes = Container.elems ini_nl (offline_nodes, online_nodes) = partition Node.offline all_nodes diff --git a/src/Ganeti/HTools/Program/Hbal.hs b/src/Ganeti/HTools/Program/Hbal.hs index 3780525..f3c40a7 100644 --- a/src/Ganeti/HTools/Program/Hbal.hs +++ b/src/Ganeti/HTools/Program/Hbal.hs @@ -43,6 +43,7 @@ import System.Posix.Signals import Text.Printf (printf) +import Ganeti.HTools.AlgorithmParams (AlgorithmOptions(..), fromCLIOptions) import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Cluster as Cluster import qualified Ganeti.HTools.Group as Group @@ -120,29 +121,22 @@ annotateOpCode = we find a valid solution or we exceed the maximum depth. -} -iterateDepth :: Bool -- ^ ignore soft errors - -> Bool -- ^ Whether to print moves +iterateDepth :: Bool -- ^ Whether to print moves + -> AlgorithmOptions -- ^ Algorithmic options to apply -> Cluster.Table -- ^ The starting table -> Int -- ^ Remaining length - -> Bool -- ^ Allow disk moves - -> Bool -- ^ Allow instance moves - -> Bool -- ^ Resrict migration -> Int -- ^ Max node name len -> Int -- ^ Max instance name len -> [MoveJob] -- ^ Current command list -> Score -- ^ Score at which to stop - -> Score -- ^ Min gain limit - -> Score -- ^ Min score gain - -> Bool -- ^ Enable evacuation mode -> IO (Cluster.Table, [MoveJob]) -- ^ The resulting table -- and commands -iterateDepth force printmove ini_tbl max_rounds disk_moves inst_moves rest_mig - nmlen imlen cmd_strs min_score mg_limit min_gain evac_mode = +iterateDepth printmove algOpts ini_tbl max_rounds nmlen imlen cmd_strs + min_score = let Cluster.Table ini_nl ini_il _ _ = ini_tbl allowed_next = Cluster.doNextBalance ini_tbl max_rounds min_score m_fin_tbl = if allowed_next - then Cluster.tryBalance force ini_tbl disk_moves - inst_moves evac_mode rest_mig mg_limit min_gain + then Cluster.tryBalance algOpts ini_tbl else Nothing in case m_fin_tbl of Just fin_tbl -> @@ -158,9 +152,8 @@ iterateDepth force printmove ini_tbl max_rounds disk_moves inst_moves rest_mig when printmove $ do putStrLn sol_line hFlush stdout - iterateDepth force printmove fin_tbl max_rounds disk_moves inst_moves - rest_mig nmlen imlen upd_cmd_strs min_score - mg_limit min_gain evac_mode + iterateDepth printmove algOpts fin_tbl max_rounds + nmlen imlen upd_cmd_strs min_score Nothing -> return (ini_tbl, cmd_strs) -- | Displays the cluster stats. @@ -395,13 +388,9 @@ main opts args = do let imlen = maximum . map (length . Instance.alias) $ Container.elems il nmlen = maximum . map (length . Node.alias) $ Container.elems nl - (fin_tbl, cmd_strs) <- iterateDepth force True ini_tbl (optMaxLength opts) - (optDiskMoves opts) - (optInstMoves opts) - (optRestrictedMigrate opts) + (fin_tbl, cmd_strs) <- iterateDepth True (fromCLIOptions opts) ini_tbl + (optMaxLength opts) nmlen imlen [] min_cv - (optMinGainLim opts) (optMinGain opts) - (optEvacMode opts) let (Cluster.Table fin_nl fin_il fin_cv fin_plc) = fin_tbl ord_plc = reverse fin_plc sol_msg = case () of diff --git a/src/Ganeti/HTools/Program/Hcheck.hs b/src/Ganeti/HTools/Program/Hcheck.hs index 7f81a3b..5c6152b 100644 --- a/src/Ganeti/HTools/Program/Hcheck.hs +++ b/src/Ganeti/HTools/Program/Hcheck.hs @@ -34,6 +34,7 @@ import Data.List (transpose) import System.Exit import Text.Printf (printf) +import Ganeti.HTools.AlgorithmParams (fromCLIOptions) import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Cluster as Cluster import qualified Ganeti.HTools.Group as Group @@ -258,14 +259,9 @@ executeSimulation opts ini_tbl min_cv gidx nl il = do let imlen = maximum . map (length . Instance.alias) $ Container.elems il nmlen = maximum . map (length . Node.alias) $ Container.elems nl - (fin_tbl, _) <- Hbal.iterateDepth (optIgnoreSoftErrors opts) False ini_tbl + (fin_tbl, _) <- Hbal.iterateDepth False (fromCLIOptions opts) ini_tbl (optMaxLength opts) - (optDiskMoves opts) - (optInstMoves opts) - False nmlen imlen [] min_cv - (optMinGainLim opts) (optMinGain opts) - (optEvacMode opts) let (Cluster.Table fin_nl fin_il _ _) = fin_tbl return (gidx, (fin_nl, fin_il)) diff --git a/src/Ganeti/HTools/Program/Hsqueeze.hs b/src/Ganeti/HTools/Program/Hsqueeze.hs index b518195..589e56e 100644 --- a/src/Ganeti/HTools/Program/Hsqueeze.hs +++ b/src/Ganeti/HTools/Program/Hsqueeze.hs @@ -39,6 +39,7 @@ import Text.Printf (printf) import Ganeti.BasicTypes import Ganeti.Common +import qualified Ganeti.HTools.AlgorithmParams as Alg import Ganeti.HTools.CLI import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Cluster as Cluster @@ -110,8 +111,9 @@ balance :: (Node.List, Instance.List) balance (nl, il) = let ini_cv = Cluster.compCV nl ini_tbl = Cluster.Table nl il ini_cv [] - balanceStep tbl = Cluster.tryBalance False tbl True True False False - 0.0 0.0 + balanceStep = Cluster.tryBalance + (Alg.defaultOptions { Alg.algMinGain = 0.0 + , Alg.algMinGainLimit = 0.0}) bTables = map fromJust . takeWhile isJust $ iterate (>>= balanceStep) (Just ini_tbl) (Cluster.Table nl' il' _ _) = last bTables diff --git a/test/hs/Test/Ganeti/HTools/Cluster.hs b/test/hs/Test/Ganeti/HTools/Cluster.hs index 8d0f55a..7ee9eaa 100644 --- a/test/hs/Test/Ganeti/HTools/Cluster.hs +++ b/test/hs/Test/Ganeti/HTools/Cluster.hs @@ -41,6 +41,7 @@ import Test.Ganeti.HTools.Instance ( genInstanceSmallerThanNode import Test.Ganeti.HTools.Node (genOnlineNode, genNode) import Ganeti.BasicTypes +import qualified Ganeti.HTools.AlgorithmParams as Alg import qualified Ganeti.HTools.Backend.IAlloc as IAlloc import qualified Ganeti.HTools.Cluster as Cluster import qualified Ganeti.HTools.Container as Container @@ -70,7 +71,11 @@ isNodeBig size node = Node.availDisk node > size * Types.unitDsk canBalance :: Cluster.Table -> Bool -> Bool -> Bool -> Bool canBalance tbl@(Cluster.Table _ _ ini_cv _) dm im evac = maybe False (\(Cluster.Table _ _ fin_cv _) -> ini_cv - fin_cv > 1e-12) - $ Cluster.tryBalance tbl dm im evac False 0 0 + $ Cluster.tryBalance (Alg.defaultOptions { Alg.algMinGain = 0.0 + , Alg.algMinGainLimit = 0.0 + , Alg.algDiskMoves = dm + , Alg.algInstanceMoves = im + , Alg.algEvacMode = evac}) tbl -- | Assigns a new fresh instance to a cluster; this is not -- allocation, so no resource checks are done. -- 2.0.0.526.g5318336
