Commit 2cdaf225 authored by Iustin Pop's avatar Iustin Pop

Re-enable standard hlint warnings

Commit 5a1e31b4 (Add infrastructure for, and two extra hlint rules)
was intended to add two *extra* hlint rules, but I didn't realise at
that time that "--hint" when first used overrides the built-in
lints. As such, since then we were basically running with just those
two rules, which resulted in many uncaught warnings/errors.

This patch fixes that (by importing the standard lint rules in our
custom hints file), and then goes to fix all the warnings that a
current hlint gives me. Compared to our current style, we have just a
few additions:

- zipWithM instead of map foo . zip …
- 'exitSuccess' instead of 'exitWith ExitSuccess'
- more uses of '.'

Additionally, we have to silence a case where hlint doesn't realise
why we are using '\e -> const (return False (e :: IOError)' instead of
just '\e -> return False' or even 'const (return False').

One warning that is generated by hlint ("Use void") can't be fixed
until we deprecate GHC 6.x, as only GHC 7 has the 'void' function in
Control.Monad.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAgata Murawska <agatamurawska@google.com>
parent 1bf11fff
......@@ -1358,6 +1358,7 @@ pep8: $(GENERATED_FILES)
$(PEP8) --ignore='$(PEP8_IGNORE)' --exclude='$(PEP8_EXCLUDE)' \
--repeat $(pep8_python_code)
# FIXME: remove ignore "Use void" when GHC 6.x is deprecated
.PHONY: hlint
hlint: $(HS_BUILT_SRCS) htools/lint-hints.hs
@test -n "$(HLINT)" || { echo 'hlint' not found during configure; exit 1; }
......@@ -1367,6 +1368,8 @@ hlint: $(HS_BUILT_SRCS) htools/lint-hints.hs
--ignore "Use comparing" \
--ignore "Use on" \
--ignore "Reduce duplication" \
--ignore "Use &&&" \
--ignore "Use void" \
--hint htools/lint-hints \
$(filter-out htools/Ganeti/THH.hs,$(HS_LIB_SRCS))
......
......@@ -89,14 +89,14 @@ $(makeJSONInstance ''ConfdReqField)
-- converts them to strings anyway, as they're used as dict-keys.
$(buildObject "ConfdReqQ" "confdReqQ"
[ renameField "Ip" $
[ renameField "Ip" .
optionalField $ simpleField C.confdReqqIp [t| String |]
, renameField "IpList" $
, renameField "IpList" .
defaultField [| [] |] $
simpleField C.confdReqqIplist [t| [String] |]
, renameField "Link" $ optionalField $
, renameField "Link" . optionalField $
simpleField C.confdReqqLink [t| String |]
, renameField "Fields" $ defaultField [| [] |] $
, renameField "Fields" . defaultField [| [] |] $
simpleField C.confdReqqFields [t| [ConfdReqField] |]
])
......
......@@ -31,11 +31,12 @@ module Ganeti.Confd.Server
import Control.Concurrent
import Control.Exception
import Control.Monad (forever, liftM)
import Control.Monad (forever, liftM, when)
import qualified Data.ByteString as B
import Data.IORef
import Data.List
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import qualified Network.Socket as S
import Prelude hiding (catch)
import System.Posix.Files
......@@ -217,7 +218,7 @@ buildResponse (cfg, linkipmap)
buildResponse cdata (ConfdRequest { confdRqType = ReqNodePipByInstPip
, confdRqQuery = DictQuery query}) =
let (cfg, linkipmap) = cdata
link = maybe (getDefaultNicLink cfg) id (confdReqQLink query)
link = fromMaybe (getDefaultNicLink cfg) (confdReqQLink query)
in case confdReqQIp query of
Just ip -> return $ getNodePipByInstanceIp cfg linkipmap link ip
Nothing -> return (ReplyStatusOk,
......@@ -333,7 +334,7 @@ buildFileStatus ofs =
-- | Wrapper over 'buildFileStatus'. This reads the data from the
-- filesystem and then builds our cache structure.
getFStat :: FilePath -> IO FStat
getFStat p = getFileStatus p >>= (return . buildFileStatus)
getFStat p = liftM buildFileStatus (getFileStatus p)
-- | Check if the file needs reloading
needsReload :: FStat -> FilePath -> IO (Maybe FStat)
......@@ -389,12 +390,10 @@ onTimeoutInner path cref state = do
onReloadTimer :: IO Bool -> FilePath -> CRef -> MVar ServerState -> IO ()
onReloadTimer inotiaction path cref state = do
continue <- modifyMVar state (onReloadInner inotiaction path cref)
if continue
then do
threadDelay configReloadRatelimit
when continue $
do threadDelay configReloadRatelimit
onReloadTimer inotiaction path cref state
else -- the inotify watch has been re-established, we can exit
return ()
-- the inotify watch has been re-established, we can exit
-- | Inner onReload handler.
--
......@@ -425,6 +424,9 @@ onReloadInner inotiaction path cref
_ -> True
return (state' { reloadModel = newmode }, continue)
-- the following hint is because hlint doesn't understand our const
-- (return False) is so that we can give a signature to 'e'
{-# ANN addNotifier "HLint: ignore Evaluate" #-}
-- | Setup inotify watcher.
--
-- This tries to setup the watch descriptor; in case of any IO errors,
......
......@@ -37,6 +37,7 @@ module Ganeti.Config
, instNodes
) where
import Control.Monad (liftM)
import Data.List (foldl')
import qualified Data.Map as M
import qualified Data.Set as S
......@@ -134,7 +135,7 @@ getInstance cfg name =
-- | Looks up an instance's primary node.
getInstPrimaryNode :: ConfigData -> String -> Result Node
getInstPrimaryNode cfg name =
getInstance cfg name >>= return . instPrimaryNode >>= getNode cfg
liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
-- | Filters DRBD minors for a given node.
getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
......
......@@ -314,13 +314,13 @@ genericMain daemon options main = do
when (optShowHelp opts) $ do
putStr $ usageHelp progname options
exitWith ExitSuccess
exitSuccess
when (optShowVer opts) $ do
printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
progname Version.version
compilerName (Data.Version.showVersion compilerVersion)
os arch :: IO ()
exitWith ExitSuccess
exitSuccess
exitUnless (null args) "This program doesn't take any arguments"
......
......@@ -931,7 +931,7 @@ nodeEvacInstance nl il ChangeAll
let no_nodes = Left "no nodes available"
node_pairs = [(p,s) | p <- avail_nodes, s <- avail_nodes, p /= s]
(nl', il', ops, _) <-
annotateResult "Can't find any good nodes for relocation" $
annotateResult "Can't find any good nodes for relocation" .
eitherToResult $
foldl'
(\accu nodes -> case evacDrbdAllInner nl il inst gdx nodes of
......@@ -974,7 +974,7 @@ evacOneNodeOnly nl il inst gdx avail_nodes = do
MirrorNone -> Bad "Can't relocate/evacuate non-mirrored instances"
MirrorInternal -> Ok ReplaceSecondary
MirrorExternal -> Ok FailoverToAny
(nl', inst', _, ndx) <- annotateResult "Can't find any good node" $
(nl', inst', _, ndx) <- annotateResult "Can't find any good node" .
eitherToResult $
foldl' (evacOneNodeInner nl inst gdx op_fn)
(Left "no nodes available") avail_nodes
......@@ -1046,7 +1046,7 @@ evacDrbdAllInner nl il inst gdx (t_pdx, t_sdx) = do
if Node.offline primary
then do
(nl', inst', _, _) <-
annotateResult "Failing over to the secondary" $
annotateResult "Failing over to the secondary" .
opToResult $ applyMove nl inst Failover
return (nl', inst', [Failover])
else return (nl, inst, [])
......@@ -1056,17 +1056,17 @@ evacDrbdAllInner nl il inst gdx (t_pdx, t_sdx) = do
-- we now need to execute a replace secondary to the future
-- primary node
(nl2, inst2, _, _) <-
annotateResult "Changing secondary to new primary" $
annotateResult "Changing secondary to new primary" .
opToResult $
applyMove nl1 inst1 o1
let ops2 = o1:ops1
-- we now execute another failover, the primary stays fixed now
(nl3, inst3, _, _) <- annotateResult "Failing over to new primary" $
(nl3, inst3, _, _) <- annotateResult "Failing over to new primary" .
opToResult $ applyMove nl2 inst2 o2
let ops3 = o2:ops2
-- and finally another replace secondary, to the final secondary
(nl4, inst4, _, _) <-
annotateResult "Changing secondary to final secondary" $
annotateResult "Changing secondary to final secondary" .
opToResult $
applyMove nl3 inst3 o3
let ops4 = o3:ops3
......
......@@ -55,7 +55,7 @@ import Ganeti.HTools.Utils (sepSplit, tryRead, exitIfBad, exitWhen)
-- | Error beautifier.
wrapIO :: IO (Result a) -> IO (Result a)
wrapIO = flip catch (\e -> return . Bad . show $ (e::IOException))
wrapIO = handle (\e -> return . Bad . show $ (e::IOException))
-- | Parses a user-supplied utilisation string.
parseUtilisation :: String -> Result (String, DynUtil)
......@@ -102,10 +102,10 @@ loadExternalData opts = do
input_data <-
case () of
_ | setRapi -> wrapIO $ Rapi.loadData mhost
| setLuxi -> wrapIO $ Luxi.loadData $ fromJust lsock
| setLuxi -> wrapIO . Luxi.loadData $ fromJust lsock
| setSim -> Simu.loadData simdata
| setFile -> wrapIO $ Text.loadData $ fromJust tfile
| setIAllocSrc -> wrapIO $ IAlloc.loadData $ fromJust iallocsrc
| setFile -> wrapIO . Text.loadData $ fromJust tfile
| setIAllocSrc -> wrapIO . IAlloc.loadData $ fromJust iallocsrc
| otherwise -> return $ Bad "No backend selected! Exiting."
let ldresult = input_data >>= mergeData util_data exTags selInsts exInsts
......
......@@ -276,7 +276,7 @@ processRelocate gl nl il idx 1 exndx = do
MirrorNone -> fail "Can't relocate non-mirrored instances"
MirrorInternal -> return (sorig, "secondary", ChangeSecondary)
MirrorExternal -> return (porig, "primary", ChangePrimary)
when (exndx /= [exp_node]) $
when (exndx /= [exp_node]) .
-- FIXME: we can't use the excluded nodes here; the logic is
-- already _but only partially_ implemented in tryNodeEvac...
fail $ "Unsupported request: excluded nodes not equal to\
......
......@@ -75,10 +75,10 @@ main opts args = do
let Request rq cdata = request
when (verbose > 1) $
when (verbose > 1) .
hPutStrLn stderr $ "Received request: " ++ show rq
when (verbose > 2) $
when (verbose > 2) .
hPutStrLn stderr $ "Received cluster data: " ++ show cdata
maybePrintNodes shownodes "Initial cluster"
......
......@@ -297,7 +297,7 @@ checkCluster verbose nl il = do
-- nothing to do on an empty cluster
when (Container.null il) $ do
printf "Cluster is empty, exiting.\n"::IO ()
exitWith ExitSuccess
exitSuccess
-- hbal doesn't currently handle split clusters
let split_insts = Cluster.findSplitInstances nl il
......@@ -328,7 +328,7 @@ checkGroup verbose gname nl il = do
"Initial check done: %d bad nodes, %d bad instances.\n"
(length bad_nodes) (length bad_instances)
when (not (null bad_nodes)) $
unless (null bad_nodes) $
putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
\that the cluster will end N+1 happy."
......@@ -340,7 +340,7 @@ checkNeedRebalance opts ini_cv = do
printf "Cluster is already well balanced (initial score %.6g,\n\
\minimum score %.6g).\nNothing to do, exiting\n"
ini_cv min_cv:: IO ()
exitWith ExitSuccess
exitSuccess
-- | Main function.
main :: Options -> [String] -> IO ()
......@@ -411,7 +411,7 @@ main opts args = do
let cmd_jobs = Cluster.splitJobs cmd_strs
when (isJust $ optShowCmds opts) $
when (isJust $ optShowCmds opts) .
saveBalanceCommands opts $ Cluster.formatCmds cmd_jobs
maybeSaveData (optSaveCluster opts) "balanced" "after balancing"
......
......@@ -188,7 +188,7 @@ printStats verbose False level phase values name = do
unless (verbose == 0) $ do
putStrLn ""
putStr prefix
mapM_ (\(a,b) -> printf " %s: %s\n" a b) (zip descr values)
mapM_ (uncurry (printf " %s: %s\n")) (zip descr values)
-- | Extract name or idx from group.
extractGroupData :: Bool -> Group.Group -> String
......@@ -230,7 +230,7 @@ perGroupChecks :: Group.List -> GroupInfo -> GroupStats
perGroupChecks gl (gidx, (nl, il)) =
let grp = Container.find gidx gl
offnl = filter Node.offline (Container.elems nl)
n1violated = length $ fst $ Cluster.computeBadItems nl il
n1violated = length . fst $ Cluster.computeBadItems nl il
conflicttags = length $ filter (>0)
(map Node.conflictingPrimaries (Container.elems nl))
offline_pri = sum . map length $ map Node.pList offnl
......@@ -335,4 +335,4 @@ main opts args = do
printFinalHTC machineread
unless exitOK $ exitWith $ ExitFailure 1
unless exitOK . exitWith $ ExitFailure 1
......@@ -118,7 +118,7 @@ writeDataInner nlen name opts cdata fixdata = do
oname = odir </> fixSlash name
putStrLn $ printCluster nl il
hFlush stdout
when (isJust shownodes) $
when (isJust shownodes) .
putStr $ Cluster.printNodes nl (fromJust shownodes)
writeFile (oname <.> "data") (serializeCluster cdata)
return True
......@@ -142,7 +142,7 @@ main opts clusters = do
let name = local
input_data <- Luxi.loadData lsock
result <- writeData nlen name opts input_data
unless result $ exitWith $ ExitFailure 2
unless result . exitWith $ ExitFailure 2
results <- mapM (\name -> Rapi.loadData name >>= writeData nlen name opts)
clusters
......
......@@ -1426,7 +1426,7 @@ prop_ClusterAllocEvacuate =
case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg
Types.Ok (nl, il, inst') ->
conjoin $ map (\mode -> check_EvacMode defGroup inst' $
conjoin . map (\mode -> check_EvacMode defGroup inst' $
Cluster.tryNodeEvac defGroupList nl il mode
[Instance.idx inst']) .
evacModeOptions .
......@@ -1894,7 +1894,7 @@ prop_Luxi_ClientServer dnschars = monadicIO $ do
-- ready
server <- run $ Luxi.getServer fpath
-- fork the server responder
_ <- run $ forkIO $
_ <- run . forkIO $
bracket
(Luxi.acceptClient server)
(\c -> Luxi.closeClient c >> removeFile fpath)
......
......@@ -85,7 +85,7 @@ getUrl url = do
-- | Helper to convert I/O errors in 'Bad' values.
ioErrToResult :: IO a -> IO (Result a)
ioErrToResult ioaction =
catch (ioaction >>= return . Ok)
catch (liftM Ok ioaction)
(\e -> return . Bad . show $ (e::IOException))
-- | Append the default port if not passed in.
......@@ -203,10 +203,10 @@ readDataHttp master = do
readDataFile:: String -- ^ Path to the directory containing the files
-> IO (Result String, Result String, Result String, Result String)
readDataFile path = do
group_body <- ioErrToResult $ readFile $ path </> "groups.json"
node_body <- ioErrToResult $ readFile $ path </> "nodes.json"
inst_body <- ioErrToResult $ readFile $ path </> "instances.json"
info_body <- ioErrToResult $ readFile $ path </> "info.json"
group_body <- ioErrToResult . readFile $ path </> "groups.json"
node_body <- ioErrToResult . readFile $ path </> "nodes.json"
inst_body <- ioErrToResult . readFile $ path </> "instances.json"
info_body <- ioErrToResult . readFile $ path </> "info.json"
return (group_body, node_body, inst_body, info_body)
-- | Loads data via either 'readDataFile' or 'readDataHttp'.
......
......@@ -30,7 +30,7 @@ module Ganeti.HTools.Simu
, parseData
) where
import Control.Monad (mplus)
import Control.Monad (mplus, zipWithM)
import Text.Printf (printf)
import Ganeti.HTools.Utils
......@@ -90,7 +90,7 @@ createGroup grpIndex spec = do
parseData :: [String] -- ^ Cluster description in text format
-> Result ClusterData
parseData ndata = do
grpNodeData <- mapM (uncurry createGroup) $ zip [1..] ndata
grpNodeData <- zipWithM createGroup [1..] ndata
let (groups, nodes) = unzip grpNodeData
nodes' = concat nodes
let ktn = map (\(idx, n) -> (idx, Node.setIdx n idx))
......
......@@ -182,7 +182,7 @@ loadNode :: (Monad m) =>
loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, spindles] = do
gdx <- lookupGroup ktg name gu
new_node <-
if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then
if "?" `elem` [tm,nm,fm,td,fd,tc] || fo == "Y" then
return $ Node.create name 0 0 0 0 0 0 True 0 gdx
else do
vtm <- tryRead name tm
......@@ -224,7 +224,7 @@ loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
disk_template <- annotateResult ("Instance " ++ name)
(diskTemplateFromRaw dt)
spindle_use <- tryRead name su
when (sidx == pidx) $ fail $ "Instance " ++ name ++
when (sidx == pidx) . fail $ "Instance " ++ name ++
" has same primary and secondary node - " ++ pnode
let vtags = commaSplit tags
newinst = Instance.create name vmem vdsk vvcpus vstatus vtags
......
......@@ -168,7 +168,7 @@ formatTable vals numpos =
-- | Constructs a printable table from given header and rows
printTable :: String -> [String] -> [[String]] -> [Bool] -> String
printTable lp header rows isnum =
unlines . map ((++) lp) . map ((:) ' ' . unwords) $
unlines . map ((++) lp . (:) ' ' . unwords) $
formatTable (header:rows) isnum
-- | Converts a unit (e.g. m or GB) into a scaling factor.
......
......@@ -47,7 +47,7 @@ stringToWord8 = B.unpack . encodeUtf8 . T.pack
-- | Converts a list of bytes to a string.
word8ToString :: HashKey -> String
word8ToString = concat . map (printf "%02x")
word8ToString = concatMap (printf "%02x")
-- | Computes the HMAC for a given key/test and salt.
computeMac :: HashKey -> Maybe String -> String -> String
......
......@@ -112,7 +112,7 @@ setupLogging logf program debug stderr_logging console syslog = do
Just path -> openFormattedHandler file_logging fmt $
fileHandler path level
let handlers = concat [file_handlers, stderr_handlers]
let handlers = file_handlers ++ stderr_handlers
updateGlobalLogger rootLoggerName $ setHandlers handlers
-- syslog handler is special (another type, still instance of the
-- typeclass, and has a built-in formatter), so we can't pass it in
......
......@@ -310,8 +310,8 @@ recvMsgExt s =
buildCall :: LuxiOp -- ^ The method
-> String -- ^ The serialized form
buildCall lo =
let ja = [ (strOfKey Method, JSString $ toJSString $ strOfOp lo::JSValue)
, (strOfKey Args, opToArgs lo::JSValue)
let ja = [ (strOfKey Method, J.showJSON $ strOfOp lo)
, (strOfKey Args, opToArgs lo)
]
jo = toJSObject ja
in encodeStrict jo
......
......@@ -102,7 +102,7 @@ instance Show RpcError where
"Node " ++ nodeName node ++ " is marked as offline"
rpcErrorJsonReport :: (Monad m) => J.Result a -> m (Either RpcError a)
rpcErrorJsonReport (J.Error x) = return $ Left $ JsonDecodeError x
rpcErrorJsonReport (J.Error x) = return . Left $ JsonDecodeError x
rpcErrorJsonReport (J.Ok x) = return $ Right x
-- | Basic timeouts for RPC calls.
......@@ -162,9 +162,9 @@ executeHttpRequest node (Right request) = do
url = requestUrl request
-- FIXME: This is very similar to getUrl in Htools/Rapi.hs
(code, !body) <- curlGetString url $ curlOpts ++ reqOpts
case code of
CurlOK -> return $ Right body
_ -> return $ Left $ CurlLayerError node (show code)
return $ case code of
CurlOK -> Right body
_ -> Left $ CurlLayerError node (show code)
#endif
-- | Prepare url for the HTTP request.
......
......@@ -128,5 +128,5 @@ parseIPFamily fam | fam == C.ip4Family = Ok Socket.AF_INET
getPrimaryIPFamily :: Maybe FilePath -> IO (Result Socket.Family)
getPrimaryIPFamily optpath = do
result <- readSSConfFile optpath (Just (show C.ip4Family)) SSPrimaryIpFamily
return (result >>= return . rstripSpace >>=
return (liftM rstripSpace result >>=
tryRead "Parsing af_family" >>= parseIPFamily)
{- Custom hint lints for Ganeti.
Since passing --hint to hlint will override, not extend the built-in hints, we need to import the existing hints so that we get full coverage.
-}
import "hint" HLint.Default
import "hint" HLint.Dollar
-- The following two hints warn to simplify e.g. "map (\v -> (v,
-- True)) lst" to "zip lst (repeat True)", which is more abstract
warn = map (\v -> (v, x)) y ==> zip y (repeat x)
......
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