Commit 5b11f8db authored by Iustin Pop's avatar Iustin Pop

Further hlint fixes

Commit 2cdaf225, “Re-enable standard hlint warnings”, got it almost
right. The only problem is that (confusingly) the default set of hints
is not in HLint.Default, but in HLint.HLint (it includes Default and
some built-ins).

After changing the lint file to correctly include the defaults, we had
another 128 suggestions:

  - Error: Eta reduce (2)
  - Error: Redundant bracket (4)
  - Error: Redundant do (17)
  - Error: Redundant lambda (7)
  - Error: Redundant return (1)
  - Warning: Avoid lambda (2)
  - Warning: Redundant $ (42)
  - Warning: Redundant bracket (35)
  - Warning: Use : (1)
  - Warning: Use String (4)
  - Warning: Use camelCase (10)
  - Warning: Use section (3)

which are fixed by the current patch. Note that the 10 "Use camelCase"
were all due to hlint not “knowing” the idiom of ‘case_’ (it does for
‘prop_’), for which I filled
http://code.google.com/p/ndmitchell/issues/detail?id=558.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarRené Nussbaumer <rn@google.com>
parent 51000365
......@@ -73,8 +73,8 @@ prop_applicative_identity v =
-- | Tests the applicative composition law (pure (.) <*> u <*> v <*> w
-- = u <*> (v <*> w)).
prop_applicative_composition :: (Result (Fun Int Int))
-> (Result (Fun Int Int))
prop_applicative_composition :: Result (Fun Int Int)
-> Result (Fun Int Int)
-> Result Int
-> Property
prop_applicative_composition u v w =
......@@ -85,8 +85,7 @@ prop_applicative_composition u v w =
-- | Tests the applicative homomorphism law (pure f <*> pure x = pure (f x)).
prop_applicative_homomorphism :: Fun Int Int -> Int -> Property
prop_applicative_homomorphism (Fun _ f) x =
((pure f <*> pure x)::Result Int) ==?
(pure (f x))
((pure f <*> pure x)::Result Int) ==? pure (f x)
-- | Tests the applicative interchange law (u <*> pure y = pure ($ y) <*> u).
prop_applicative_interchange :: Result (Fun Int Int)
......
......@@ -38,6 +38,8 @@ import Test.Ganeti.Common
import Ganeti.Common
import Ganeti.Daemon as Daemon
{-# ANN module "HLint: ignore Use camelCase" #-}
-- | Test a few string arguments.
prop_string_arg :: String -> Property
prop_string_arg argument =
......@@ -65,7 +67,7 @@ case_bool_arg =
-- | Tests a few invalid arguments.
case_wrong_arg :: Assertion
case_wrong_arg = do
case_wrong_arg =
mapM_ (passFailOpt defaultOptions assertFailure (return ()))
[ (oSyslogUsage, "foo", "yes")
, (oPort 0, "x", "10")
......
......@@ -43,6 +43,8 @@ import Ganeti.HTools.CLI as CLI
import qualified Ganeti.HTools.Program as Program
import qualified Ganeti.HTools.Types as Types
{-# ANN module "HLint: ignore Use camelCase" #-}
-- | Test correct parsing.
prop_parseISpec :: String -> Int -> Int -> Int -> Property
prop_parseISpec descr dsk mem cpu =
......@@ -52,7 +54,7 @@ prop_parseISpec descr dsk mem cpu =
-- | Test parsing failure due to wrong section count.
prop_parseISpecFail :: String -> Property
prop_parseISpecFail descr =
forAll (choose (0,100) `suchThat` ((/=) 3)) $ \nelems ->
forAll (choose (0,100) `suchThat` (/= 3)) $ \nelems ->
forAll (replicateM nelems arbitrary) $ \values ->
let str = intercalate "," $ map show (values::[Int])
in case parseISpecString descr str of
......@@ -101,7 +103,7 @@ case_bool_arg =
-- | Tests a few invalid arguments.
case_wrong_arg :: Assertion
case_wrong_arg = do
case_wrong_arg =
mapM_ (passFailOpt defaultOptions assertFailure (return ()))
[ (oSpindleUse, "-1", "1")
, (oSpindleUse, "a", "1")
......
......@@ -47,6 +47,8 @@ import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Types as Types
{-# ANN module "HLint: ignore Use camelCase" #-}
-- * Helpers
-- | Make a small cluster, both nodes and instances.
......@@ -148,7 +150,7 @@ prop_Alloc_sane inst =
prop_CanTieredAlloc :: Instance.Instance -> Property
prop_CanTieredAlloc inst =
forAll (choose (2, 5)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
let nl = makeSmallCluster node count
il = Container.empty
rqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
......@@ -196,7 +198,7 @@ genClusterAlloc count node inst =
prop_AllocRelocate :: Property
prop_AllocRelocate =
forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg
......@@ -230,7 +232,7 @@ check_EvacMode grp inst result =
(gdx == Group.idx grp)
v -> failmsg ("invalid solution: " ++ show v) False
where failmsg :: String -> Bool -> Property
failmsg = \msg -> printTestCase ("Failed to evacuate: " ++ msg)
failmsg msg = printTestCase ("Failed to evacuate: " ++ msg)
idx = Instance.idx inst
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
......@@ -238,7 +240,7 @@ check_EvacMode grp inst result =
prop_AllocEvacuate :: Property
prop_AllocEvacuate =
forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg
......@@ -255,7 +257,7 @@ prop_AllocEvacuate =
prop_AllocChangeGroup :: Property
prop_AllocChangeGroup =
forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg
......@@ -327,7 +329,7 @@ prop_SplitCluster node inst =
canAllocOn :: Node.List -> Int -> Instance.Instance -> Bool
canAllocOn nl reqnodes inst =
case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
Cluster.tryAlloc nl (Container.empty) inst of
Cluster.tryAlloc nl Container.empty inst of
Types.Bad _ -> False
Types.Ok as ->
case Cluster.asSolution as of
......@@ -344,7 +346,7 @@ prop_AllocPolicy node =
-- rqn is the required nodes (1 or 2)
forAll (choose (1, 2)) $ \rqn ->
forAll (choose (5, 20)) $ \count ->
forAll (arbitrary `suchThat` (canAllocOn (makeSmallCluster node count) rqn))
forAll (arbitrary `suchThat` canAllocOn (makeSmallCluster node count) rqn)
$ \inst ->
forAll (arbitrary `suchThat` (isFailure .
Instance.instMatchesPolicy inst)) $ \ipol ->
......
......@@ -85,7 +85,7 @@ genNode min_multiplier max_multiplier = do
-- | Helper function to generate a sane node.
genOnlineNode :: Gen Node.Node
genOnlineNode = do
genOnlineNode =
arbitrary `suchThat` (\n -> not (Node.offline n) &&
not (Node.failN1 n) &&
Node.availDisk n > 0 &&
......
......@@ -53,7 +53,7 @@ import qualified Ganeti.HTools.Utils as Utils
-- * Instance text loader tests
prop_Load_Instance :: String -> Int -> Int -> Int -> Types.InstanceStatus
-> NonEmptyList Char -> [Char]
-> NonEmptyList Char -> String
-> NonNegative Int -> NonNegative Int -> Bool
-> Types.DiskTemplate -> Int -> Property
prop_Load_Instance name mem dsk vcpus status
......
......@@ -40,21 +40,21 @@ import qualified Ganeti.HTools.Types as Types
import qualified Ganeti.HTools.Utils as Utils
-- | Helper to generate a small string that doesn't contain commas.
genNonCommaString :: Gen [Char]
genNonCommaString :: Gen String
genNonCommaString = do
size <- choose (0, 20) -- arbitrary max size
vectorOf size (arbitrary `suchThat` ((/=) ','))
vectorOf size (arbitrary `suchThat` (/=) ',')
-- | If the list is not just an empty element, and if the elements do
-- not contain commas, then join+split should be idempotent.
prop_commaJoinSplit :: Property
prop_commaJoinSplit =
forAll (choose (0, 20)) $ \llen ->
forAll (vectorOf llen genNonCommaString `suchThat` ((/=) [""])) $ \lst ->
forAll (vectorOf llen genNonCommaString `suchThat` (/=) [""]) $ \lst ->
Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst
-- | Split and join should always be idempotent.
prop_commaSplitJoin :: [Char] -> Property
prop_commaSplitJoin :: String -> Property
prop_commaSplitJoin s =
Utils.commaJoin (Utils.sepSplit ',' s) ==? s
......
......@@ -58,21 +58,21 @@ instance Arbitrary Luxi.LuxiOp where
case lreq of
Luxi.ReqQuery -> Luxi.Query <$> arbitrary <*> getFields <*> genFilter
Luxi.ReqQueryFields -> Luxi.QueryFields <$> arbitrary <*> getFields
Luxi.ReqQueryNodes -> Luxi.QueryNodes <$> (listOf getFQDN) <*>
Luxi.ReqQueryNodes -> Luxi.QueryNodes <$> listOf getFQDN <*>
getFields <*> arbitrary
Luxi.ReqQueryGroups -> Luxi.QueryGroups <$> arbitrary <*>
arbitrary <*> arbitrary
Luxi.ReqQueryInstances -> Luxi.QueryInstances <$> (listOf getFQDN) <*>
Luxi.ReqQueryInstances -> Luxi.QueryInstances <$> listOf getFQDN <*>
getFields <*> arbitrary
Luxi.ReqQueryJobs -> Luxi.QueryJobs <$> arbitrary <*> getFields
Luxi.ReqQueryExports -> Luxi.QueryExports <$>
(listOf getFQDN) <*> arbitrary
listOf getFQDN <*> arbitrary
Luxi.ReqQueryConfigValues -> Luxi.QueryConfigValues <$> getFields
Luxi.ReqQueryClusterInfo -> pure Luxi.QueryClusterInfo
Luxi.ReqQueryTags -> Luxi.QueryTags <$> arbitrary <*> getFQDN
Luxi.ReqSubmitJob -> Luxi.SubmitJob <$> (resize maxOpCodes arbitrary)
Luxi.ReqSubmitJob -> Luxi.SubmitJob <$> resize maxOpCodes arbitrary
Luxi.ReqSubmitManyJobs -> Luxi.SubmitManyJobs <$>
(resize maxOpCodes arbitrary)
resize maxOpCodes arbitrary
Luxi.ReqWaitForJobChange -> Luxi.WaitForJobChange <$> arbitrary <*>
getFields <*> pure J.JSNull <*>
pure J.JSNull <*> arbitrary
......@@ -116,7 +116,7 @@ luxiClientPong c =
prop_ClientServer :: [[DNSChar]] -> Property
prop_ClientServer dnschars = monadicIO $ do
let msgs = map (map dnsGetChar) dnschars
fpath <- run $ getTempFileName
fpath <- run getTempFileName
-- we need to create the server first, otherwise (if we do it in the
-- forked thread) the client could try to connect to it before it's
-- ready
......@@ -131,7 +131,7 @@ prop_ClientServer dnschars = monadicIO $ do
bracket
(Luxi.getClient fpath)
Luxi.closeClient
(\c -> luxiClientPong c msgs)
(`luxiClientPong` msgs)
stop $ replies ==? msgs
testSuite "Luxi"
......
......@@ -47,6 +47,8 @@ import qualified Ganeti.Constants as C
import Ganeti.Objects as Objects
import Ganeti.JSON
{-# ANN module "HLint: ignore Use camelCase" #-}
-- * Arbitrary instances
$(genArbitrary ''Hypervisor)
......@@ -79,7 +81,7 @@ instance Arbitrary DiskLogicalId where
-- properties, we only generate disks with no children (FIXME), as
-- generating recursive datastructures is a bit more work.
instance Arbitrary Disk where
arbitrary = Disk <$> arbitrary <*> (pure []) <*> arbitrary
arbitrary = Disk <$> arbitrary <*> pure [] <*> arbitrary
<*> arbitrary <*> arbitrary
-- FIXME: we should generate proper values, >=0, etc., but this is
......@@ -102,9 +104,9 @@ instance Arbitrary Instance where
<$> getFQDN <*> getFQDN <*> getFQDN -- OS name, but...
<*> arbitrary
-- FIXME: add non-empty hvparams when they're a proper type
<*> (pure $ Container Map.empty) <*> arbitrary
<*> pure (Container Map.empty) <*> arbitrary
-- ... and for OSParams
<*> (pure $ Container Map.empty) <*> arbitrary <*> arbitrary
<*> pure (Container Map.empty) <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary
-- ts
<*> arbitrary <*> arbitrary
......@@ -127,7 +129,7 @@ $(genArbitrary ''PartialIPolicy)
-- validation rules.
instance Arbitrary NodeGroup where
arbitrary = NodeGroup <$> getFQDN <*> pure [] <*> arbitrary <*> arbitrary
<*> arbitrary <*> (pure $ Container Map.empty)
<*> arbitrary <*> pure (Container Map.empty)
-- ts
<*> arbitrary <*> arbitrary
-- uuid
......@@ -181,7 +183,7 @@ genEmptyCluster ncount = do
nodeName = nodeName n ++ show idx })
nodes [(1::Int)..]
contnodes = Container . Map.fromList $ map (\n -> (nodeName n, n)) nodes'
continsts = Container $ Map.empty
continsts = Container Map.empty
grp <- arbitrary
let contgroups = Container $ Map.singleton guuid grp
serial <- arbitrary
......
......@@ -44,6 +44,8 @@ import Test.Ganeti.TestCommon
import qualified Ganeti.Constants as C
import qualified Ganeti.OpCodes as OpCodes
{-# ANN module "HLint: ignore Use camelCase" #-}
-- * Arbitrary instances
$(genArbitrary ''OpCodes.ReplaceDisksMode)
......@@ -125,7 +127,7 @@ case_py_compat = do
\encoded = [op.__getstate__() for op in decoded]\n\
\print serializer.Dump(encoded)" serialized
>>= checkPythonResult
let deserialised = (J.decode py_stdout::J.Result [OpCodes.OpCode])
let deserialised = J.decode py_stdout::J.Result [OpCodes.OpCode]
decoded <- case deserialised of
J.Ok ops -> return ops
J.Error msg ->
......
......@@ -65,7 +65,7 @@ genFilter' 0 =
where value = oneof [ QuotedString <$> getName
, NumericValue <$> arbitrary
]
genFilter' n = do
genFilter' n =
oneof [ AndFilter <$> vectorOf n'' (genFilter' n')
, OrFilter <$> vectorOf n'' (genFilter' n')
, NotFilter <$> genFilter' n'
......@@ -92,7 +92,7 @@ $(genArbitrary ''FieldDefinition)
-- recursive ones, and not 'JSNull', which we can't use in a
-- 'RSNormal' 'ResultEntry'.
genJSValue :: Gen JSValue
genJSValue = do
genJSValue =
oneof [ JSBool <$> arbitrary
, JSRational <$> pure False <*> arbitrary
, JSString <$> (toJSString <$> arbitrary)
......
......@@ -47,6 +47,8 @@ import Ganeti.Query.Language
import Ganeti.Query.Node
import Ganeti.Query.Query
{-# ANN module "HLint: ignore Use camelCase" #-}
-- * Helpers
-- | Checks if a list of field definitions contains unknown fields.
......@@ -77,7 +79,7 @@ prop_queryNode_noUnknown =
prop_queryNode_Unknown :: Property
prop_queryNode_Unknown =
forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
forAll (arbitrary `suchThat` (`notElem` (Map.keys nodeFieldsMap)))
forAll (arbitrary `suchThat` (`notElem` Map.keys nodeFieldsMap))
$ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cluster (Query QRNode [field] EmptyFilter)) >>= resultProp
......
......@@ -149,7 +149,7 @@ newtype TagChar = TagChar { tagGetChar :: Char }
-- | All valid tag chars. This doesn't need to match _exactly_
-- Ganeti's own tag regex, just enough for it to be close.
tagChar :: [Char]
tagChar :: String
tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
instance Arbitrary TagChar where
......
......@@ -95,7 +95,7 @@ mkConsArbitrary :: (Name, [a]) -> Exp
mkConsArbitrary (name, types) =
let infix_arb a = InfixE (Just a) (VarE '(<*>)) (Just (VarE 'arbitrary))
constr = AppE (VarE 'pure) (ConE name)
in foldl (\a _ -> infix_arb a) (constr) types
in foldl (\a _ -> infix_arb a) constr types
-- | Extracts the name and the types from a constructor.
conInfo :: Con -> (Name, [Type])
......@@ -108,7 +108,7 @@ conInfo (ForallC _ _ subcon) = conInfo subcon
mkRegularArbitrary :: Name -> [Con] -> Q [Dec]
mkRegularArbitrary name cons = do
expr <- case cons of
[] -> fail $ "Can't make Arbitrary instance for an empty data type"
[] -> fail "Can't make Arbitrary instance for an empty data type"
[x] -> return $ mkConsArbitrary (conInfo x)
xs -> appE (varE 'oneof) $
listE (map (return . mkConsArbitrary . conInfo) xs)
......
......@@ -99,10 +99,10 @@ reqWithConversion :: (String -> Result a)
-> (a -> b -> Result b)
-> String
-> ArgDescr (b -> Result b)
reqWithConversion conversion_fn updater_fn metavar =
reqWithConversion conversion_fn updater_fn =
ReqArg (\string_opt opts -> do
parsed_value <- conversion_fn string_opt
updater_fn parsed_value opts) metavar
updater_fn parsed_value opts)
-- | Command line parser, using a generic 'Options' structure.
parseOpts :: (StandardOptions a) =>
......
......@@ -146,7 +146,7 @@ $(declareIADT "ConfdErrorType"
])
$(makeJSONInstance ''ConfdErrorType)
$(buildObject "ConfdRequest" "confdRq" $
$(buildObject "ConfdRequest" "confdRq"
[ simpleField "protocol" [t| Int |]
, simpleField "type" [t| ConfdRequestType |]
, defaultField [| EmptyQuery |] $ simpleField "query" [t| ConfdQuery |]
......
......@@ -286,7 +286,7 @@ updateConfig path r = do
-- | Wrapper over 'updateConfig' that handles IO errors.
safeUpdateConfig :: FilePath -> FStat -> CRef -> IO (FStat, ConfigReload)
safeUpdateConfig path oldfstat cref = do
safeUpdateConfig path oldfstat cref =
catch (do
nt <- needsReload oldfstat path
case nt of
......@@ -410,7 +410,7 @@ onReloadInner inotiaction path cref
-- This tries to setup the watch descriptor; in case of any IO errors,
-- it will return False.
addNotifier :: INotify -> FilePath -> CRef -> MVar ServerState -> IO Bool
addNotifier inotify path cref mstate = do
addNotifier inotify path cref mstate =
catch (addWatch inotify [CloseWrite] path
(onInotify inotify path cref mstate) >> return True)
(\e -> const (return False) (e::IOError))
......@@ -430,9 +430,9 @@ onInotify inotify path cref mstate Ignored = do
path cref mstate
return state' { reloadModel = mode }
onInotify inotify path cref mstate _ = do
onInotify inotify path cref mstate _ =
modifyMVar_ mstate $ \state ->
if (reloadModel state == ReloadNotify)
if reloadModel state == ReloadNotify
then do
ctime <- getCurrentTime
(newfstat, _) <- safeUpdateConfig path (reloadFStat state) cref
......@@ -481,7 +481,7 @@ listener :: S.Socket -> HashKey
listener s hmac resp = do
(msg, _, peer) <- S.recvFrom s 4096
if confdMagicFourcc `isPrefixOf` msg
then (forkIO $ resp s hmac (drop 4 msg) peer) >> return ()
then forkIO (resp s hmac (drop 4 msg) peer) >> return ()
else logDebug "Invalid magic code!" >> return ()
return ()
......
......@@ -63,7 +63,7 @@ parseMessage :: HashKey -> String -> Integer
parseMessage hmac msg curtime = do
(salt, origmsg, request) <- parseRequest hmac msg
ts <- tryRead "Parsing timestamp" salt::Result Integer
if (abs (ts - curtime) > (fromIntegral C.confdMaxClockSkew))
if abs (ts - curtime) > fromIntegral C.confdMaxClockSkew
then fail "Too old/too new timestamp or clock skew"
else return (origmsg, request)
......
......@@ -111,7 +111,7 @@ getNodeInstances cfg nname =
-- | Computes the role of a node.
getNodeRole :: ConfigData -> Node -> NodeRole
getNodeRole cfg node
| nodeName node == (clusterMasterNode $ configCluster cfg) = NRMaster
| nodeName node == clusterMasterNode (configCluster cfg) = NRMaster
| nodeMasterCandidate node = NRCandidate
| nodeDrained node = NRDrained
| nodeOffline node = NROffline
......@@ -133,7 +133,7 @@ getInstancesIpByLink linkipmap link =
getItem :: String -> String -> M.Map String a -> Result a
getItem kind name allitems = do
let lresult = lookupName (M.keys allitems) name
err = \details -> Bad $ kind ++ " name " ++ name ++ " " ++ details
err msg = Bad $ kind ++ " name " ++ name ++ " " ++ msg
fullname <- case lrMatchPriority lresult of
PartialMatch -> Ok $ lrContent lresult
ExactMatch -> Ok $ lrContent lresult
......@@ -160,7 +160,7 @@ getGroup cfg name =
-- if not found by uuid, we need to look it up by name, slow
Ok grp -> Ok grp
Bad _ -> let by_name = M.mapKeys
(\k -> groupName ((M.!) groups k )) groups
(groupName . (M.!) groups) groups
in getItem "NodeGroup" name by_name
-- | Computes a node group's node params.
......@@ -232,7 +232,7 @@ buildLinkIpInstnameMap cfg =
link = nicpLink fparams
in case nicIp nic of
Nothing -> accum
Just ip -> let oldipmap = M.findWithDefault (M.empty)
Just ip -> let oldipmap = M.findWithDefault M.empty
link accum
newipmap = M.insert ip iname oldipmap
in M.insert link newipmap accum
......
......@@ -105,8 +105,8 @@ defaultOptions = DaemonOptions
instance StandardOptions DaemonOptions where
helpRequested = optShowHelp
verRequested = optShowVer
requestHelp = \opts -> opts { optShowHelp = True }
requestVer = \opts -> opts { optShowVer = True }
requestHelp o = o { optShowHelp = True }
requestVer o = o { optShowVer = True }
-- | Abrreviation for the option type.
type OptType = GenericOptType DaemonOptions
......@@ -176,14 +176,14 @@ formatIOError msg err = msg ++ ": " ++ show err
-- | Wrapper over '_writePidFile' that transforms IO exceptions into a
-- 'Bad' value.
writePidFile :: FilePath -> IO (Result Fd)
writePidFile path = do
writePidFile path =
catch (fmap Ok $ _writePidFile path)
(return . Bad . formatIOError "Failure during writing of the pid file")
-- | Helper function to ensure a socket doesn't exist. Should only be
-- called once we have locked the pid file successfully.
cleanupSocket :: FilePath -> IO ()
cleanupSocket socketPath = do
cleanupSocket socketPath =
catchJust (guard . isDoesNotExistError) (removeLink socketPath)
(const $ return ())
......@@ -217,11 +217,11 @@ defaultBindAddr :: Int -- ^ The port we want
-> Socket.Family -- ^ The cluster IP family
-> Result (Socket.Family, Socket.SockAddr)
defaultBindAddr port Socket.AF_INET =
Ok $ (Socket.AF_INET,
Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
Ok (Socket.AF_INET,
Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
defaultBindAddr port Socket.AF_INET6 =
Ok $ (Socket.AF_INET6,
Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
Ok (Socket.AF_INET6,
Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam
-- | Default hints for the resolver
......@@ -236,7 +236,7 @@ resolveAddr port str = do
resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port))
return $ case resolved of
[] -> Bad "Invalid results from lookup?"
best:_ -> Ok $ (Socket.addrFamily best, Socket.addrAddress best)
best:_ -> Ok (Socket.addrFamily best, Socket.addrAddress best)
-- | Based on the options, compute the socket address to use for the
-- daemon.
......@@ -246,11 +246,10 @@ parseAddress :: DaemonOptions -- ^ Command line options
parseAddress opts defport = do
let port = maybe defport fromIntegral $ optPort opts
def_family <- Ssconf.getPrimaryIPFamily Nothing
ainfo <- case optBindAddress opts of
Nothing -> return (def_family >>= defaultBindAddr port)
Just saddr -> catch (resolveAddr port saddr)
(annotateIOError $ "Invalid address " ++ saddr)
return ainfo
case optBindAddress opts of
Nothing -> return (def_family >>= defaultBindAddr port)
Just saddr -> catch (resolveAddr port saddr)
(annotateIOError $ "Invalid address " ++ saddr)
-- | Run an I/O action as a daemon.
--
......
......@@ -199,8 +199,8 @@ type OptType = GenericOptType Options
instance StandardOptions Options where
helpRequested = optShowHelp
verRequested = optShowVer
requestHelp = \opts -> opts { optShowHelp = True }
requestVer = \opts -> opts { optShowVer = True }
requestHelp o = o { optShowHelp = True }
requestVer o = o { optShowVer = True }
-- * Helper functions
......@@ -539,7 +539,7 @@ setNodeStatus opts fixed_nl = do
m_cpu = optMcpu opts
m_dsk = optMdsk opts
unless (null offline_wrong) $ do
unless (null offline_wrong) .
exitErr $ printf "wrong node name(s) set as offline: %s\n"
(commaJoin (map lrContent offline_wrong))
let setMCpuFn = case m_cpu of
......
......@@ -276,7 +276,7 @@ instMatchesPolicy :: Instance -> T.IPolicy -> T.OpResult ()
instMatchesPolicy inst ipol = do
instAboveISpec inst (T.iPolicyMinSpec ipol)
instBelowISpec inst (T.iPolicyMaxSpec ipol)
if (diskTemplate inst `elem` T.iPolicyDiskTemplates ipol)
if diskTemplate inst `elem` T.iPolicyDiskTemplates ipol
then T.OpGood ()
else T.OpFail T.FailDisk
......
......@@ -212,7 +212,7 @@ getClusterData (JSObject obj) = do
cpol <- tryFromObj errmsg obj' "ipolicy"
return (ctags, cpol)
getClusterData _ = Bad $ "Cannot parse cluster info, not a JSON record"
getClusterData _ = Bad "Cannot parse cluster info, not a JSON record"
-- | Parses the cluster groups.
getGroups :: JSValue -> Result [(String, Group.Group)]
......
......@@ -158,8 +158,8 @@ printBool False b = show b
-- readable mode).
printGroupsMappings :: Group.List -> IO ()
printGroupsMappings gl = do
let extract_vals = \g -> (printf "GROUP_UUID_%d" $ Group.idx g :: String,
Group.uuid g)
let extract_vals g = (printf "GROUP_UUID_%d" $ Group.idx g :: String,
Group.uuid g)
printpairs = map extract_vals (Container.elems gl)
printKeysHTC printpairs
......
......@@ -104,9 +104,9 @@ showGroupInfo verbose gl nl il = do
splitInstancesInfo :: Int -> Node.List -> Instance.List -> IO ()
splitInstancesInfo verbose nl il = do
let split_insts = Cluster.findSplitInstances nl il
if (null split_insts)
if null split_insts
then
when (verbose > 1) $ do
when (verbose > 1) $
putStrLn "No split instances found"::IO ()
else do
putStrLn "Found instances belonging to multiple node groups:"
......@@ -115,12 +115,12 @@ splitInstancesInfo verbose nl il = do
-- | Print common (interesting) information.
commonInfo :: Int -> Group.List -> Node.List -> Instance.List -> IO ()
commonInfo verbose gl nl il = do
when (Container.null il && verbose > 1) $ do
printf "Cluster is empty.\n"::IO ()
when (Container.null il && verbose > 1) $
printf "Cluster is empty.\n"::IO ()
let nl_size = (Container.size nl)