Commit 3603605a authored by Iustin Pop's avatar Iustin Pop
Browse files

Cleanup hlint errors



First, we update the recommended hlint version to what I used to get a
clean output (1.8.15). Most of the changes are:

- remove unneeded parentheses
- some simplifications (intercalate " " → unwords, maybe … id →
  fromMaybe, etc.)
- removal of some duplicate code (in previous patches)

There are still some warnings which I didn't clean out but plain
ignored:

- 'Eta reduce' in some specific files, because the type inference
  specialises the function on the first call, and annotating the type
  properly would be too verbose
- use of 'first', 'comparing', and 'on', since these don't seem to be
  widely or consistently used (outside ganeti/htools, I mean)
- use of Control.Exception.catch, as we only care about I/O errors; at
  one point yes, we will need to transition to this new API
- 'Reduce duplication', since hlint warns even for 3 duplicate lines,
  and abstracting that away seems overkill to me

After this patch, make hlint is clean and doesn't exit with an error
anymore; we could enable it automatically on 'make lint' if hlint is
detected (future patch).

Note that we explicitly skip the THH.hs file from checking because it
seems that hlint doesn't parse correctly for now the splice notation.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAgata Murawska <agatamurawska@google.com>
parent 2f9198be
......@@ -1170,7 +1170,13 @@ lint: $(BUILT_SOURCES)
.PHONY: hlint
hlint: $(HS_BUILT_SRCS)
if tty -s; then C="-c"; else C=""; fi; \
hlint --report=doc/hs-lint.html $$C htools
hlint --report=doc/hs-lint.html --cross $$C \
--ignore "Use first" \
--ignore "Use comparing" \
--ignore "Use on" \
--ignore "Use Control.Exception.catch" \
--ignore "Reduce duplication" \
$(filter-out htools/Ganeti/THH.hs,$(HS_LIB_SRCS))
# a dist hook rule for updating the vcs-version file; this is
# hardcoded due to where it needs to build the file...
......
......@@ -36,7 +36,8 @@ document, plus:
- `HsColour <http://hackage.haskell.org/package/hscolour>`_, again
used for documentation (it's source-code pretty-printing)
- `hlint <http://community.haskell.org/~ndm/hlint/>`_, a source code
linter (equivalent to pylint for Python)
linter (equivalent to pylint for Python), recommended version 1.8 or
above (tested with 1.8.15)
- the `QuickCheck <http://hackage.haskell.org/package/QuickCheck>`_
library, version 2.x
- ``hpc``, which comes with the compiler, so you should already have
......@@ -69,9 +70,9 @@ You can run the Haskell linter :command:`hlint` via::
make hlint
This is not enabled by default as it gets many false positives, and
thus the normal output is not “clean”. The above command will generate
both output on the terminal and also a HTML report at
This is not enabled by default (as the htools component is
optional). The above command will generate both output on the terminal
and, if any warnings are found, also an HTML report at
``doc/hs-lint.html``.
When writing or debugging TemplateHaskell code, it's useful to see
......
......@@ -452,13 +452,13 @@ parseOpts argv progname options =
(o, n, []) ->
do
let (pr, args) = (foldM (flip id) defaultOptions o, n)
po <- (case pr of
Bad msg -> do
hPutStrLn stderr "Error while parsing command\
\line arguments:"
hPutStrLn stderr msg
exitWith $ ExitFailure 1
Ok val -> return val)
po <- case pr of
Bad msg -> do
hPutStrLn stderr "Error while parsing command\
\line arguments:"
hPutStrLn stderr msg
exitWith $ ExitFailure 1
Ok val -> return val
when (optShowHelp po) $ do
putStr $ usageHelp progname options
exitWith ExitSuccess
......@@ -534,7 +534,7 @@ setNodeStatus opts fixed_nl = do
m_cpu = optMcpu opts
m_dsk = optMdsk opts
when (not (null offline_wrong)) $ do
unless (null offline_wrong) $ do
hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
(commaJoin (map lrContent offline_wrong)) :: IO ()
exitWith $ ExitFailure 1
......
......@@ -373,9 +373,8 @@ applyMove nl inst Failover =
let (old_pdx, old_sdx, old_p, old_s) = instanceNodes nl inst
int_p = Node.removePri old_p inst
int_s = Node.removeSec old_s inst
force_p = Node.offline old_p
new_nl = do -- Maybe monad
new_p <- Node.addPriEx force_p int_s inst
new_p <- Node.addPriEx (Node.offline old_p) int_s inst
new_s <- Node.addSec int_p inst old_sdx
let new_inst = Instance.setBoth inst old_sdx old_pdx
return (Container.addTwo old_pdx new_s old_sdx new_p nl,
......@@ -526,7 +525,8 @@ checkInstanceMove :: [Ndx] -- ^ Allowed target node indices
checkInstanceMove nodes_idx disk_moves inst_moves ini_tbl target =
let opdx = Instance.pNode target
osdx = Instance.sNode target
nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
bad_nodes = [opdx, osdx]
nodes = filter (`notElem` bad_nodes) nodes_idx
use_secondary = elem osdx nodes_idx && inst_moves
aft_failover = if use_secondary -- if allowed to failover
then checkSingleStep ini_tbl target ini_tbl Failover
......@@ -1308,7 +1308,7 @@ printNodes nl fs =
_ -> fs
snl = sortBy (comparing Node.idx) (Container.elems nl)
(header, isnum) = unzip $ map Node.showHeader fields
in unlines . map ((:) ' ' . intercalate " ") $
in unlines . map ((:) ' ' . unwords) $
formatTable (header:map (Node.list fields) snl) isnum
-- | Print the instance list.
......@@ -1335,7 +1335,7 @@ printInsts nl il =
header = [ "F", "Name", "Pri_node", "Sec_node", "Auto_bal"
, "vcpu", "mem" , "dsk", "lCpu", "lMem", "lDsk", "lNet" ]
isnum = False:False:False:False:False:repeat True
in unlines . map ((:) ' ' . intercalate " ") $
in unlines . map ((:) ' ' . unwords) $
formatTable (header:map helper sil) isnum
-- | Shows statistics for a given node list.
......
......@@ -95,16 +95,14 @@ loadExternalData opts = do
" files options should be given.")
exitWith $ ExitFailure 1
util_contents <- (case optDynuFile opts of
Just path -> readFile path
Nothing -> return "")
util_contents <- maybe (return "") readFile (optDynuFile opts)
let util_data = mapM parseUtilisation $ lines util_contents
util_data' <- (case util_data of
Ok x -> return x
Bad y -> do
hPutStrLn stderr ("Error: can't parse utilisation" ++
" data: " ++ show y)
exitWith $ ExitFailure 1)
util_data' <- case util_data of
Ok x -> return x
Bad y -> do
hPutStrLn stderr ("Error: can't parse utilisation" ++
" data: " ++ show y)
exitWith $ ExitFailure 1
input_data <-
case () of
_ | setRapi -> wrapIO $ Rapi.loadData mhost
......@@ -115,13 +113,12 @@ loadExternalData opts = do
let ldresult = input_data >>= mergeData util_data' exTags selInsts exInsts
cdata <-
(case ldresult of
Ok x -> return x
Bad s -> do
hPrintf stderr
"Error: failed to load data, aborting. Details:\n%s\n" s:: IO ()
exitWith $ ExitFailure 1
)
case ldresult of
Ok x -> return x
Bad s -> do
hPrintf stderr
"Error: failed to load data, aborting. Details:\n%s\n" s:: IO ()
exitWith $ ExitFailure 1
let (fix_msgs, nl) = checkData (cdNodes cdata) (cdInstances cdata)
unless (optVerbose opts == 0) $ maybeShowWarnings fix_msgs
......
......@@ -50,6 +50,8 @@ import Ganeti.HTools.ExtLoader (loadExternalData)
import Ganeti.HTools.Utils
import Ganeti.HTools.Types
{-# ANN module "HLint: ignore Eta reduce" #-}
-- | Type alias for the result of an IAllocator call.
type IAllocResult = (String, JSValue, Node.List, Instance.List)
......@@ -83,8 +85,9 @@ parseInstance ktn n a = do
else readEitherString $ head nodes
pidx <- lookupNode ktn n pnode
let snodes = tail nodes
sidx <- (if null snodes then return Node.noSecondary
else readEitherString (head snodes) >>= lookupNode ktn n)
sidx <- if null snodes
then return Node.noSecondary
else readEitherString (head snodes) >>= lookupNode ktn n
return (n, Instance.setBoth (snd base) pidx sidx)
-- | Parses a node as found in the cluster node list.
......@@ -101,17 +104,17 @@ parseNode ktg n a = do
vm_capable <- annotateResult desc $ maybeFromObj a "vm_capable"
let vm_capable' = fromMaybe True vm_capable
gidx <- lookupGroup ktg n guuid
node <- (if offline || drained || not vm_capable'
then return $ Node.create n 0 0 0 0 0 0 True gidx
else do
mtotal <- extract "total_memory"
mnode <- extract "reserved_memory"
mfree <- extract "free_memory"
dtotal <- extract "total_disk"
dfree <- extract "free_disk"
ctotal <- extract "total_cpus"
return $ Node.create n mtotal mnode mfree
dtotal dfree ctotal False gidx)
node <- if offline || drained || not vm_capable'
then return $ Node.create n 0 0 0 0 0 0 True gidx
else do
mtotal <- extract "total_memory"
mnode <- extract "reserved_memory"
mfree <- extract "free_memory"
dtotal <- extract "total_disk"
dfree <- extract "free_disk"
ctotal <- extract "total_cpus"
return $ Node.create n mtotal mnode mfree
dtotal dfree ctotal False gidx
return (n, node)
-- | Parses a group as found in the cluster group list.
......@@ -330,12 +333,12 @@ readRequest opts args = do
hPutStrLn stderr $ "Error: " ++ err
exitWith $ ExitFailure 1
Ok (fix_msgs, rq) -> maybeShowWarnings fix_msgs >> return rq
(if isJust (optDataFile opts) || (not . null . optNodeSim) opts
then do
cdata <- loadExternalData opts
let Request rqt _ = r1
return $ Request rqt cdata
else return r1)
if isJust (optDataFile opts) || (not . null . optNodeSim) opts
then do
cdata <- loadExternalData opts
let Request rqt _ = r1
return $ Request rqt cdata
else return r1
-- | Main iallocator pipeline.
runIAllocator :: Request -> (Maybe (Node.List, Instance.List), String)
......
......@@ -317,10 +317,9 @@ checkData nl il =
(Node.fMem node - adj_mem)
umsg1 =
if delta_mem > 512 || delta_dsk > 1024
then (printf "node %s is missing %d MB ram \
\and %d GB disk"
nname delta_mem (delta_dsk `div` 1024)):
msgs
then printf "node %s is missing %d MB ram \
\and %d GB disk"
nname delta_mem (delta_dsk `div` 1024):msgs
else msgs
in (umsg1, newn)
) [] nl
......
......@@ -41,6 +41,8 @@ import qualified Ganeti.HTools.Instance as Instance
import Ganeti.HTools.Utils (fromJVal, annotateResult, tryFromObj, asJSObject,
fromObj)
{-# ANN module "HLint: ignore Eta reduce" #-}
-- * Utility functions
-- | Get values behind \"data\" part of the result.
......@@ -148,14 +150,15 @@ parseInstance ktn [ name, disk, mem, vcpus
xname <- annotateResult "Parsing new instance" (fromJValWithStatus name)
let convert a = genericConvert "Instance" xname a
xdisk <- convert "disk_usage" disk
xmem <- (case oram of -- FIXME: remove the "guessing"
(_, JSRational _ _) -> convert "oper_ram" oram
_ -> convert "be/memory" mem)
xmem <- case oram of -- FIXME: remove the "guessing"
(_, JSRational _ _) -> convert "oper_ram" oram
_ -> convert "be/memory" mem
xvcpus <- convert "be/vcpus" vcpus
xpnode <- convert "pnode" pnode >>= lookupNode ktn xname
xsnodes <- convert "snodes" snodes::Result [JSString]
snode <- (if null xsnodes then return Node.noSecondary
else lookupNode ktn xname (fromJSString $ head xsnodes))
snode <- if null xsnodes
then return Node.noSecondary
else lookupNode ktn xname (fromJSString $ head xsnodes)
xrunning <- convert "status" status
xtags <- convert "tags" tags
xauto_balance <- convert "auto_balance" auto_balance
......@@ -181,17 +184,17 @@ parseNode ktg [ name, mtotal, mnode, mfree, dtotal, dfree
xdrained <- convert "drained" drained
xvm_capable <- convert "vm_capable" vm_capable
xgdx <- convert "group.uuid" g_uuid >>= lookupGroup ktg xname
node <- (if xoffline || xdrained || not xvm_capable
then return $ Node.create xname 0 0 0 0 0 0 True xgdx
else do
xmtotal <- convert "mtotal" mtotal
xmnode <- convert "mnode" mnode
xmfree <- convert "mfree" mfree
xdtotal <- convert "dtotal" dtotal
xdfree <- convert "dfree" dfree
xctotal <- convert "ctotal" ctotal
return $ Node.create xname xmtotal xmnode xmfree
xdtotal xdfree xctotal False xgdx)
node <- if xoffline || xdrained || not xvm_capable
then return $ Node.create xname 0 0 0 0 0 0 True xgdx
else do
xmtotal <- convert "mtotal" mtotal
xmnode <- convert "mnode" mnode
xmfree <- convert "mfree" mfree
xdtotal <- convert "dtotal" dtotal
xdfree <- convert "dfree" dfree
xctotal <- convert "ctotal" ctotal
return $ Node.create xname xmtotal xmnode xmfree
xdtotal xdfree xctotal False xgdx
return (xname, node)
parseNode _ v = fail ("Invalid node query result: " ++ show v)
......
......@@ -328,11 +328,10 @@ removePri t inst =
removeSec :: Node -> Instance.Instance -> Node
removeSec t inst =
let iname = Instance.idx inst
uses_disk = Instance.usesLocalStorage inst
cur_dsk = fDsk t
pnode = Instance.pNode inst
new_slist = delete iname (sList t)
new_dsk = if uses_disk
new_dsk = if Instance.usesLocalStorage inst
then cur_dsk + Instance.dsk inst
else cur_dsk
old_peers = peers t
......
......@@ -26,6 +26,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.HTools.Program.Hail (main) where
import Control.Monad
import Data.Maybe (fromMaybe)
import System.Environment (getArgs)
import System.IO
......@@ -74,7 +75,7 @@ main = do
maybeSaveData savecluster "pre-ialloc" "before iallocator run" cdata
let (maybe_ni, resp) = runIAllocator request
(fin_nl, fin_il) = maybe (cdNodes cdata, cdInstances cdata) id maybe_ni
(fin_nl, fin_il) = fromMaybe (cdNodes cdata, cdInstances cdata) maybe_ni
putStrLn resp
maybePrintNodes shownodes "Final cluster" (Cluster.printNodes fin_nl)
......
......@@ -143,14 +143,14 @@ saveBalanceCommands :: Options -> String -> IO ()
saveBalanceCommands opts cmd_data = do
let out_path = fromJust $ optShowCmds opts
putStrLn ""
(if out_path == "-" then
printf "Commands to run to reach the above solution:\n%s"
(unlines . map (" " ++) .
filter (/= " check") .
lines $ cmd_data)
else do
writeFile out_path (shTemplate ++ cmd_data)
printf "The commands have been written to file '%s'\n" out_path)
if out_path == "-"
then printf "Commands to run to reach the above solution:\n%s"
(unlines . map (" " ++) .
filter (/= " check") .
lines $ cmd_data)
else do
writeFile out_path (shTemplate ++ cmd_data)
printf "The commands have been written to file '%s'\n" out_path
-- | Polls a set of jobs at a fixed interval until all are finished
-- one way or another.
......@@ -176,12 +176,12 @@ execWrapper :: String -> Node.List
execWrapper _ _ _ _ [] = return True
execWrapper master nl il cref alljss = do
cancel <- readIORef cref
(if cancel > 0
then do
hPrintf stderr "Exiting early due to user request, %d\
\ jobset(s) remaining." (length alljss)::IO ()
return False
else execJobSet master nl il cref alljss)
if cancel > 0
then do
hPrintf stderr "Exiting early due to user request, %d\
\ jobset(s) remaining." (length alljss)::IO ()
return False
else execJobSet master nl il cref alljss
-- | Execute an entire jobset.
execJobSet :: String -> Node.List
......@@ -202,17 +202,17 @@ execJobSet master nl il cref (js:jss) = do
putStrLn $ "Got job IDs " ++ commaJoin x
waitForJobs client x
)
(case jrs of
Bad x -> do
hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
return False
Ok x -> if checkJobsStatus x
then execWrapper master nl il cref jss
else do
hPutStrLn stderr $ "Not all jobs completed successfully: " ++
show x
hPutStrLn stderr "Aborting."
return False)
case jrs of
Bad x -> do
hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
return False
Ok x -> if checkJobsStatus x
then execWrapper master nl il cref jss
else do
hPutStrLn stderr $ "Not all jobs completed successfully: " ++
show x
hPutStrLn stderr "Aborting."
return False
-- | Executes the jobs, if possible and desired.
maybeExecJobs :: Options
......@@ -279,7 +279,7 @@ selectGroup opts gl nlf ilf = do
exitWith $ ExitFailure 1
Just grp ->
case lookup (Group.idx grp) ngroups of
Nothing -> do
Nothing ->
-- This will only happen if there are no nodes assigned
-- to this group
return (Group.name grp, (Container.empty, Container.empty))
......@@ -375,10 +375,10 @@ main = do
checkNeedRebalance opts ini_cv
(if verbose > 2
then printf "Initial coefficients: overall %.8f, %s\n"
ini_cv (Cluster.printStats nl)::IO ()
else printf "Initial score: %.8f\n" ini_cv)
if verbose > 2
then printf "Initial coefficients: overall %.8f, %s\n"
ini_cv (Cluster.printStats nl)::IO ()
else printf "Initial score: %.8f\n" ini_cv
putStrLn "Trying to minimize the CV..."
let imlen = maximum . map (length . Instance.alias) $ Container.elems il
......
......@@ -268,7 +268,7 @@ printAllocationMap :: Int -> String
printAllocationMap verbose msg nl ixes =
when (verbose > 1) $ do
hPutStrLn stderr (msg ++ " map")
hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
hPutStr stderr . unlines . map ((:) ' ' . unwords) $
formatTable (map (printInstance nl) (reverse ixes))
-- This is the numberic-or-not field
-- specification; the first three fields are
......@@ -315,7 +315,7 @@ printTiered :: Bool -> [(RSpec, Int)] -> Double
-> Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
printTiered True spec_map m_cpu nl trl_nl _ = do
printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
printKeys [("TSPEC", intercalate " " (formatSpecMap spec_map))]
printKeys [("TSPEC", unwords (formatSpecMap spec_map))]
printAllocationStats m_cpu nl trl_nl
printTiered False spec_map _ ini_nl fin_nl sreason = do
......@@ -433,16 +433,15 @@ main = do
-- Run the tiered allocation, if enabled
(case optTieredSpec opts of
Nothing -> return ()
Just tspec -> do
(treason, trl_nl, _, spec_map) <-
case optTieredSpec opts of
Nothing -> return ()
Just tspec -> do
(treason, trl_nl, _, spec_map) <-
runAllocation cdata stop_allocation
(Cluster.tieredAlloc nl il alloclimit (iofspec tspec)
allocnodes [] []) tspec SpecTiered opts
(Cluster.tieredAlloc nl il alloclimit (iofspec tspec)
allocnodes [] []) tspec SpecTiered opts
printTiered machine_r spec_map (optMcpu opts) nl trl_nl treason
)
printTiered machine_r spec_map (optMcpu opts) nl trl_nl treason
-- Run the standard (avg-mode) allocation
......
......@@ -133,6 +133,13 @@ makeSmallCluster node count =
(_, nlst) = Loader.assignIndices namelst
in nlst
-- | Make a small cluster, both nodes and instances.
makeSmallEmptyCluster :: Node.Node -> Int -> Instance.Instance
-> (Node.List, Instance.List, Instance.Instance)
makeSmallEmptyCluster node count inst =
(makeSmallCluster node count, Container.empty,
setInstanceSmallerThanNode node inst)
-- | Checks if a node is "big" enough.
isNodeBig :: Node.Node -> Int -> Bool
isNodeBig node size = Node.availDisk node > size * Types.unitDsk
......@@ -246,19 +253,19 @@ instance Arbitrary OpCodes.OpCode where
, "OP_INSTANCE_FAILOVER"
, "OP_INSTANCE_MIGRATE"
]
(case op_id of
"OP_TEST_DELAY" ->
liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary
"OP_INSTANCE_REPLACE_DISKS" ->
liftM5 OpCodes.OpInstanceReplaceDisks arbitrary arbitrary
arbitrary arbitrary arbitrary
"OP_INSTANCE_FAILOVER" ->
liftM3 OpCodes.OpInstanceFailover arbitrary arbitrary
arbitrary
"OP_INSTANCE_MIGRATE" ->
liftM5 OpCodes.OpInstanceMigrate arbitrary arbitrary
arbitrary arbitrary arbitrary
_ -> fail "Wrong opcode")
case op_id of
"OP_TEST_DELAY" ->
liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary
"OP_INSTANCE_REPLACE_DISKS" ->
liftM5 OpCodes.OpInstanceReplaceDisks arbitrary arbitrary
arbitrary arbitrary arbitrary
"OP_INSTANCE_FAILOVER" ->
liftM3 OpCodes.OpInstanceFailover arbitrary arbitrary
arbitrary
"OP_INSTANCE_MIGRATE" ->
liftM5 OpCodes.OpInstanceMigrate arbitrary arbitrary
arbitrary arbitrary arbitrary
_ -> fail "Wrong opcode"
instance Arbitrary Jobs.OpStatus where
arbitrary = elements [minBound..maxBound]
......@@ -283,9 +290,9 @@ instance Arbitrary Types.FailMode where
instance Arbitrary a => Arbitrary (Types.OpResult a) where
arbitrary = arbitrary >>= \c ->
case c of
False -> liftM Types.OpFail arbitrary
True -> liftM Types.OpGood arbitrary
if c
then liftM Types.OpGood arbitrary
else liftM Types.OpFail arbitrary
-- * Actual tests
......@@ -295,7 +302,7 @@ instance Arbitrary a => Arbitrary (Types.OpResult a) where
-- not contain commas, then join+split should be idempotent.
prop_Utils_commaJoinSplit =
forAll (arbitrary `suchThat`
(\l -> l /= [""] && all (not . elem ',') l )) $ \lst ->
(\l -> l /= [""] && all (notElem ',') l )) $ \lst ->
Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst
-- | Split and join should always be idempotent.
......@@ -323,21 +330,19 @@ prop_Utils_select :: Int -- ^ Default result
-> [Int] -- ^ List of True values
-> Gen Prop -- ^ Test result
prop_Utils_select def lst1 lst2 =
Utils.select def cndlist ==? expectedresult
Utils.select def (flist ++ tlist) ==? expectedresult
where expectedresult = Utils.if' (null lst2) def (head lst2)
flist = map (\e -> (False, e)) lst1
tlist = map (\e -> (True, e)) lst2
cndlist = flist ++ tlist
-- | Test basic select functionality with undefined default
prop_Utils_select_undefd :: [Int] -- ^ List of False values
-> NonEmptyList Int -- ^ List of True values
-> Gen Prop -- ^ Test result
prop_Utils_select_undefd lst1 (NonEmpty lst2) =
Utils.select undefined cndlist ==? head lst2
Utils.select undefined (flist ++ tlist) ==? head lst2
where flist = map (\e -> (False, e)) lst1
tlist = map (\e -> (True, e)) lst2
cndlist = flist ++ tlist
-- | Test basic select functionality with undefined list values
prop_Utils_select_undefv :: [Int] -- ^ List of False values
......@@ -422,6 +427,8 @@ testSuite "PeerMap"
-- ** Container tests
-- we silence the following due to hlint bug fixed in later versions
{-# ANN prop_Container_addTwo "HLint: ignore Avoid lambda" #-}
prop_Container_addTwo cdata i1 i2 =
fn i1 i2 cont == fn i2 i1 cont &&
fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
......@@ -444,7 +451,7 @@ prop_Container_findByName node othername =
forAll (vector cnt) $ \ names ->
(length . nub) (map fst names ++ map snd names) ==
length names * 2 &&
not (othername `elem` (map fst names ++ map snd names)) ==>
othername `notElem` (map fst names ++ map snd names) ==>
let nl = makeSmallCluster node cnt
nodes = Container.elems nl
nodes' = map (\((name, alias), nn) -> (Node.idx nn,
......@@ -455,7 +462,7 @@ prop_Container_findByName node othername =
target = snd (nodes' !! fidx)
in Container.findByName nl' (Node.name target) == Just target &&
Container.findByName nl' (Node.alias target) == Just target &&
Container.findByName nl' othername == Nothing
isNothing (Container.findByName nl' othername)
testSuite "Container"
[ 'prop_Container_addTwo
......@@ -765,7 +772,7 @@ prop_Node_rMem inst =
-- this is not related to rMem, but as good a place to
-- test as any
inst_idx `elem` Node.sList a_ab &&
not (inst_idx `elem` Node.sList d_ab)
inst_idx `notElem` Node.sList d_ab
x -> printTestCase ("Failed to add/remove instances: " ++ show x) False
-- | Check mdsk setting.
......@@ -858,9 +865,7 @@ prop_ClusterAlloc_sane node inst =
&& Node.availDisk node > 0
&& Node.availMem node > 0
==>
let nl = makeSmallCluster node count
il = Container.empty
inst' = setInstanceSmallerThanNode node inst
let (nl, il, inst') = makeSmallEmptyCluster node count inst
in case Cluster.genAllocNodes defGroupList nl 2 True >>=
Cluster.tryAlloc nl il inst' of
Types.Bad _ -> False
......@@ -900,9 +905,7 @@ prop_ClusterAllocEvac node inst =
&& not (Node.failN1 node)
&& isNodeBig node 4
==>