Fix some hlint warnings (#1056)

* Fix some hlint warnings

* Apply review suggestions + tiny bonus fix

Author: jhrcek

exes/BuildClient.hs

@@ -109,7 +109,7 @@ main = topHandler $ do
                        "       hackage-build build [packages] [options]",
                        "       hackage-build stats",
                        "Options:"]
-               mapM_ putStrLn $ strs
+               mapM_ putStrLn strs
                putStrLn $ usageInfo usageHeader buildFlagDescrs
                unless (null strs) exitFailure
         Init uri auxUris -> initialise opts uri auxUris
@@ -339,18 +339,18 @@ infoStats verbosity mDetailedStats pkgIdsHaveDocs = do
 -- NOTE: Expects the same number of columns in every row!
 printTable :: [[String]] -> String
 printTable xss = intercalate "\n"
-               . map (intercalate " ")
+               . map unwords
                . map padCols
                $ xss
   where
     colWidths :: [[Int]]
-    colWidths = map (map length) $ xss
+    colWidths = map (map length) xss
 
     maxColWidths :: [Int]
-    maxColWidths = foldr1 (\xs ys -> map (uncurry max) (zip xs ys)) colWidths
+    maxColWidths = map maximum (transpose colWidths)
 
     padCols :: [String] -> [String]
-    padCols cols = map (uncurry padTo) (zip maxColWidths cols)
+    padCols cols = zipWith padTo maxColWidths cols
 
     padTo :: Int -> String -> String
     padTo len str = str ++ replicate (len - length str) ' '
@@ -401,7 +401,7 @@ getDocumentationStats verbosity opts config pkgs = do
                                   False -> return Nothing
       mPackages   <- fmap parseJsonStats <$> requestGET' (packagesUri False curGhcVersion)
       mCandidates <- fmap parseJsonStats <$> requestGET' (packagesUri True curGhcVersion)
-      liftIO $ putStrLn $ show curGhcVersion
+      liftIO $ print curGhcVersion
       case (mPackages, mCandidates) of
         -- Download failure
         (Nothing, _) -> fail $ "Could not download " ++ show (packagesUri False curGhcVersion)
@@ -426,9 +426,9 @@ getDocumentationStats verbosity opts config pkgs = do
       hClose moutput
       handler <- openFile dirloc ReadWriteMode
       contents <- hGetContents handler
-      let res     = read contents :: [(String, String)]
-          version' = fmap (\(_,b) -> b) $ find (\(a,_)-> a=="Project version") res
-      return $ version'
+      let res      = read contents :: [(String, String)]
+          version' = lookup "Project version" res
+      return version'
 
     getQry :: [PackageIdentifier] -> String
     getQry [] = ""
@@ -576,7 +576,7 @@ processPkg verbosity opts config docInfo = do
     coverageFile <- mapM (coveragePackage verbosity opts docInfo) hpcLoc
 
     -- Modify test-outcome and rewrite report file.
-    mapM (setTestStatus mRpt buildReport) testOutcome
+    mapM_ (setTestStatus mRpt buildReport) testOutcome
 
     case bo_dryRun opts of
       True -> return ()
@@ -610,7 +610,7 @@ processPkg verbosity opts config docInfo = do
         let buildReport' = fmap (unlines.setTestOutcome testOutcome) $ fmap lines buildReport
         rewriteRpt mRpt buildReport'
 
-coveragePackage :: Verbosity -> BuildOpts -> DocInfo -> FilePath -> IO (FilePath)
+coveragePackage :: Verbosity -> BuildOpts -> DocInfo -> FilePath -> IO FilePath
 coveragePackage verbosity opts docInfo loc = do
   let pkgid = docInfoPackage docInfo
       dir = takeDirectory loc
