Commit 942a9a6a authored by Iustin Pop's avatar Iustin Pop
Browse files

Remove multiple uses of '.&&.' with conjoin



This is just a bit of cleanup. The (.&&.) operator is internally just:

  a .&& b = conjoin [a, b]

so let's replace 'a .&&. b .&&. c .&&. d' directly with 'conjoin [a,
b, c, d]'.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent 41eb900e
......@@ -114,10 +114,12 @@ prop_monad_laws :: Int -> Result Int
-> Fun Int (Result Int)
-> Property
prop_monad_laws a m (Fun _ k) (Fun _ h) =
printTestCase "return a >>= k == k a" ((return a >>= k) ==? k a) .&&.
printTestCase "m >>= return == m" ((m >>= return) ==? m) .&&.
printTestCase "m >>= (\\x -> k x >>= h) == (m >>= k) >>= h)"
conjoin
[ printTestCase "return a >>= k == k a" ((return a >>= k) ==? k a)
, printTestCase "m >>= return == m" ((m >>= return) ==? m)
, printTestCase "m >>= (\\x -> k x >>= h) == (m >>= k) >>= h)"
((m >>= (\x -> k x >>= h)) ==? ((m >>= k) >>= h))
]
-- | Tests the monad plus laws ( mzero >>= f = mzero, v >> mzero = mzero).
prop_monadplus_mzero :: Result Int -> Fun Int (Result Int) -> Property
......
......@@ -266,14 +266,15 @@ check_EvacMode grp inst result =
let moved = Cluster.esMoved es
failed = Cluster.esFailed es
opcodes = not . null $ Cluster.esOpCodes es
in failmsg ("'failed' not empty: " ++ show failed) (null failed) .&&.
failmsg "'opcodes' is null" opcodes .&&.
case moved of
[(idx', gdx, _)] -> failmsg "invalid instance moved" (idx == idx')
.&&.
failmsg "wrong target group"
(gdx == Group.idx grp)
v -> failmsg ("invalid solution: " ++ show v) False
in conjoin
[ failmsg ("'failed' not empty: " ++ show failed) (null failed)
, failmsg "'opcodes' is null" opcodes
, case moved of
[(idx', gdx, _)] ->
failmsg "invalid instance moved" (idx == idx') .&&.
failmsg "wrong target group" (gdx == Group.idx grp)
v -> failmsg ("invalid solution: " ++ show v) False
]
where failmsg :: String -> Bool -> Property
failmsg msg = printTestCase ("Failed to evacuate: " ++ msg)
idx = Instance.idx inst
......
......@@ -74,10 +74,12 @@ prop_findByName =
$ zip names nodes
nl' = Container.fromList nodes'
target = snd (nodes' !! fidx)
in Container.findByName nl' (Node.name target) ==? Just target .&&.
Container.findByName nl' (Node.alias target) ==? Just target .&&.
printTestCase "Found non-existing name"
(isNothing (Container.findByName nl' othername))
in conjoin
[ Container.findByName nl' (Node.name target) ==? Just target
, Container.findByName nl' (Node.alias target) ==? Just target
, printTestCase "Found non-existing name"
(isNothing (Container.findByName nl' othername))
]
testSuite "HTools/Container"
[ 'prop_addTwo
......
......@@ -82,16 +82,16 @@ prop_Load =
nidx = map Node.idx nodes
mdc_out = map (\n -> (Node.tMem n, Node.tDsk n, Node.tCpu n,
Node.fMem n, Node.fDsk n)) nodes
in
Container.size gl ==? ngroups .&&.
Container.size nl ==? totnodes .&&.
Container.size il ==? 0 .&&.
length tags ==? 0 .&&.
ipol ==? Types.defIPolicy .&&.
nidx ==? [1..totnodes] .&&.
mdc_in ==? mdc_out .&&.
map Group.iPolicy (Container.elems gl) ==?
replicate ngroups Types.defIPolicy
in conjoin [ Container.size gl ==? ngroups
, Container.size nl ==? totnodes
, Container.size il ==? 0
, length tags ==? 0
, ipol ==? Types.defIPolicy
, nidx ==? [1..totnodes]
, mdc_in ==? mdc_out
, map Group.iPolicy (Container.elems gl) ==?
replicate ngroups Types.defIPolicy
]
testSuite "HTools/Simu"
[ 'prop_Load
......
......@@ -194,11 +194,12 @@ prop_CreateSerialise =
in case Text.parseData saved >>= Loader.mergeData [] [] [] [] of
Bad msg -> failTest $ "Failed to load/merge: " ++ msg
Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) ->
ctags ==? ctags2 .&&.
Types.defIPolicy ==? cpol2 .&&.
il' ==? il2 .&&.
defGroupList ==? gl2 .&&.
nl' ==? nl2
conjoin [ ctags ==? ctags2
, Types.defIPolicy ==? cpol2
, il' ==? il2
, defGroupList ==? gl2
, nl' ==? nl2
]
testSuite "HTools/Text"
[ 'prop_Load_Instance
......
......@@ -199,12 +199,13 @@ prop_fillDict defaults custom =
d_keys = map fst defaults
c_map = Map.fromList custom
c_keys = map fst custom
in printTestCase "Empty custom filling"
(fillDict d_map Map.empty [] == d_map) .&&.
printTestCase "Empty defaults filling"
(fillDict Map.empty c_map [] == c_map) .&&.
printTestCase "Delete all keys"
(fillDict d_map c_map (d_keys++c_keys) == Map.empty)
in conjoin [ printTestCase "Empty custom filling"
(fillDict d_map Map.empty [] == d_map)
, printTestCase "Empty defaults filling"
(fillDict Map.empty c_map [] == c_map)
, printTestCase "Delete all keys"
(fillDict d_map c_map (d_keys++c_keys) == Map.empty)
]
-- | Test that the serialisation of 'DiskLogicalId', which is
-- implemented manually, is idempotent. Since we don't have a
......
......@@ -68,13 +68,15 @@ prop_queryNode_noUnknown =
run (query cluster False (Query QRNode [field] EmptyFilter)) >>= resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRNode [field])
stop $ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
(hasUnknownFields fdefs) .&&.
printTestCase ("Got unknown result status via query (" ++
show fdata ++ ")")
(all (all ((/= RSUnknown) . rentryStatus)) fdata) .&&.
printTestCase ("Got unknown fields via query fields (" ++ show fdefs'
++ ")") (hasUnknownFields fdefs')
stop $ conjoin
[ printTestCase ("Got unknown fields via query (" ++
show fdefs ++ ")") (hasUnknownFields fdefs)
, printTestCase ("Got unknown result status via query (" ++
show fdata ++ ")")
(all (all ((/= RSUnknown) . rentryStatus)) fdata)
, printTestCase ("Got unknown fields via query fields (" ++
show fdefs'++ ")") (hasUnknownFields fdefs')
]
-- | Tests that an unknown field is returned as such.
prop_queryNode_Unknown :: Property
......@@ -86,16 +88,18 @@ prop_queryNode_Unknown =
run (query cluster False (Query QRNode [field] EmptyFilter)) >>= resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRNode [field])
stop $ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
(not $ hasUnknownFields fdefs) .&&.
printTestCase ("Got /= ResultUnknown result status via query (" ++
show fdata ++ ")")
(all (all ((== RSUnknown) . rentryStatus)) fdata) .&&.
printTestCase ("Got a Just in a result value (" ++
show fdata ++ ")")
(all (all (isNothing . rentryValue)) fdata) .&&.
printTestCase ("Got known fields via query fields (" ++ show fdefs'
++ ")") (not $ hasUnknownFields fdefs')
stop $ conjoin
[ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
(not $ hasUnknownFields fdefs)
, printTestCase ("Got /= ResultUnknown result status via query (" ++
show fdata ++ ")")
(all (all ((== RSUnknown) . rentryStatus)) fdata)
, printTestCase ("Got a Just in a result value (" ++
show fdata ++ ")")
(all (all (isNothing . rentryValue)) fdata)
, printTestCase ("Got known fields via query fields (" ++ show fdefs'
++ ")") (not $ hasUnknownFields fdefs')
]
-- | Checks that a result type is conforming to a field definition.
checkResultType :: FieldDefinition -> ResultEntry -> Property
......@@ -128,14 +132,16 @@ prop_queryNode_types =
forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cfg False (Query QRNode [field] EmptyFilter)) >>= resultProp
stop $ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
(conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) .&&.
printTestCase "Wrong field definitions length"
(length fdefs ==? 1) .&&.
printTestCase "Wrong field result rows length"
(all ((== 1) . length) fdata) .&&.
printTestCase "Wrong number of result rows"
stop $ conjoin
[ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
(conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata)
, printTestCase "Wrong field definitions length"
(length fdefs ==? 1)
, printTestCase "Wrong field result rows length"
(all ((== 1) . length) fdata)
, printTestCase "Wrong number of result rows"
(length fdata ==? numnodes)
]
-- | Test that queryFields with empty fields list returns all node fields.
case_queryNode_allfields :: Assertion
......@@ -155,16 +161,19 @@ prop_queryGroup_noUnknown =
forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cluster False (Query QRGroup [field] EmptyFilter)) >>= resultProp
run (query cluster False (Query QRGroup [field] EmptyFilter)) >>=
resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRGroup [field])
stop $ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
(hasUnknownFields fdefs) .&&.
printTestCase ("Got unknown result status via query (" ++
show fdata ++ ")")
(all (all ((/= RSUnknown) . rentryStatus)) fdata) .&&.
printTestCase ("Got unknown fields via query fields (" ++ show fdefs'
++ ")") (hasUnknownFields fdefs')
stop $ conjoin
[ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
(hasUnknownFields fdefs)
, printTestCase ("Got unknown result status via query (" ++
show fdata ++ ")")
(all (all ((/= RSUnknown) . rentryStatus)) fdata)
, printTestCase ("Got unknown fields via query fields (" ++ show fdefs'
++ ")") (hasUnknownFields fdefs')
]
prop_queryGroup_Unknown :: Property
prop_queryGroup_Unknown =
......@@ -175,16 +184,18 @@ prop_queryGroup_Unknown =
run (query cluster False (Query QRGroup [field] EmptyFilter)) >>= resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRGroup [field])
stop $ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
(not $ hasUnknownFields fdefs) .&&.
printTestCase ("Got /= ResultUnknown result status via query (" ++
show fdata ++ ")")
(all (all ((== RSUnknown) . rentryStatus)) fdata) .&&.
printTestCase ("Got a Just in a result value (" ++
show fdata ++ ")")
(all (all (isNothing . rentryValue)) fdata) .&&.
printTestCase ("Got known fields via query fields (" ++ show fdefs'
++ ")") (not $ hasUnknownFields fdefs')
stop $ conjoin
[ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
(not $ hasUnknownFields fdefs)
, printTestCase ("Got /= ResultUnknown result status via query (" ++
show fdata ++ ")")
(all (all ((== RSUnknown) . rentryStatus)) fdata)
, printTestCase ("Got a Just in a result value (" ++
show fdata ++ ")")
(all (all (isNothing . rentryValue)) fdata)
, printTestCase ("Got known fields via query fields (" ++ show fdefs'
++ ")") (not $ hasUnknownFields fdefs')
]
prop_queryGroup_types :: Property
prop_queryGroup_types =
......@@ -193,12 +204,13 @@ prop_queryGroup_types =
forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cfg False (Query QRGroup [field] EmptyFilter)) >>= resultProp
stop $ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
(conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) .&&.
printTestCase "Wrong field definitions length"
(length fdefs ==? 1) .&&.
printTestCase "Wrong field result rows length"
stop $ conjoin
[ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
(conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata)
, printTestCase "Wrong field definitions length" (length fdefs ==? 1)
, printTestCase "Wrong field result rows length"
(all ((== 1) . length) fdata)
]
case_queryGroup_allfields :: Assertion
case_queryGroup_allfields = do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment