Turn on, and fix, more warnings

The Makefile was intented to be -Wall and not simply -W, but I missed
that. This enables more warnings and also enables -Werror (except for
the tests).

Ganeti/HTools/Cluster.hs

@@ -431,10 +431,10 @@ checkMove nodes_idx disk_moves ini_tbl victims =
         -- iterate over all instances, computing the best move
         best_tbl =
             foldl'
-            (\ step_tbl elem ->
-                 if Instance.snode elem == Node.noSecondary then step_tbl
+            (\ step_tbl em ->
+                 if Instance.snode em == Node.noSecondary then step_tbl
                     else compareTables step_tbl $
-                         checkInstanceMove nodes_idx disk_moves ini_tbl elem)
+                         checkInstanceMove nodes_idx disk_moves ini_tbl em)
             ini_tbl victims
         Table _ _ _ best_plc = best_tbl
     in
@@ -478,9 +478,9 @@ collapseFailures flst =
 -- | Update current Allocation solution and failure stats with new
 -- elements
 concatAllocs :: AllocSolution -> OpResult AllocElement -> AllocSolution
-concatAllocs (flst, succ, sols) (OpFail reason) = (reason:flst, succ, sols)
+concatAllocs (flst, cntok, sols) (OpFail reason) = (reason:flst, cntok, sols)
 
-concatAllocs (flst, succ, osols) (OpGood ns@(nl, _, _)) =
+concatAllocs (flst, cntok, osols) (OpGood ns@(nl, _, _)) =
     let nscore = compCV nl
         -- Choose the old or new solution, based on the cluster score
         nsols = case osols of
@@ -489,7 +489,7 @@ concatAllocs (flst, succ, osols) (OpGood ns@(nl, _, _)) =
                       if oscore < nscore
                       then osols
                       else Just (nscore, ns)
-        nsuc = succ + 1
+        nsuc = cntok + 1
     -- Note: we force evaluation of nsols here in order to keep the
     -- memory profile low - we know that we will need nsols for sure
     -- in the next cycle, so we force evaluation of nsols, since the
@@ -539,11 +539,11 @@ tryReloc nl il xid 1 ex_idx =
         valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes
         valid_idxes = map Node.idx valid_nodes
         sols1 = foldl' (\cstate x ->
-                            let elem = do
+                            let em = do
                                   (mnl, i, _, _) <-
                                       applyMove nl inst (ReplaceSecondary x)
                                   return (mnl, i, [Container.find x mnl])
-                            in concatAllocs cstate elem
+                            in concatAllocs cstate em
                        ) ([], 0, Nothing) valid_idxes
     in return sols1
 

Ganeti/HTools/Luxi.hs

@@ -133,10 +133,10 @@ recvMsg s = do
   let _recv obuf = do
               nbuf <- withTimeout queryTimeout "reading luxi response" $
                       S.recv (socket s) 4096
-              let (msg, rbuf) = break ((==) eOM) (obuf ++ nbuf)
-              (if null rbuf
+              let (msg, remaining) = break ((==) eOM) (obuf ++ nbuf)
+              (if null remaining
                then _recv msg
-               else return (msg, drop 1 rbuf))
+               else return (msg, tail remaining))
   cbuf <- readIORef $ rbuf s
   (msg, nbuf) <- _recv cbuf
   writeIORef (rbuf s) nbuf

Ganeti/HTools/Node.hs

@@ -217,11 +217,11 @@ buildPeers t il =
 
 -- | Assigns an instance to a node as primary without other updates.
 setPri :: Node -> T.Idx -> Node
-setPri t idx = t { plist = idx:plist t }
+setPri t ix = t { plist = ix:plist t }
 
 -- | Assigns an instance to a node as secondary without other updates.
 setSec :: Node -> T.Idx -> Node
-setSec t idx = t { slist = idx:slist t }
+setSec t ix = t { slist = ix:slist t }
 
 -- | Add primary cpus to a node
 addCpus :: Node -> Int -> Node

Ganeti/HTools/QC.hs