@@ -886,7 +886,7 @@ putBuildFiles config docInfo reportFile buildLogFile coverageFile installOk = do
     (_, response) <- request Request {
       rqURI     = uri,
       rqMethod  = PUT,
-      rqHeaders = [Header HdrContentType   ("application/json"),
+      rqHeaders = [Header HdrContentType "application/json",
                    Header HdrContentLength (show (BS.length body))],
       rqBody    = body
     }

exes/ImportClient.hs

@@ -119,7 +119,7 @@ main = topHandler $ do
     printHelp help = getProgName >>= putStr . help
     printOptionsList = putStr . unlines
     printErrors errs = do
-      putStr (concat (intersperse "\n" errs))
+      putStr (intercalate "\n" errs)
       exitWith (ExitFailure 1)
     printVersion = putStrLn $ "hackage-import " ++ display Paths.version
 
@@ -408,7 +408,7 @@ importIndex jobs indexFile baseURI = do
          =<< LBS.readFile indexFile
 
     pkgs' <- evaluate (sortBy (comparing fst) pkgs)
-    info $ "Uploading..."
+    info "Uploading..."
 
     concForM_ jobs pkgs' $ \tasks ->
       httpSession $ do
@@ -802,7 +802,7 @@ downloadCountCommand =
   where
     name = "downloads"
     shortDesc = "Import download counts"
-    longDesc  = Just $ \_ -> unlines $ [
+    longDesc  = Just $ \_ -> unlines [
         "Replace the on-disk download statistics with the download statistics"
       , "extracted from Apache log files (in .gz format)"
       ]

exes/Main.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE PatternGuards #-}
-
 module Main where
 
 import qualified Distribution.Server as Server
@@ -44,8 +42,8 @@ import Data.Maybe
          ( isNothing )
 import Data.List
          ( intercalate, isInfixOf )
-import Data.Traversable
-         ( forM )
+import Data.Foldable
+         ( forM_ )
 import Data.Version
          ( showVersion )
 import Control.Monad
@@ -377,7 +375,7 @@ runAction opts = do
           fail $ "Sorry, the server assumes it will be served (or proxied) "
               ++ " via http or https, so cannot use uri scheme " ++ uriScheme uri
         | isNothing (uriAuthority uri) ->
-          fail $ "The base-uri has to include the full host name"
+          fail "The base-uri has to include the full host name"
         | uriPath uri `notElem` ["", "/"] ->
           fail $ "Sorry, the server assumes the base-uri to be at the root of "
               ++ " the domain, so cannot use " ++ uriPath uri
@@ -689,7 +687,7 @@ testBackupCommand =
           flagTestBackupScrubbed (\v flags -> flags { flagTestBackupScrubbed = v })
           (noArg (Flag True))
       , option [] ["features"]
-          ("Only test the specified features")
+          "Only test the specified features"
           flagTestBackupFeatures (\v flags -> flags { flagTestBackupFeatures = v })
           (reqArgFlag "FEATURES")
       ]
@@ -920,7 +918,7 @@ withServer config doTemp = bracket initialise shutdown
       loginfo verbosity "Initializing happstack-state..."
       server <- Server.initialise config
       loginfo verbosity "Server data loaded into memory"
-      void $ forM mtemp $ \temp -> do
+      forM_ mtemp $ \temp -> do
         loginfo verbosity "Tearing down temp server"
         Server.tearDownTemp temp
       return server

exes/MirrorClient.hs

@@ -126,7 +126,7 @@ mirrorOnce verbosity opts
               ignoreCount   = length pkgsToMirror - mirrorCount
 
           if mirrorCount == 0
-            then liftIO $ notice verbosity $ "No packages to mirror"
+            then liftIO $ notice verbosity "No packages to mirror"
             else do
               liftIO $ notice verbosity $
                   show mirrorCount ++ " packages to mirror."

src/Distribution/Client.hs

@@ -100,7 +100,7 @@ data PkgIndexInfo = PkgIndexInfo
 downloadIndex :: URI -> FilePath -> HttpSession [PkgIndexInfo]
 downloadIndex uri | isOldHackageURI uri = downloadOldIndex uri
                   | otherwise           = downloadNewIndex uri
-  where
+
 
 isOldHackageURI :: URI -> Bool
 isOldHackageURI uri

src/Distribution/Client/Mirror/Repo/Secure.hs

@@ -187,12 +187,12 @@ finalizeLocalMirror' cache repoRoot = (`runContT` return) $ do
       let (dir, template) = splitFileName dst
       bracket (openBinaryTempFileWithDefaultPermissions dir template)
               (\(temp, h) -> ignoreIOErrors (hClose h >> removeFile temp)) $
-              (\(temp, h) -> do
+               \(temp, h) -> do
                  BS.L.hPut h =<< BS.L.readFile src
                  hClose h
                  a <- callback ()
                  renameFile temp dst
-                 return a)
+                 return a
 
     ignoreIOErrors :: IO () -> IO ()
     ignoreIOErrors = handle $ \(_ :: IOException) -> return ()

src/Distribution/Client/Mirror/State.hs

@@ -11,7 +11,7 @@ module Distribution.Client.Mirror.State (
 -- stdlib
 import Control.Exception
 import Control.Monad
-import Data.Maybe (catMaybes)
+import Data.Maybe (mapMaybe)
 import Data.Set (Set)
 import Network.URI
 import System.Directory
@@ -115,7 +115,7 @@ readPkgProblemFile file = do
   exists <- doesFileExist file
   if exists
     then evaluate . Set.fromList
-                  . catMaybes . map simpleParse . lines
+                  . mapMaybe simpleParse . lines
                 =<< readFile file
     else return Set.empty
 

src/Distribution/Server.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
 module Distribution.Server (
     -- * Server control
     Server(..),
@@ -287,7 +287,7 @@ initState server (admin, pass) = do
         Nothing -> fail "Couldn't parse admin name (should be alphanumeric)"
     case muid of
         Right uid -> Group.addUserToGroup adminGroup uid
-        Left Users.ErrUserNameClash -> fail $ "Inconceivable!! failed to create admin user"
+        Left Users.ErrUserNameClash -> fail "Inconceivable!! failed to create admin user"
 
 -- The top-level server part.
 -- It collects resources from Distribution.Server.Features, collects
@@ -341,7 +341,7 @@ setUpTemp sconf secs = do
         -- cost to it
         threadDelay $ secs*1000000
         -- could likewise specify a mirror to redirect to for tarballs, and 503 for everything else
-        runServer listenOn $ (resp 503 $ setHeader "Content-Type" "text/html" $ toResponse html503)
+        runServer listenOn $ resp 503 $ setHeader "Content-Type" "text/html" $ toResponse html503
     return (TempServer tid)
   where listenOn = confListenOn sconf
 
@@ -362,4 +362,4 @@ tearDownTemp :: TempServer -> IO ()
 tearDownTemp (TempServer tid) = do
     killThread tid
     -- give the server enough time to release the bind
-    threadDelay $ 1000000
+    threadDelay 1000000

src/Distribution/Server/Features/AdminLog.hs

@@ -14,7 +14,7 @@ import Distribution.Server.Features.Users
 
 import Data.SafeCopy (base, deriveSafeCopy)
 import Data.Typeable
-import Data.Maybe(catMaybes)
+import Data.Maybe(mapMaybe)
 import Control.Monad.Reader
 import qualified Control.Monad.State as State
 import Data.Time (UTCTime)
@@ -161,7 +161,7 @@ restoreAdminLogBackup =
 
 importLogs :: AdminLog -> BS.ByteString -> AdminLog
 importLogs (AdminLog ls) =
-    AdminLog . (++ls) . catMaybes . map fromRecord . lines . unpackUTF8
+    AdminLog . (++ls) . mapMaybe fromRecord . lines . unpackUTF8
   where
     fromRecord :: String -> Maybe (UTCTime,UserId,AdminAction,BS.ByteString)
     fromRecord = readMaybe

src/Distribution/Server/Features/Browse.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE BlockArguments, NamedFieldPuns, TupleSections #-}
+{-# LANGUAGE BlockArguments, NamedFieldPuns #-}
 module Distribution.Server.Features.Browse (initBrowseFeature, PaginationConfig(..), StartIndex(..), NumElems(..), paginate) where
 
 import Control.Arrow (left)