From 01e524934eae5ae964c51a19ff2a1a1011f5e51a Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Sun, 7 Oct 2012 20:46:28 +0200
Subject: [PATCH] Cleanup HTools.Types/BasicTypes imports
Before we reorganised the source tree, the 'Result' type was exported
from HTools/Types.hs. This changed during the reorg, but at that time
we didn't change the exports; instead, we kept re-exporting it from
the old module for compatibility.
In light of future changes to the Result type, let's stop this
re-export and cleanup the imports of the other modules.
One test is slightly rewritten with explicit types declaration (part
of the values already needed one, let's make it explicit).
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Michael Hanselmann <hansmi@google.com>
---
htest/Test/Ganeti/HTools/CLI.hs | 5 ++-
htest/Test/Ganeti/HTools/Cluster.hs | 57 +++++++++++++-------------
htest/Test/Ganeti/HTools/Instance.hs | 23 +++++------
htest/Test/Ganeti/HTools/Loader.hs | 5 +--
htest/Test/Ganeti/HTools/Simu.hs | 7 ++--
htest/Test/Ganeti/HTools/Text.hs | 35 ++++++++--------
htest/Test/Ganeti/HTools/Types.hs | 17 ++++----
htest/Test/Ganeti/Utils.hs | 26 ++++++------
htools/Ganeti/HTools/Cluster.hs | 1 +
htools/Ganeti/HTools/ExtLoader.hs | 1 +
htools/Ganeti/HTools/IAlloc.hs | 1 +
htools/Ganeti/HTools/Instance.hs | 17 ++++----
htools/Ganeti/HTools/Luxi.hs | 1 +
htools/Ganeti/HTools/Program/Hbal.hs | 1 +
htools/Ganeti/HTools/Program/Hscan.hs | 2 +-
htools/Ganeti/HTools/Program/Hspace.hs | 1 +
htools/Ganeti/HTools/Rapi.hs | 1 +
htools/Ganeti/HTools/Simu.hs | 1 +
htools/Ganeti/HTools/Text.hs | 1 +
htools/Ganeti/HTools/Types.hs | 5 ---
20 files changed, 109 insertions(+), 99 deletions(-)
diff --git a/htest/Test/Ganeti/HTools/CLI.hs b/htest/Test/Ganeti/HTools/CLI.hs
index bfcd4517f..39e93da9a 100644
--- a/htest/Test/Ganeti/HTools/CLI.hs
+++ b/htest/Test/Ganeti/HTools/CLI.hs
@@ -39,6 +39,7 @@ import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.Common
+import Ganeti.BasicTypes
import Ganeti.HTools.CLI as CLI
import qualified Ganeti.HTools.Program as Program
import qualified Ganeti.HTools.Types as Types
@@ -49,7 +50,7 @@ import qualified Ganeti.HTools.Types as Types
prop_parseISpec :: String -> Int -> Int -> Int -> Property
prop_parseISpec descr dsk mem cpu =
let str = printf "%d,%d,%d" dsk mem cpu::String
- in parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk)
+ in parseISpecString descr str ==? Ok (Types.RSpec cpu mem dsk)
-- | Test parsing failure due to wrong section count.
prop_parseISpecFail :: String -> Property
@@ -58,7 +59,7 @@ prop_parseISpecFail descr =
forAll (replicateM nelems arbitrary) $ \values ->
let str = intercalate "," $ map show (values::[Int])
in case parseISpecString descr str of
- Types.Ok v -> failTest $ "Expected failure, got " ++ show v
+ Ok v -> failTest $ "Expected failure, got " ++ show v
_ -> passTest
-- | Test a few string arguments.
diff --git a/htest/Test/Ganeti/HTools/Cluster.hs b/htest/Test/Ganeti/HTools/Cluster.hs
index 0fc892f18..75f998002 100644
--- a/htest/Test/Ganeti/HTools/Cluster.hs
+++ b/htest/Test/Ganeti/HTools/Cluster.hs
@@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.HTools.Cluster (testHTools_Cluster) where
-import Test.QuickCheck
+import Test.QuickCheck hiding (Result)
import qualified Data.IntMap as IntMap
import Data.Maybe
@@ -40,6 +40,7 @@ import Test.Ganeti.HTools.Instance ( genInstanceSmallerThanNode
, genInstanceSmallerThan )
import Test.Ganeti.HTools.Node (genOnlineNode, genNode)
+import Ganeti.BasicTypes
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Group as Group
@@ -135,8 +136,8 @@ prop_Alloc_sane inst =
reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
Cluster.tryAlloc nl il inst' of
- Types.Bad msg -> failTest msg
- Types.Ok as ->
+ Bad msg -> failTest msg
+ Ok as ->
case Cluster.asSolution as of
Nothing -> failTest "Failed to allocate, empty solution"
Just (xnl, xi, _, cv) ->
@@ -159,8 +160,8 @@ prop_IterateAlloc_sane inst =
allocnodes = Cluster.genAllocNodes defGroupList nl reqnodes True
in case allocnodes >>= \allocnodes' ->
Cluster.iterateAlloc nl il (Just limit) inst' allocnodes' [] [] of
- Types.Bad msg -> failTest msg
- Types.Ok (_, xnl, xil, _, _) ->
+ Bad msg -> failTest msg
+ Ok (_, xnl, xil, _, _) ->
let old_score = Cluster.compCV xnl
tbl = Cluster.Table xnl xil old_score []
in case Cluster.tryBalance tbl True True False 0 1e-4 of
@@ -200,8 +201,8 @@ prop_CanTieredAlloc =
allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
in case allocnodes >>= \allocnodes' ->
Cluster.tieredAlloc nl il (Just 5) inst allocnodes' [] [] of
- Types.Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg
- Types.Ok (_, nl', il', ixes, cstats) ->
+ Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg
+ Ok (_, nl', il', ixes, cstats) ->
let (ai_alloc, ai_pool, ai_unav) =
Cluster.computeAllocationDelta
(Cluster.totalResources nl)
@@ -221,19 +222,19 @@ prop_CanTieredAlloc =
-- | Helper function to create a cluster with the given range of nodes
-- and allocate an instance on it.
genClusterAlloc :: Int -> Node.Node -> Instance.Instance
- -> Types.Result (Node.List, Instance.List, Instance.Instance)
+ -> Result (Node.List, Instance.List, Instance.Instance)
genClusterAlloc count node inst =
let nl = makeSmallCluster node count
reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
Cluster.tryAlloc nl Container.empty inst of
- Types.Bad _ -> Types.Bad "Can't allocate"
- Types.Ok as ->
+ Bad msg -> Bad $ "Can't allocate: " ++ msg
+ Ok as ->
case Cluster.asSolution as of
- Nothing -> Types.Bad "Empty solution?"
+ Nothing -> Bad "Empty solution?"
Just (xnl, xi, _, _) ->
let xil = Container.add (Instance.idx xi) xi Container.empty
- in Types.Ok (xnl, xil, xi)
+ in Ok (xnl, xil, xi)
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
-- we can also relocate it.
@@ -243,25 +244,25 @@ prop_AllocRelocate =
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
- Types.Bad msg -> failTest msg
- Types.Ok (nl, il, inst') ->
+ Bad msg -> failTest msg
+ Ok (nl, il, inst') ->
case IAlloc.processRelocate defGroupList nl il
(Instance.idx inst) 1
[(if Instance.diskTemplate inst' == Types.DTDrbd8
then Instance.sNode
else Instance.pNode) inst'] of
- Types.Ok _ -> passTest
- Types.Bad msg -> failTest $ "Failed to relocate: " ++ msg
+ Ok _ -> passTest
+ Bad msg -> failTest $ "Failed to relocate: " ++ msg
-- | Helper property checker for the result of a nodeEvac or
-- changeGroup operation.
check_EvacMode :: Group.Group -> Instance.Instance
- -> Types.Result (Node.List, Instance.List, Cluster.EvacSolution)
+ -> Result (Node.List, Instance.List, Cluster.EvacSolution)
-> Property
check_EvacMode grp inst result =
case result of
- Types.Bad msg -> failTest $ "Couldn't evacuate/change group:" ++ msg
- Types.Ok (_, _, es) ->
+ Bad msg -> failTest $ "Couldn't evacuate/change group:" ++ msg
+ Ok (_, _, es) ->
let moved = Cluster.esMoved es
failed = Cluster.esFailed es
opcodes = not . null $ Cluster.esOpCodes es
@@ -285,8 +286,8 @@ prop_AllocEvacuate =
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
- Types.Bad msg -> failTest msg
- Types.Ok (nl, il, inst') ->
+ Bad msg -> failTest msg
+ Ok (nl, il, inst') ->
conjoin . map (\mode -> check_EvacMode defGroup inst' $
Cluster.tryNodeEvac defGroupList nl il mode
[Instance.idx inst']) .
@@ -302,8 +303,8 @@ prop_AllocChangeGroup =
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
- Types.Bad msg -> failTest msg
- Types.Ok (nl, il, inst') ->
+ Bad msg -> failTest msg
+ Ok (nl, il, inst') ->
-- we need to add a second node group and nodes to the cluster
let nl2 = Container.elems $ makeSmallCluster node count
grp2 = Group.setIdx defGroup (Group.idx defGroup + 1)
@@ -330,9 +331,9 @@ prop_AllocBalance =
i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
in case allocnodes >>= \allocnodes' ->
Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of
- Types.Bad msg -> failTest $ "Failed to allocate: " ++ msg
- Types.Ok (_, _, _, [], _) -> failTest "Failed to allocate: no instances"
- Types.Ok (_, xnl, il', _, _) ->
+ Bad msg -> failTest $ "Failed to allocate: " ++ msg
+ Ok (_, _, _, [], _) -> failTest "Failed to allocate: no instances"
+ Ok (_, xnl, il', _, _) ->
let ynl = Container.add (Node.idx hnode) hnode xnl
cv = Cluster.compCV ynl
tbl = Cluster.Table ynl il' cv []
@@ -373,8 +374,8 @@ canAllocOn :: Node.List -> Int -> Instance.Instance -> Maybe String
canAllocOn nl reqnodes inst =
case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
Cluster.tryAlloc nl Container.empty inst of
- Types.Bad msg -> Just $ "Can't allocate: " ++ msg
- Types.Ok as ->
+ Bad msg -> Just $ "Can't allocate: " ++ msg
+ Ok as ->
case Cluster.asSolution as of
Nothing -> Just $ "No allocation solution; failures: " ++
show (Cluster.collapseFailures $ Cluster.asFailures as)
diff --git a/htest/Test/Ganeti/HTools/Instance.hs b/htest/Test/Ganeti/HTools/Instance.hs
index 6da4510f6..a83dd4be3 100644
--- a/htest/Test/Ganeti/HTools/Instance.hs
+++ b/htest/Test/Ganeti/HTools/Instance.hs
@@ -33,12 +33,13 @@ module Test.Ganeti.HTools.Instance
, Instance.Instance(..)
) where
-import Test.QuickCheck
+import Test.QuickCheck hiding (Result)
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.HTools.Types ()
+import Ganeti.BasicTypes
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Types as Types
@@ -110,42 +111,40 @@ prop_shrinkMG :: Instance.Instance -> Property
prop_shrinkMG inst =
Instance.mem inst >= 2 * Types.unitMem ==>
case Instance.shrinkByType inst Types.FailMem of
- Types.Ok inst' -> Instance.mem inst' == Instance.mem inst - Types.unitMem
- _ -> False
+ Ok inst' -> Instance.mem inst' ==? Instance.mem inst - Types.unitMem
+ Bad msg -> failTest msg
prop_shrinkMF :: Instance.Instance -> Property
prop_shrinkMF inst =
forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
let inst' = inst { Instance.mem = mem}
- in Types.isBad $ Instance.shrinkByType inst' Types.FailMem
+ in isBad $ Instance.shrinkByType inst' Types.FailMem
prop_shrinkCG :: Instance.Instance -> Property
prop_shrinkCG inst =
Instance.vcpus inst >= 2 * Types.unitCpu ==>
case Instance.shrinkByType inst Types.FailCPU of
- Types.Ok inst' ->
- Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu
- _ -> False
+ Ok inst' -> Instance.vcpus inst' ==? Instance.vcpus inst - Types.unitCpu
+ Bad msg -> failTest msg
prop_shrinkCF :: Instance.Instance -> Property
prop_shrinkCF inst =
forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
let inst' = inst { Instance.vcpus = vcpus }
- in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU
+ in isBad $ Instance.shrinkByType inst' Types.FailCPU
prop_shrinkDG :: Instance.Instance -> Property
prop_shrinkDG inst =
Instance.dsk inst >= 2 * Types.unitDsk ==>
case Instance.shrinkByType inst Types.FailDisk of
- Types.Ok inst' ->
- Instance.dsk inst' == Instance.dsk inst - Types.unitDsk
- _ -> False
+ Ok inst' -> Instance.dsk inst' ==? Instance.dsk inst - Types.unitDsk
+ Bad msg -> failTest msg
prop_shrinkDF :: Instance.Instance -> Property
prop_shrinkDF inst =
forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
let inst' = inst { Instance.dsk = dsk }
- in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk
+ in isBad $ Instance.shrinkByType inst' Types.FailDisk
prop_setMovable :: Instance.Instance -> Bool -> Property
prop_setMovable inst m =
diff --git a/htest/Test/Ganeti/HTools/Loader.hs b/htest/Test/Ganeti/HTools/Loader.hs
index e02acf193..a96aff5b3 100644
--- a/htest/Test/Ganeti/HTools/Loader.hs
+++ b/htest/Test/Ganeti/HTools/Loader.hs
@@ -42,7 +42,6 @@ import qualified Ganeti.BasicTypes as BasicTypes
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Loader as Loader
import qualified Ganeti.HTools.Node as Node
-import qualified Ganeti.HTools.Types as Types
prop_lookupNode :: [(String, Int)] -> String -> String -> Property
prop_lookupNode ktn inst node =
@@ -76,8 +75,8 @@ prop_mergeData ns =
let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns
in case Loader.mergeData [] [] [] []
(Loader.emptyCluster {Loader.cdNodes = na}) of
- Types.Bad _ -> False
- Types.Ok (Loader.ClusterData _ nl il _ _) ->
+ BasicTypes.Bad _ -> False
+ BasicTypes.Ok (Loader.ClusterData _ nl il _ _) ->
let nodes = Container.elems nl
instances = Container.elems il
in (sum . map (length . Node.pList)) nodes == 0 &&
diff --git a/htest/Test/Ganeti/HTools/Simu.hs b/htest/Test/Ganeti/HTools/Simu.hs
index d113b18e4..9ea572ac4 100644
--- a/htest/Test/Ganeti/HTools/Simu.hs
+++ b/htest/Test/Ganeti/HTools/Simu.hs
@@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.HTools.Simu (testHTools_Simu) where
-import Test.QuickCheck
+import Test.QuickCheck hiding (Result)
import Control.Monad
import qualified Data.IntMap as IntMap
@@ -37,6 +37,7 @@ import Text.Printf (printf)
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
+import Ganeti.BasicTypes
import qualified Ganeti.Constants as C
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Group as Group
@@ -75,8 +76,8 @@ prop_Load =
fromIntegral m, fromIntegral d))
specs :: [(Double, Double, Double, Int, Int)]
in case Simu.parseData strspecs of
- Types.Bad msg -> failTest $ "Failed to load specs: " ++ msg
- Types.Ok (Loader.ClusterData gl nl il tags ipol) ->
+ Bad msg -> failTest $ "Failed to load specs: " ++ msg
+ Ok (Loader.ClusterData gl nl il tags ipol) ->
let nodes = map snd $ IntMap.toAscList nl
nidx = map Node.idx nodes
mdc_out = map (\n -> (Node.tMem n, Node.tDsk n, Node.tCpu n,
diff --git a/htest/Test/Ganeti/HTools/Text.hs b/htest/Test/Ganeti/HTools/Text.hs
index 63c65f9b0..1237f7ec3 100644
--- a/htest/Test/Ganeti/HTools/Text.hs
+++ b/htest/Test/Ganeti/HTools/Text.hs
@@ -40,6 +40,7 @@ import Test.Ganeti.TestHTools
import Test.Ganeti.HTools.Instance (genInstanceSmallerThanNode)
import Test.Ganeti.HTools.Node (genNode, genOnlineNode)
+import Ganeti.BasicTypes
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Group as Group
@@ -79,9 +80,9 @@ prop_Load_Instance name mem dsk vcpus status
[name, mem_s, dsk_s, vcpus_s, status_s,
sbal, pnode, pnode, tags]
in case inst of
- Types.Bad msg -> failTest $ "Failed to load instance: " ++ msg
- Types.Ok (_, i) -> printTestCase "Mismatch in some field while\
- \ loading the instance" $
+ Bad msg -> failTest $ "Failed to load instance: " ++ msg
+ Ok (_, i) -> printTestCase "Mismatch in some field while\
+ \ loading the instance" $
Instance.name i == name &&
Instance.vcpus i == vcpus &&
Instance.mem i == mem &&
@@ -91,15 +92,15 @@ prop_Load_Instance name mem dsk vcpus status
else sdx) &&
Instance.autoBalance i == autobal &&
Instance.spindleUse i == su &&
- Types.isBad fail1
+ isBad fail1
prop_Load_InstanceFail :: [(String, Int)] -> [String] -> Property
prop_Load_InstanceFail ktn fields =
length fields /= 10 && length fields /= 11 ==>
case Text.loadInst nl fields of
- Types.Ok _ -> failTest "Managed to load instance from invalid data"
- Types.Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
- "Invalid/incomplete instance data: '" `isPrefixOf` msg
+ Ok _ -> failTest "Managed to load instance from invalid data"
+ Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
+ "Invalid/incomplete instance data: '" `isPrefixOf` msg
where nl = Map.fromList ktn
prop_Load_Node :: String -> Int -> Int -> Int -> Int -> Int
@@ -153,15 +154,15 @@ prop_ISpecIdempotent :: Types.ISpec -> Property
prop_ISpecIdempotent ispec =
case Text.loadISpec "dummy" . Utils.sepSplit ',' .
Text.serializeISpec $ ispec of
- Types.Bad msg -> failTest $ "Failed to load ispec: " ++ msg
- Types.Ok ispec' -> ispec ==? ispec'
+ Bad msg -> failTest $ "Failed to load ispec: " ++ msg
+ Ok ispec' -> ispec ==? ispec'
prop_IPolicyIdempotent :: Types.IPolicy -> Property
prop_IPolicyIdempotent ipol =
case Text.loadIPolicy . Utils.sepSplit '|' $
Text.serializeIPolicy owner ipol of
- Types.Bad msg -> failTest $ "Failed to load ispec: " ++ msg
- Types.Ok res -> (owner, ipol) ==? res
+ Bad msg -> failTest $ "Failed to load ispec: " ++ msg
+ Ok res -> (owner, ipol) ==? res
where owner = "dummy"
-- | This property, while being in the text tests, does more than just
@@ -183,16 +184,16 @@ prop_CreateSerialise =
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= \allocn ->
Cluster.iterateAlloc nl Container.empty (Just maxiter) inst allocn [] []
of
- Types.Bad msg -> failTest $ "Failed to allocate: " ++ msg
- Types.Ok (_, _, _, [], _) -> printTestCase
- "Failed to allocate: no allocations" False
- Types.Ok (_, nl', il', _, _) ->
+ Bad msg -> failTest $ "Failed to allocate: " ++ msg
+ Ok (_, _, _, [], _) -> printTestCase
+ "Failed to allocate: no allocations" False
+ Ok (_, nl', il', _, _) ->
let cdata = Loader.ClusterData defGroupList nl' il' ctags
Types.defIPolicy
saved = Text.serializeCluster cdata
in case Text.parseData saved >>= Loader.mergeData [] [] [] [] of
- Types.Bad msg -> failTest $ "Failed to load/merge: " ++ msg
- Types.Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) ->
+ Bad msg -> failTest $ "Failed to load/merge: " ++ msg
+ Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) ->
ctags ==? ctags2 .&&.
Types.defIPolicy ==? cpol2 .&&.
il' ==? il2 .&&.
diff --git a/htest/Test/Ganeti/HTools/Types.hs b/htest/Test/Ganeti/HTools/Types.hs
index aebcc4ceb..5e124d5dd 100644
--- a/htest/Test/Ganeti/HTools/Types.hs
+++ b/htest/Test/Ganeti/HTools/Types.hs
@@ -38,7 +38,7 @@ module Test.Ganeti.HTools.Types
, nullIPolicy
) where
-import Test.QuickCheck
+import Test.QuickCheck hiding (Result)
import Control.Applicative
@@ -46,6 +46,7 @@ import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.TestHTools
+import Ganeti.BasicTypes
import qualified Ganeti.HTools.Types as Types
-- * Helpers
@@ -140,20 +141,20 @@ prop_EvacMode_serialisation = testSerialisation
prop_opToResult :: Types.OpResult Int -> Bool
prop_opToResult op =
case op of
- Types.OpFail _ -> Types.isBad r
+ Types.OpFail _ -> isBad r
Types.OpGood v -> case r of
- Types.Bad _ -> False
- Types.Ok v' -> v == v'
+ Bad _ -> False
+ Ok v' -> v == v'
where r = Types.opToResult op
prop_eitherToResult :: Either String Int -> Bool
prop_eitherToResult ei =
case ei of
- Left _ -> Types.isBad r
+ Left _ -> isBad r
Right v -> case r of
- Types.Bad _ -> False
- Types.Ok v' -> v == v'
- where r = Types.eitherToResult ei
+ Bad _ -> False
+ Ok v' -> v == v'
+ where r = eitherToResult ei
testSuite "HTools/Types"
[ 'prop_AllocPolicy_serialisation
diff --git a/htest/Test/Ganeti/Utils.hs b/htest/Test/Ganeti/Utils.hs
index 35d7a5575..5aae3acbb 100644
--- a/htest/Test/Ganeti/Utils.hs
+++ b/htest/Test/Ganeti/Utils.hs
@@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.Utils (testUtils) where
-import Test.QuickCheck
+import Test.QuickCheck hiding (Result)
import Test.HUnit
import Data.List
@@ -37,8 +37,8 @@ import qualified Text.JSON as J
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
+import Ganeti.BasicTypes
import qualified Ganeti.JSON as JSON
-import qualified Ganeti.HTools.Types as Types
import Ganeti.Utils
-- | Helper to generate a small string that doesn't contain commas.
@@ -107,16 +107,18 @@ prop_select_undefv lst1 (NonEmpty lst2) =
prop_parseUnit :: NonNegative Int -> Property
prop_parseUnit (NonNegative n) =
- parseUnit (show n) ==? Types.Ok n .&&.
- parseUnit (show n ++ "m") ==? Types.Ok n .&&.
- parseUnit (show n ++ "M") ==? Types.Ok (truncate n_mb::Int) .&&.
- parseUnit (show n ++ "g") ==? Types.Ok (n*1024) .&&.
- parseUnit (show n ++ "G") ==? Types.Ok (truncate n_gb::Int) .&&.
- parseUnit (show n ++ "t") ==? Types.Ok (n*1048576) .&&.
- parseUnit (show n ++ "T") ==? Types.Ok (truncate n_tb::Int) .&&.
- printTestCase "Internal error/overflow?"
- (n_mb >=0 && n_gb >= 0 && n_tb >= 0) .&&.
- property (Types.isBad (parseUnit (show n ++ "x")::Types.Result Int))
+ conjoin
+ [ parseUnit (show n) ==? (Ok n::Result Int)
+ , parseUnit (show n ++ "m") ==? (Ok n::Result Int)
+ , parseUnit (show n ++ "M") ==? (Ok (truncate n_mb)::Result Int)
+ , parseUnit (show n ++ "g") ==? (Ok (n*1024)::Result Int)
+ , parseUnit (show n ++ "G") ==? (Ok (truncate n_gb)::Result Int)
+ , parseUnit (show n ++ "t") ==? (Ok (n*1048576)::Result Int)
+ , parseUnit (show n ++ "T") ==? (Ok (truncate n_tb)::Result Int)
+ , printTestCase "Internal error/overflow?"
+ (n_mb >=0 && n_gb >= 0 && n_tb >= 0)
+ , property (isBad (parseUnit (show n ++ "x")::Result Int))
+ ]
where n_mb = (fromIntegral n::Rational) * 1000 * 1000 / 1024 / 1024
n_gb = n_mb * 1000
n_tb = n_gb * 1000
diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs
index b36b5ded7..3542669bc 100644
--- a/htools/Ganeti/HTools/Cluster.hs
+++ b/htools/Ganeti/HTools/Cluster.hs
@@ -81,6 +81,7 @@ import Data.Maybe (fromJust, isNothing)
import Data.Ord (comparing)
import Text.Printf (printf)
+import Ganeti.BasicTypes
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
diff --git a/htools/Ganeti/HTools/ExtLoader.hs b/htools/Ganeti/HTools/ExtLoader.hs
index 2ecd10014..534ca7eb2 100644
--- a/htools/Ganeti/HTools/ExtLoader.hs
+++ b/htools/Ganeti/HTools/ExtLoader.hs
@@ -49,6 +49,7 @@ import qualified Ganeti.HTools.IAlloc as IAlloc
import Ganeti.HTools.Loader (mergeData, checkData, ClusterData(..)
, commonSuffix)
+import Ganeti.BasicTypes
import Ganeti.HTools.Types
import Ganeti.HTools.CLI
import Ganeti.Utils (sepSplit, tryRead, exitIfBad, exitWhen)
diff --git a/htools/Ganeti/HTools/IAlloc.hs b/htools/Ganeti/HTools/IAlloc.hs
index e923a0328..a9acf6607 100644
--- a/htools/Ganeti/HTools/IAlloc.hs
+++ b/htools/Ganeti/HTools/IAlloc.hs
@@ -39,6 +39,7 @@ import Text.JSON (JSObject, JSValue(JSArray),
import System.Exit
import System.IO
+import Ganeti.BasicTypes
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Group as Group
diff --git a/htools/Ganeti/HTools/Instance.hs b/htools/Ganeti/HTools/Instance.hs
index 62803ff80..b78eaa6ad 100644
--- a/htools/Ganeti/HTools/Instance.hs
+++ b/htools/Ganeti/HTools/Instance.hs
@@ -57,6 +57,7 @@ module Ganeti.HTools.Instance
, mirrorType
) where
+import Ganeti.BasicTypes
import qualified Ganeti.HTools.Types as T
import qualified Ganeti.HTools.Container as Container
@@ -233,20 +234,20 @@ setMovable t m = t { movable = m }
-- | Try to shrink the instance based on the reason why we can't
-- allocate it.
-shrinkByType :: Instance -> T.FailMode -> T.Result Instance
+shrinkByType :: Instance -> T.FailMode -> Result Instance
shrinkByType inst T.FailMem = let v = mem inst - T.unitMem
in if v < T.unitMem
- then T.Bad "out of memory"
- else T.Ok inst { mem = v }
+ then Bad "out of memory"
+ else Ok inst { mem = v }
shrinkByType inst T.FailDisk = let v = dsk inst - T.unitDsk
in if v < T.unitDsk
- then T.Bad "out of disk"
- else T.Ok inst { dsk = v }
+ then Bad "out of disk"
+ else Ok inst { dsk = v }
shrinkByType inst T.FailCPU = let v = vcpus inst - T.unitCpu
in if v < T.unitCpu
- then T.Bad "out of vcpus"
- else T.Ok inst { vcpus = v }
-shrinkByType _ f = T.Bad $ "Unhandled failure mode " ++ show f
+ then Bad "out of vcpus"
+ else Ok inst { vcpus = v }
+shrinkByType _ f = Bad $ "Unhandled failure mode " ++ show f
-- | Return the spec of an instance.
specOf :: Instance -> T.RSpec
diff --git a/htools/Ganeti/HTools/Luxi.hs b/htools/Ganeti/HTools/Luxi.hs
index f7a435ae9..7716df931 100644
--- a/htools/Ganeti/HTools/Luxi.hs
+++ b/htools/Ganeti/HTools/Luxi.hs
@@ -32,6 +32,7 @@ import qualified Control.Exception as E
import Text.JSON.Types
import qualified Text.JSON
+import Ganeti.BasicTypes
import qualified Ganeti.Luxi as L
import qualified Ganeti.Query.Language as Qlang
import Ganeti.HTools.Loader
diff --git a/htools/Ganeti/HTools/Program/Hbal.hs b/htools/Ganeti/HTools/Program/Hbal.hs
index 9c68e5735..e72bf5e72 100644
--- a/htools/Ganeti/HTools/Program/Hbal.hs
+++ b/htools/Ganeti/HTools/Program/Hbal.hs
@@ -49,6 +49,7 @@ import qualified Ganeti.HTools.Group as Group
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
+import Ganeti.BasicTypes
import Ganeti.Common
import Ganeti.HTools.CLI
import Ganeti.HTools.ExtLoader
diff --git a/htools/Ganeti/HTools/Program/Hscan.hs b/htools/Ganeti/HTools/Program/Hscan.hs
index b160e5d6e..df003fe35 100644
--- a/htools/Ganeti/HTools/Program/Hscan.hs
+++ b/htools/Ganeti/HTools/Program/Hscan.hs
@@ -37,6 +37,7 @@ import System.FilePath
import Text.Printf (printf)
+import Ganeti.BasicTypes
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Node as Node
@@ -49,7 +50,6 @@ import Ganeti.HTools.Text (serializeCluster)
import Ganeti.Common
import Ganeti.HTools.CLI
-import Ganeti.HTools.Types
-- | Options list and functions.
options :: [OptType]
diff --git a/htools/Ganeti/HTools/Program/Hspace.hs b/htools/Ganeti/HTools/Program/Hspace.hs
index 33e7e94a0..6ec9ea683 100644
--- a/htools/Ganeti/HTools/Program/Hspace.hs
+++ b/htools/Ganeti/HTools/Program/Hspace.hs
@@ -44,6 +44,7 @@ import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
+import Ganeti.BasicTypes
import Ganeti.Common
import Ganeti.HTools.Types
import Ganeti.HTools.CLI
diff --git a/htools/Ganeti/HTools/Rapi.hs b/htools/Ganeti/HTools/Rapi.hs
index b7a737047..359037d4c 100644
--- a/htools/Ganeti/HTools/Rapi.hs
+++ b/htools/Ganeti/HTools/Rapi.hs
@@ -44,6 +44,7 @@ import Text.JSON.Types (JSValue(..))
import Text.Printf (printf)
import System.FilePath
+import Ganeti.BasicTypes
import Ganeti.HTools.Loader
import Ganeti.HTools.Types
import Ganeti.JSON
diff --git a/htools/Ganeti/HTools/Simu.hs b/htools/Ganeti/HTools/Simu.hs
index 2e61ed700..438a6ffa5 100644
--- a/htools/Ganeti/HTools/Simu.hs
+++ b/htools/Ganeti/HTools/Simu.hs
@@ -33,6 +33,7 @@ module Ganeti.HTools.Simu
import Control.Monad (mplus, zipWithM)
import Text.Printf (printf)
+import Ganeti.BasicTypes
import Ganeti.Utils
import Ganeti.HTools.Types
import Ganeti.HTools.Loader
diff --git a/htools/Ganeti/HTools/Text.hs b/htools/Ganeti/HTools/Text.hs
index 3731bcc1f..f978cf2a7 100644
--- a/htools/Ganeti/HTools/Text.hs
+++ b/htools/Ganeti/HTools/Text.hs
@@ -47,6 +47,7 @@ import Data.List
import Text.Printf (printf)
+import Ganeti.BasicTypes
import Ganeti.Utils
import Ganeti.HTools.Loader
import Ganeti.HTools.Types
diff --git a/htools/Ganeti/HTools/Types.hs b/htools/Ganeti/HTools/Types.hs
index fb8391054..b625cefc2 100644
--- a/htools/Ganeti/HTools/Types.hs
+++ b/htools/Ganeti/HTools/Types.hs
@@ -62,11 +62,6 @@ module Ganeti.HTools.Types
, templateMirrorType
, MoveJob
, JobSet
- , Result(..)
- , isOk
- , isBad
- , eitherToResult
- , annotateResult
, Element(..)
, FailMode(..)
, FailStats
--
GitLab