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)

src/Distribution/Server/Features/Browse/ApplyFilter.hs

@@ -28,8 +28,7 @@ applyFilter now isSearch coreResource userResource tagsResource DistroFeature{qu
  packages <- filterM filterForItem items
  pure $
    map packageIndexInfoToValue $
-   sort isSearch (boSort browseOptions) $
-   packages
+   sort isSearch (boSort browseOptions) packages
  where
   packageIndexInfoToValue :: PackageItem -> Value
   packageIndexInfoToValue PackageItem{..} =
@@ -85,7 +84,7 @@ applyFilter now isSearch coreResource userResource tagsResource DistroFeature{qu
 
   filterForItem :: PackageItem -> IO Bool
   filterForItem item =
-    all id <$> traverse (includeItem item) filtersWithDefaults
+    and <$> traverse (includeItem item) filtersWithDefaults
 
 sort :: IsSearch -> Sort -> [PackageItem] -> [PackageItem]
 sort isSearch Sort {sortColumn, sortDirection} =

src/Distribution/Server/Features/BuildReports/State.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE DeriveDataTypeable, TypeFamilies, TemplateHaskell,
              FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
-             TypeOperators, TypeSynonymInstances #-}
+             TypeOperators #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Distribution.Server.Features.BuildReports.State where
 
@@ -67,7 +67,7 @@ setFailStatus pkgid status = do
     let reports = BuildReports.setFailStatus pkgid status buildReports
     State.put reports
 
-resetFailCount :: PackageId -> Update BuildReports (Bool)
+resetFailCount :: PackageId -> Update BuildReports Bool
 resetFailCount pkgid = do
     buildReports <- State.get
     case BuildReports.resetFailCount pkgid buildReports of

src/Distribution/Server/Features/Core.hs

@@ -502,7 +502,7 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
     -- Queries
     --
     queryGetPackageIndex :: MonadIO m => m (PackageIndex PkgInfo)
-    queryGetPackageIndex = return . packageIndex =<< queryState packagesState GetPackagesState
+    queryGetPackageIndex = packageIndex <$> queryState packagesState GetPackagesState
 
     queryGetIndexTarballInfo :: MonadIO m => m IndexTarballInfo
     queryGetIndexTarballInfo = readAsyncCache cacheIndexTarball
@@ -753,11 +753,11 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
     deauth _ = do
       return $ (toResponse ("<script>window.location='/'</script>"::String)) {
           rsCode = 401
-        , rsHeaders   = mkHeaders ([("Content-Type",  "text/html")])
+        , rsHeaders   = mkHeaders [("Content-Type",  "text/html")]
       }
 
 packageExists, packageIdExists :: (Package pkg, Package pkg') => PackageIndex pkg -> pkg' -> Bool
 -- | Whether a package exists in the given package index.
 packageExists   pkgs pkg = not . null $ PackageIndex.lookupPackageName pkgs (packageName pkg)
 -- | Whether a particular package version exists in the given package index.
-packageIdExists pkgs pkg = maybe False (const True) $ PackageIndex.lookupPackageId pkgs (packageId pkg)
+packageIdExists pkgs pkg = isJust $ PackageIndex.lookupPackageId pkgs (packageId pkg)

src/Distribution/Server/Features/Core/Backup.hs

@@ -292,7 +292,7 @@ forceLast :: BS.ByteString -> BS.ByteString
 forceLast = BS.fromChunks . forceLastBlock . BS.toChunks
   where
     forceLastBlock []     = []
-    forceLastBlock (c:[]) = c : []
+    forceLastBlock [c]    = [c]
     forceLastBlock (c:cs) = c : forceLastBlock cs
 
 --------------------------------------------------------------------------------

src/Distribution/Server/Features/Distro.hs

@@ -115,10 +115,10 @@ distroFeature UserFeature{..}
 
     textEnumDistros _ = fmap (toResponse . intercalate ", " . map display) (queryState distrosState EnumerateDistros)
     textDistroPkgs dpath = withDistroPath dpath $ \dname pkgs -> do
-        let pkglines = map (\(name, info) -> display name ++ " at " ++ display (distroVersion info) ++ ": " ++ distroUrl info) $ pkgs
+        let pkglines = map (\(name, info) -> display name ++ " at " ++ display (distroVersion info) ++ ": " ++ distroUrl info) pkgs
         return $ toResponse (unlines $ ("Packages for " ++ display dname):pkglines)
     csvDistroPackageList dpath = withDistroPath dpath $ \_dname pkgs -> do
-        return $ toResponse $ packageListToCSV $ pkgs
+        return $ toResponse $ packageListToCSV pkgs
     textDistroPkg dpath = withDistroPackagePath dpath $ \_ _ info -> return . toResponse $ show info
 
     -- result: see-other uri, or an error: not authenticated or not found (todo)
@@ -127,7 +127,7 @@ distroFeature UserFeature{..}
         guardAuthorised_ [InGroup adminGroup] --TODO: use the per-distro maintainer groups
         -- should also check for existence here of distro here
         void $ updateState distrosState $ RemoveDistro distro
-        seeOther ("/distros/") (toResponse ())
+        seeOther "/distros/" (toResponse ())
 
     -- result: ok response or not-found error
     distroPackageDelete dpath =

src/Distribution/Server/Features/Documentation.hs

@@ -14,7 +14,7 @@ import Distribution.Server.Features.Users
 import Distribution.Server.Features.Core
 import Distribution.Server.Features.TarIndexCache
 import Distribution.Server.Features.BuildReports
-import Distribution.Version ( Version )
+import Distribution.Version (Version, nullVersion)
 
 import Distribution.Server.Framework.BackupRestore
 import qualified Distribution.Server.Framework.ResponseContentTypes as Resource
@@ -29,7 +29,6 @@ import qualified Codec.Archive.Tar.Check as Tar
 
 import Distribution.Text
 import Distribution.Package
-import Distribution.Version (nullVersion)
 import qualified Distribution.Parsec as P
 
 import qualified Data.ByteString.Char8 as C
@@ -113,7 +112,7 @@ documentationStateComponent name stateDir = do
     }
   where
     dumpBackup doc =
-        let exportFunc (pkgid, blob) = BackupBlob ([display pkgid, "documentation.tar"]) blob
+        let exportFunc (pkgid, blob) = BackupBlob [display pkgid, "documentation.tar"] blob
         in map exportFunc . Map.toList $ documentation doc
 
     updateDocumentation :: Documentation -> RestoreBackup Documentation
@@ -227,7 +226,7 @@ documentationFeature name
         parseVersion' (Just k) = P.simpleParsec k
 
         parsePkgs :: String -> [PackageIdentifier]
-        parsePkgs pkgsStr = map fromJust $ filter isJust $ map (P.simpleParsec . C.unpack) $ C.split ',' (C.pack pkgsStr)
+        parsePkgs pkgsStr = mapMaybe (P.simpleParsec . C.unpack) (C.split ',' (C.pack pkgsStr))
 
         isSelectedPackage pkgid pkgid'@(PackageIdentifier _ v)
             | nullVersion == v =