From 2cdaf22531affcdb44eeb6a80a65c42ba2d50ca1 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Sat, 18 Aug 2012 20:52:20 +0200
Subject: [PATCH] Re-enable standard hlint warnings
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
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: Iustin Pop <iustin@google.com>
Reviewed-by: Agata Murawska <agatamurawska@google.com>
---
Makefile.am | 3 +++
htools/Ganeti/Confd.hs | 8 ++++----
htools/Ganeti/Confd/Server.hs | 20 +++++++++++---------
htools/Ganeti/Config.hs | 3 ++-
htools/Ganeti/Daemon.hs | 4 ++--
htools/Ganeti/HTools/Cluster.hs | 12 ++++++------
htools/Ganeti/HTools/ExtLoader.hs | 8 ++++----
htools/Ganeti/HTools/IAlloc.hs | 2 +-
htools/Ganeti/HTools/Program/Hail.hs | 4 ++--
htools/Ganeti/HTools/Program/Hbal.hs | 8 ++++----
htools/Ganeti/HTools/Program/Hcheck.hs | 6 +++---
htools/Ganeti/HTools/Program/Hscan.hs | 4 ++--
htools/Ganeti/HTools/QC.hs | 4 ++--
htools/Ganeti/HTools/Rapi.hs | 10 +++++-----
htools/Ganeti/HTools/Simu.hs | 4 ++--
htools/Ganeti/HTools/Text.hs | 4 ++--
htools/Ganeti/HTools/Utils.hs | 2 +-
htools/Ganeti/Hash.hs | 2 +-
htools/Ganeti/Logging.hs | 2 +-
htools/Ganeti/Luxi.hs | 4 ++--
htools/Ganeti/Rpc.hs | 8 ++++----
htools/Ganeti/Ssconf.hs | 2 +-
htools/lint-hints.hs | 9 +++++++++
23 files changed, 74 insertions(+), 59 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index bd0e4dced..8d412c406 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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))
diff --git a/htools/Ganeti/Confd.hs b/htools/Ganeti/Confd.hs
index 8fdf12d77..ceb4c8f24 100644
--- a/htools/Ganeti/Confd.hs
+++ b/htools/Ganeti/Confd.hs
@@ -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] |]
])
diff --git a/htools/Ganeti/Confd/Server.hs b/htools/Ganeti/Confd/Server.hs
index ee837c163..9b41e69c4 100644
--- a/htools/Ganeti/Confd/Server.hs
+++ b/htools/Ganeti/Confd/Server.hs
@@ -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
- onReloadTimer inotiaction path cref state
- else -- the inotify watch has been re-established, we can exit
- return ()
+ when continue $
+ do threadDelay configReloadRatelimit
+ onReloadTimer inotiaction path cref state
+ -- 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,
diff --git a/htools/Ganeti/Config.hs b/htools/Ganeti/Config.hs
index 139c45018..0a55b574d 100644
--- a/htools/Ganeti/Config.hs
+++ b/htools/Ganeti/Config.hs
@@ -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)]
diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs
index c6708f13f..d6ce50b40 100644
--- a/htools/Ganeti/Daemon.hs
+++ b/htools/Ganeti/Daemon.hs
@@ -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"
diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs
index 9500aeafa..5d325dc2f 100644
--- a/htools/Ganeti/HTools/Cluster.hs
+++ b/htools/Ganeti/HTools/Cluster.hs
@@ -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
diff --git a/htools/Ganeti/HTools/ExtLoader.hs b/htools/Ganeti/HTools/ExtLoader.hs
index bd258f5f3..797a66f5a 100644
--- a/htools/Ganeti/HTools/ExtLoader.hs
+++ b/htools/Ganeti/HTools/ExtLoader.hs
@@ -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
diff --git a/htools/Ganeti/HTools/IAlloc.hs b/htools/Ganeti/HTools/IAlloc.hs
index 3142755a1..6488b0c57 100644
--- a/htools/Ganeti/HTools/IAlloc.hs
+++ b/htools/Ganeti/HTools/IAlloc.hs
@@ -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\
diff --git a/htools/Ganeti/HTools/Program/Hail.hs b/htools/Ganeti/HTools/Program/Hail.hs
index 4fc016a0a..e701777e1 100644
--- a/htools/Ganeti/HTools/Program/Hail.hs
+++ b/htools/Ganeti/HTools/Program/Hail.hs
@@ -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"
diff --git a/htools/Ganeti/HTools/Program/Hbal.hs b/htools/Ganeti/HTools/Program/Hbal.hs
index 19880a768..8dc5bdd17 100644
--- a/htools/Ganeti/HTools/Program/Hbal.hs
+++ b/htools/Ganeti/HTools/Program/Hbal.hs
@@ -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"
diff --git a/htools/Ganeti/HTools/Program/Hcheck.hs b/htools/Ganeti/HTools/Program/Hcheck.hs
index b322ce7b3..6b0da7d00 100644
--- a/htools/Ganeti/HTools/Program/Hcheck.hs
+++ b/htools/Ganeti/HTools/Program/Hcheck.hs
@@ -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
diff --git a/htools/Ganeti/HTools/Program/Hscan.hs b/htools/Ganeti/HTools/Program/Hscan.hs
index 9a8feda47..5c89de90a 100644
--- a/htools/Ganeti/HTools/Program/Hscan.hs
+++ b/htools/Ganeti/HTools/Program/Hscan.hs
@@ -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
diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index 5bf17d675..6f2c8a8de 100644
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -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)
diff --git a/htools/Ganeti/HTools/Rapi.hs b/htools/Ganeti/HTools/Rapi.hs
index 710bfbb6f..87265e12a 100644
--- a/htools/Ganeti/HTools/Rapi.hs
+++ b/htools/Ganeti/HTools/Rapi.hs
@@ -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'.
diff --git a/htools/Ganeti/HTools/Simu.hs b/htools/Ganeti/HTools/Simu.hs
index 890eae11d..ec8b8b634 100644
--- a/htools/Ganeti/HTools/Simu.hs
+++ b/htools/Ganeti/HTools/Simu.hs
@@ -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))
diff --git a/htools/Ganeti/HTools/Text.hs b/htools/Ganeti/HTools/Text.hs
index 3b4bece07..d0f5e24a7 100644
--- a/htools/Ganeti/HTools/Text.hs
+++ b/htools/Ganeti/HTools/Text.hs
@@ -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
diff --git a/htools/Ganeti/HTools/Utils.hs b/htools/Ganeti/HTools/Utils.hs
index 2b21518c4..0efe7fe85 100644
--- a/htools/Ganeti/HTools/Utils.hs
+++ b/htools/Ganeti/HTools/Utils.hs
@@ -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.
diff --git a/htools/Ganeti/Hash.hs b/htools/Ganeti/Hash.hs
index 56d6601ed..1b0b4f66b 100644
--- a/htools/Ganeti/Hash.hs
+++ b/htools/Ganeti/Hash.hs
@@ -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
diff --git a/htools/Ganeti/Logging.hs b/htools/Ganeti/Logging.hs
index c71775730..0cc3dd61e 100644
--- a/htools/Ganeti/Logging.hs
+++ b/htools/Ganeti/Logging.hs
@@ -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
diff --git a/htools/Ganeti/Luxi.hs b/htools/Ganeti/Luxi.hs
index 72e5fc153..f9eacab0d 100644
--- a/htools/Ganeti/Luxi.hs
+++ b/htools/Ganeti/Luxi.hs
@@ -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
diff --git a/htools/Ganeti/Rpc.hs b/htools/Ganeti/Rpc.hs
index ac9830313..48c6d2b58 100644
--- a/htools/Ganeti/Rpc.hs
+++ b/htools/Ganeti/Rpc.hs
@@ -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.
diff --git a/htools/Ganeti/Ssconf.hs b/htools/Ganeti/Ssconf.hs
index 39a3d95df..cc3639561 100644
--- a/htools/Ganeti/Ssconf.hs
+++ b/htools/Ganeti/Ssconf.hs
@@ -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)
diff --git a/htools/lint-hints.hs b/htools/lint-hints.hs
index 8c9828a42..ebb1fc1fc 100644
--- a/htools/lint-hints.hs
+++ b/htools/lint-hints.hs
@@ -1,3 +1,12 @@
+{- 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)
--
GitLab