@@ -88,11 +88,11 @@ instance Arbitrary Node.Node where
       return n'
 
 -- | Make sure add is idempotent
-prop_PeerMap_addIdempotent pmap key elem =
+prop_PeerMap_addIdempotent pmap key em =
     fn puniq == fn (fn puniq)
     where _types = (pmap::PeerMap.PeerMap,
-                    key::PeerMap.Key, elem::PeerMap.Elem)
-          fn = PeerMap.add key elem
+                    key::PeerMap.Key, em::PeerMap.Elem)
+          fn = PeerMap.add key em
           puniq = PeerMap.accumArray const pmap
 
 -- | Make sure remove is idempotent
@@ -109,10 +109,10 @@ prop_PeerMap_findMissing pmap key =
           puniq = PeerMap.accumArray const pmap
 
 -- | Make sure an added item is found
-prop_PeerMap_addFind pmap key elem =
-    PeerMap.find key (PeerMap.add key elem puniq) == elem
+prop_PeerMap_addFind pmap key em =
+    PeerMap.find key (PeerMap.add key em puniq) == em
     where _types = (pmap::PeerMap.PeerMap,
-                    key::PeerMap.Key, elem::PeerMap.Elem)
+                    key::PeerMap.Key, em::PeerMap.Elem)
           puniq = PeerMap.accumArray const pmap
 
 -- | Manual check that maxElem returns the maximum indeed, or 0 for null

Ganeti/HTools/Utils.hs

@@ -81,7 +81,7 @@ meanValue lst = sum lst / fromIntegral (length lst)
 stdDev :: Floating a => [a] -> a
 stdDev lst =
     let mv = meanValue lst
-        av = foldl' (\accu elem -> let d = elem - mv in accu + d * d) 0.0 lst
+        av = foldl' (\accu em -> let d = em - mv in accu + d * d) 0.0 lst
         bv = sqrt (av / fromIntegral (length lst))
     in bv
 

Makefile

@@ -5,7 +5,7 @@ HDDIR = apidoc
 
 DOCS = README.html NEWS.html
 
-HFLAGS = -O2 -W -fwarn-monomorphism-restriction -fwarn-tabs
+HFLAGS = -O2 -Wall -Werror -fwarn-monomorphism-restriction -fwarn-tabs
 HEXTRA =
 
 HPCEXCL = --exclude Main --exclude Ganeti.HTools.QC
@@ -17,7 +17,7 @@ all: $(HPROGS)
 $(HALLPROGS): %: %.hs Ganeti/HTools/Version.hs $(HSRCS) Makefile
 	ghc --make $(HFLAGS) $(HEXTRA) $@
 
-test: HEXTRA=-fhpc
+test: HEXTRA=-fhpc -Wwarn
 
 $(DOCS) : %.html : %
 	rst2html $< $@

hail.hs

@@ -47,14 +47,14 @@ options :: [OptType]
 options = [oShowVer, oShowHelp]
 
 processResults :: (Monad m) => Cluster.AllocSolution -> m (String, [Node.Node])
-processResults (fstats, succ, sols) =
+processResults (fstats, successes, sols) =
     case sols of
       Nothing -> fail "No valid allocation solutions"
       Just (best, (_, _, w)) ->
           let tfails = length fstats
               info = printf "successes %d, failures %d,\
                             \ best score: %.8f for node(s) %s"
-                            succ tfails
+                            successes tfails
                             best (intercalate "/" . map Node.name $ w)::String
           in return (info, w)
 
@@ -90,8 +90,8 @@ main = do
       sols = processRequest request >>= processResults
   let (ok, info, rn) =
           case sols of
-            Ok (info, sn) -> (True, "Request successful: " ++ info,
-                                  map ((++ csf) . Node.name) sn)
+            Ok (ginfo, sn) -> (True, "Request successful: " ++ ginfo,
+                                   map ((++ csf) . Node.name) sn)
             Bad s -> (False, "Request failed: " ++ s, [])
       resp = formatResponse ok info rn
   putStrLn resp