Fix some hlint warnings - part 2

exes/BuildClient.hs

@@ -396,7 +396,7 @@ getDocumentationStats :: Verbosity
 getDocumentationStats verbosity opts config pkgs = do
     notice verbosity "Downloading documentation index"
     httpSession verbosity "hackage-build" version $ do
-      curGhcVersion <- liftIO $ case (bo_buildOlderGHC opts) of
+      curGhcVersion <- liftIO $ case bo_buildOlderGHC opts of
                                   True -> getGHCversion
                                   False -> return Nothing
       mPackages   <- fmap parseJsonStats <$> requestGET' (packagesUri False curGhcVersion)

src/Distribution/Client.hs

@@ -140,8 +140,7 @@ downloadOldIndex uri cacheDir = do
     logFile   = cacheDir </> "log"
 
     mergeLogInfo pkgids theLog =
-        catMaybes
-      . map selectDetails
+        mapMaybe selectDetails
       $ mergeBy (\pkgid entry -> compare pkgid (entryPkgId entry))
                 (sort pkgids)
                 ( map (maximumBy (comparing entryTime))

src/Distribution/Client/ParseApacheLogs.hs

@@ -26,8 +26,7 @@ logToDownloadCounts =
   . map formatOutput
   . Map.toList
   . accumHist
-  . catMaybes
-  . map ((packageGET >=> parseGET) . parseLine . SBS.concat . LBS.toChunks)
+  . mapMaybe ((packageGET >=> parseGET) . parseLine . SBS.concat . LBS.toChunks)
   . LBS.lines
 
 data LogLine = LogLine {

src/Distribution/Server/Features/AdminFrontend.hs

@@ -1,6 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE NamedFieldPuns, RecordWildCards, BangPatterns,
-             StandaloneDeriving, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
 module Distribution.Server.Features.AdminFrontend (
     initAdminFrontendFeature
   ) where

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

@@ -89,7 +89,6 @@ import Text.StringTemplate ()
 import Text.StringTemplate.Classes
          ( SElem(..), ToSElem(..) )
 
-import Data.String (fromString)
 import Data.Aeson
 import Data.Functor.Identity (Identity)
 import Data.List
@@ -607,10 +606,10 @@ data BuildFiles = BuildFiles {
 instance Data.Aeson.FromJSON BuildFiles where
   parseJSON = withObject "buildFiles" $ \o ->
     BuildFiles
-      <$> o .:? fromString "report"
-      <*> o .:? fromString "log"
-      <*> o .:? fromString "coverage"
-      <*> o .: fromString "buildFail"
+      <$> o .:? "report"
+      <*> o .:? "log"
+      <*> o .:? "coverage"
+      <*> o .: "buildFail"
 
 instance Data.Aeson.ToJSON BuildFiles where
   toJSON p = object [
@@ -631,21 +630,21 @@ instance Data.Aeson.ToJSON PkgDetails where
   toJSON p = object [
     "pkgid"      .= (DT.display $ pkid p::String),
     "docs"       .= docs p,
-    "failCnt"    .= failCnt  p,
-    "buildTime"  .= buildTime  p,
-    "ghcId"     .= (k $ ghcId p) ]
+    "failCnt"    .= failCnt p,
+    "buildTime"  .= buildTime p,
+    "ghcId"      .= k (ghcId p) ]
     where
       k (Just a) = Just $ DT.display a
       k Nothing = Nothing
 
 instance Data.Aeson.FromJSON PkgDetails where
   parseJSON = withObject "pkgDetails" $ \o ->
     PkgDetails
-      <$> ((\k -> maybe (fail $ "failed to parse "<>k) pure $ P.simpleParsec k) =<< (o .: (fromString "pkgid")))
-      <*> o .: fromString "docs"
-      <*> o .:? fromString "failCnt"
-      <*> o .:? fromString "buildTime"
-      <*> fmap parseVersion (o .:? (fromString "ghcId"))
+      <$> ((\k -> maybe (fail $ "failed to parse "<>k) pure $ P.simpleParsec k) =<< (o .: "pkgid"))
+      <*> o .: "docs"
+      <*> o .:? "failCnt"
+      <*> o .:? "buildTime"
+      <*> fmap parseVersion (o .:? "ghcId")
     where
       parseVersion :: Maybe String -> Maybe Version
       parseVersion Nothing = Nothing

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

@@ -89,8 +89,8 @@ data PkgBuildReports = PkgBuildReports {
     buildStatus :: !BuildStatus
 } deriving (Eq, Typeable, Show)
 
-data BuildReports = BuildReports {
-    reportsIndex :: !(Map.Map PackageId PkgBuildReports)
+newtype BuildReports = BuildReports {
+    reportsIndex :: Map.Map PackageId PkgBuildReports
 } deriving (Eq, Typeable, Show)
 
 emptyPkgReports :: PkgBuildReports
@@ -331,8 +331,8 @@ instance Serialize BuildReports_v0 where
     put (BuildReports_v0 index) = Serialize.put index
     get = BuildReports_v0 <$> Serialize.get
 
-data BuildReports_v2 = BuildReports_v2
-  { reportsIndex_v2 :: !(Map.Map PackageId PkgBuildReports_v2)
+newtype BuildReports_v2 = BuildReports_v2
+  { reportsIndex_v2 :: Map.Map PackageId PkgBuildReports_v2
   } deriving (Eq, Typeable, Show)
 
 instance Migrate BuildReports_v2 where

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

@@ -7,7 +7,6 @@ module Distribution.Server.Features.BuildReports.Render
 import Distribution.Server.Framework
 
 import Distribution.Server.Features.BuildReports
-import Distribution.Server.Features.BuildReports.BuildReports (BuildReportId)
 import Distribution.Server.Features.BuildReports.BuildReport (BuildReport(..), InstallOutcome(..), Outcome(..))
 import Distribution.Server.Features.Documentation
 

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

@@ -312,7 +312,7 @@ data TarIndexEntry_v0 =
 
 deriveSafeCopy 0 'base ''TarIndexEntry_v0
 
-data PackagesState_v0 = PackagesState_v0 !(PackageIndex PkgInfo)
+newtype PackagesState_v0 = PackagesState_v0 (PackageIndex PkgInfo)
 
 deriveSafeCopy 0 'base ''PackagesState_v0
 

src/Distribution/Server/Features/Distro/Types.hs

@@ -41,8 +41,8 @@ instance Parsec DistroName where
   parsec = DistroName <$> P.munch1 (\c -> Char.isAlphaNum c || c `elem` "-_()[]{}=$,;")
 
 -- | Listing of known distributions and their maintainers
-data Distributions = Distributions {
-    nameMap :: !(Map.Map DistroName UserIdSet)
+newtype Distributions = Distributions {
+    nameMap :: Map.Map DistroName UserIdSet
 }
  deriving (Eq, Typeable, Show)
 

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

@@ -16,8 +16,8 @@ import qualified Control.Monad.State as State
 import qualified Data.Map as Map
 
 ---------------------------------- Documentation
-data Documentation = Documentation {
-     documentation :: !(Map.Map PackageIdentifier BlobId)
+newtype Documentation = Documentation {
+     documentation :: Map.Map PackageIdentifier BlobId
    } deriving (Typeable, Show, Eq)
 
 deriveSafeCopy 0 'base ''Documentation

src/Distribution/Server/Features/EditCabalFiles.hs

@@ -1,5 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE NamedFieldPuns, RecordWildCards, BangPatterns #-}
+{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
 module Distribution.Server.Features.EditCabalFiles (
     initEditCabalFilesFeature
 

src/Distribution/Server/Features/HoogleData.hs

@@ -1,6 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, TypeFamilies, TemplateHaskell,
-             RankNTypes, NamedFieldPuns, RecordWildCards,
-             RecursiveDo, BangPatterns, CPP #-}
+{-# LANGUAGE TypeFamilies, RankNTypes, NamedFieldPuns, RecordWildCards, CPP #-}
 module Distribution.Server.Features.HoogleData (
     initHoogleDataFeature,
     HoogleDataFeature(..),

src/Distribution/Server/Features/Html/HtmlUtilities.hs

@@ -85,8 +85,8 @@ htmlUtilities CoreFeature{coreResource}
             addns = toStr $ fst revTags
             delns = toStr $ snd revTags
             disp = thediv ! [theclass "box"] << [ paragraph << [bold $ toHtml "Current Tags: ", toHtml tagsStr, br]
-                                                , paragraph << [bold $ toHtml "Additions to be reviewed: ", toHtml $ if (addns /= "") then addns else "None", br]
-                                                , paragraph << [bold $ toHtml "Deletions to be reviewed: ", toHtml $ if (delns /= "") then delns else "None", br]
+                                                , paragraph << [bold $ toHtml "Additions to be reviewed: ", toHtml $ if addns /= "" then addns else "None", br]
+                                                , paragraph << [bold $ toHtml "Deletions to be reviewed: ", toHtml $ if delns /= "" then delns else "None", br]
                                                 ]
         in
             [ big $ bold $ toHtml $ display pkgname

src/Distribution/Server/Features/PackageCandidates.hs

@@ -494,7 +494,7 @@ candidatesFeature ServerEnv{serverBlobStore = store}
           PackageIndex.Unambiguous [] -> return Nothing -- can this ever occur?
 
           PackageIndex.Ambiguous mps -> do
-            let matchingPackages = concat . map (take 1) $ mps
+            let matchingPackages = concatMap (take 1) mps
             groups <- mapM (liftIO . Group.queryUserGroup . maintainersGroup . packageName) matchingPackages
             if not . any (uid `Group.member`) $ groups
               then return $ Just $ ErrorResponse 403 [] "Publish failed" (caseClash matchingPackages)

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

@@ -26,8 +26,8 @@ data CandidatePackages = CandidatePackages {
   , candidateMigratedPkgTarball :: Bool
   } deriving (Typeable, Show, Eq)
 
-data CandidatePackages_v0 = CandidatePackages_v0 {
-    candidateList_v0 :: !(PackageIndex.PackageIndex CandPkgInfo)
+newtype CandidatePackages_v0 = CandidatePackages_v0 {
+    candidateList_v0 :: PackageIndex.PackageIndex CandPkgInfo
   } deriving (Typeable, Show, Eq)
 
 deriveSafeCopy 0 'base ''CandidatePackages_v0

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

@@ -9,7 +9,7 @@ import Distribution.Package
 import Distribution.Version
 
 import Data.Acid  (Query, Update, makeAcidic)
-import Data.Maybe (isJust, fromMaybe)
+import Data.Maybe (fromMaybe, isNothing)
 import Data.Typeable (Typeable)
 import Control.Arrow (second)
 import Control.Monad (ap)
@@ -46,18 +46,17 @@ consolidateRanges ranges depr =
 data VersionStatus = NormalVersion | DeprecatedVersion | UnpreferredVersion deriving (Show, Typeable, Eq, Ord, Enum)
 
 getVersionStatus :: PreferredInfo -> Version -> VersionStatus
-getVersionStatus info version = case version `elem` deprecatedVersions info of
-    True  -> DeprecatedVersion
-    False -> case maybe True (withinRange version) (sumRange info) of
-        True  -> NormalVersion
-        False -> UnpreferredVersion
+getVersionStatus info version
+    | version `elem` deprecatedVersions info = DeprecatedVersion
+    | maybe True (withinRange version) (sumRange info) = NormalVersion
+    | otherwise = UnpreferredVersion
 
 classifyVersions :: PreferredInfo -> [Version] -> [(Version, VersionStatus)]
 classifyVersions (PreferredInfo [] [] _) = map (flip (,) NormalVersion)
 classifyVersions info = map ((,) `ap` getVersionStatus info)
 
 partitionVersions :: PreferredInfo -> [Version] -> ([Version], [Version], [Version])
-partitionVersions info versions = if (not . isJust $ sumRange info) then (versions, [], []) else go versions
+partitionVersions info versions = if isNothing $ sumRange info then (versions, [], []) else go versions
   where go :: [Version] -> ([Version], [Version], [Version]) -- foldr-type approach
         go (v:vs) = let ~(norm, depr, unpref) = go vs in case getVersionStatus info v of
             NormalVersion -> (v:norm, depr, unpref)

src/Distribution/Server/Features/Search/BM25F.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE RecordWildCards #-}
-
 -- | See:
 --
 -- * \"The Probabilistic Relevance Framework: BM25 and Beyond\"

src/Distribution/Server/Features/Search/DocFeatVals.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Distribution.Server.Features.Search.DocFeatVals (
     DocFeatVals,
     featureValue,

src/Distribution/Server/Features/Search/ExtractDescriptionTerms.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE BangPatterns, NamedFieldPuns, GeneralizedNewtypeDeriving #-}
-
 module Distribution.Server.Features.Search.ExtractDescriptionTerms (
     extractSynopsisTerms,
     extractDescriptionTerms,
@@ -50,7 +48,7 @@ splitTok tok =
         ([],      _:trailing) -> go trailing
         (leading, _:trailing) -> leading : go trailing
         ([],      [])         -> []
-        (leading, [])         -> leading : []
+        (leading, [])         -> [leading]
 
 
 extractDescriptionTerms :: [Text] -> Set Text -> String -> [Text]

src/Distribution/Server/Features/Security.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NamedFieldPuns  #-}
 {-# LANGUAGE BangPatterns    #-}
 
 -- | TUF security features

src/Distribution/Server/Features/ServerIntrospect.hs

@@ -140,7 +140,7 @@ apiDocPageHtml serverFeatures = hackagePage title content
         renderComponents (StaticBranch sdir:cs) =
           let (rest, url) = renderComponents cs
           in ("/" +++ sdir +++ rest, liftM (("/" ++ sdir) ++) url)
-        renderComponents (DynamicBranch leaf:[])
+        renderComponents [DynamicBranch leaf]
           | ResourceFormat _ (Just (StaticBranch _)) <- resourceFormat resource =
               ("/" +++ leaf, Just ("/" ++ leaf))
         renderComponents (DynamicBranch ddir:cs) =
@@ -228,7 +228,7 @@ apiDocJSON serverFeatures = featureList
 
         renderComponents (StaticBranch  sdir:cs) = "/" ++ sdir
                                                        ++ renderComponents cs
-        renderComponents (DynamicBranch leaf:[])
+        renderComponents [DynamicBranch leaf]
           | ResourceFormat _ (Just (StaticBranch _)) <- resourceFormat resource
                                                  = "/" ++ leaf
         renderComponents (DynamicBranch ddir:cs) = "/" ++ ":" ++ ddir

src/Distribution/Server/Features/StaticFiles.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE NamedFieldPuns, RecordWildCards, BangPatterns #-}
+{-# LANGUAGE NamedFieldPuns #-}
 module Distribution.Server.Features.StaticFiles (
     initStaticFilesFeature
   ) where

src/Distribution/Server/Features/Tags.hs

@@ -288,7 +288,6 @@ tagsFeature CoreFeature{ queryGetPackageIndex }
                                     let addTags = Set.fromList aliases `Set.difference` calcTags
                                         delTags = Set.fromList del `Set.intersection` calcTags
                                     void $ updateState tagsState $ InsertReviewTags pkgname addTags delTags
-                                    return ()
                                 else errBadRequest "Authorization Error" [MText "You need to be logged in to propose tags"]
                     _ -> errBadRequest "Tags not recognized" [MText "Couldn't parse your tag list. It should be comma separated with any number of alphanumerical tags. Tags can also also have -+#*."]
           Nothing -> errBadRequest "Tags not recognized" [MText "Couldn't parse your tag list. It should be comma separated with any number of alphanumerical tags. Tags can also also have -+#*."]

src/Distribution/Server/Features/Upload.hs

@@ -352,7 +352,7 @@ uploadFeature ServerEnv{serverBlobStore = store}
                          else return Nothing
 
                 (False,PackageIndex.Ambiguous mps) -> do
-                      let matchingPackages = concat . map (take 1) $ mps
+                      let matchingPackages = concatMap (take 1) mps
                       groups <- mapM (queryUserGroup . maintainersGroup . packageName) matchingPackages
                       if not . any (uid `Group.member`) $ groups
                          then uploadError (caseClash matchingPackages)

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

@@ -102,8 +102,8 @@ makeAcidic ''HackageTrustees ['getHackageTrustees
                              ]
 
 -------------------------------- Uploader list
-data HackageUploaders = HackageUploaders {
-    uploaderList :: !UserIdSet
+newtype HackageUploaders = HackageUploaders {
+    uploaderList :: UserIdSet
 } deriving (Show, Typeable, Eq)
 
 $(deriveSafeCopy 0 'base ''HackageUploaders)

src/Distribution/Server/Features/UserSignup.hs

@@ -361,16 +361,14 @@ userSignupFeature ServerEnv{serverBaseURI, serverCron}
 
     querySignupInfo :: Nonce -> MonadIO m => m (Maybe SignupResetInfo)
     querySignupInfo nonce =
-            queryState signupResetState (LookupSignupResetInfo nonce)
-        >>= return . justSignupInfo
+        justSignupInfo <$> queryState signupResetState (LookupSignupResetInfo nonce)
       where
         justSignupInfo (Just info@SignupInfo{}) = Just info
         justSignupInfo _                        = Nothing
 
     queryResetInfo :: Nonce -> MonadIO m => m (Maybe SignupResetInfo)
     queryResetInfo nonce =
-            queryState signupResetState (LookupSignupResetInfo nonce)
-        >>= return . justResetInfo
+        justResetInfo <$> queryState signupResetState (LookupSignupResetInfo nonce)
       where
         justResetInfo (Just info@ResetInfo{}) = Just info
         justResetInfo _                       = Nothing

src/Distribution/Server/Framework/BlobStorage.hs

@@ -82,7 +82,7 @@ blobETag :: BlobId -> ETag
 blobETag = ETag . blobMd5
 
 readBlobId :: String -> Either String BlobId
-readBlobId = either Left (Right . BlobId) . readDigest
+readBlobId = fmap BlobId . readDigest
 
 instance SafeCopy BlobId where
   version = 2

src/Distribution/Server/Framework/HtmlFormWrapper.hs

@@ -149,7 +149,7 @@ requestFormDataAsJSON = do
     let keyvals = [ (k, v)
                   | (k, Input { inputValue = Right v }) <- fromMaybe [] mbody
                   , case k of '_':_ -> False; _ -> True ]
-        paths   = [ (parsePathTmpl (BS8.unpack v) k)
+        paths   = [ parsePathTmpl (BS8.unpack v) k
                   | (k, v) <- keyvals ]
     case accumJPaths paths of
       Nothing -> return $ Left (zip keyvals paths )

src/Distribution/Server/Packages/Types.hs

@@ -303,7 +303,7 @@ instance Migrate PkgInfo_v1 where
     migrate (PkgInfo_v0 a b c d e) =
       PkgInfo_v1 (migrate a) b
                  [ (migrate (migrate pt), migrateUploadInfo ui) | (pt, ui) <- c ]
-                 [ (cf, (migrateUploadInfo ui)) | (cf, ui) <- d ]
+                 [ (cf, migrateUploadInfo ui) | (cf, ui) <- d ]
                  (migrateUploadInfo e)
       where
         migrateUploadInfo (UTCTime_v0 ts, UserId_v0 uid) = (ts, UserId uid)

src/Distribution/Server/Packages/Unpack.hs

@@ -452,7 +452,7 @@ explainTarError (FutureTimeError entryname time serverTime) =
  ++ "with cabal-install-1.18.0.2 or older have this problem)."
 explainTarError (PermissionsError entryname mode) =
     "The tarball entry " ++ quote entryname ++ " has file permissions that are "
- ++ "broken: " ++ (showMode mode) ++ ". Permissions must be 644 at a minimum "
+ ++ "broken: " ++ showMode mode ++ ". Permissions must be 644 at a minimum "
  ++ "for files and 755 for directories."
   where
     showMode :: Tar.Permissions -> String

src/Distribution/Server/Pages/Package.hs

@@ -236,7 +236,7 @@ renderDetailedDependencies pkgRender =
     list :: [Html] -> Html
     list items = thediv ! [identifier "detailed-dependencies"] << unordList items
 
-    renderComponent :: (CondBranch ConfVar [Dependency] IsBuildable)
+    renderComponent :: CondBranch ConfVar [Dependency] IsBuildable
                     -> Maybe Html
     renderComponent (CondBranch condition then' else')
         | Just thenHtml <- render then' =

src/Distribution/Server/Pages/PackageFromTemplate.hs

@@ -111,8 +111,8 @@ packagePageTemplate render
     , "executables"       $= (commaList . map toHtml $ rendExecNames render)
     , "downloadSection"   $= Old.downloadSection render
     , "stability"         $= renderStability desc
-    , "isDeprecated"      $= (if deprs == Nothing then False else True)
-    , "deprecatedMsg"     $= (deprHtml deprs)
+    , "isDeprecated"      $= isJust deprs
+    , "deprecatedMsg"     $= deprHtml deprs
     ]
   where
     -- Access via "$hackage.varName$"

src/Distribution/Server/Pages/Recent.hs

@@ -145,7 +145,7 @@ recentRevisionsFeed users hostURI now pkgs = RSS
     desc = "The 40 most recent revisions to cabal metadata in Hackage (or last 48 hours worth, whichever is greater), the Haskell package database."
     twoDaysAgo = addUTCTime (negate $ 60 * 60 * 48) now
     pkgListTwoDays = takeWhile (\p -> pkgLatestUploadTime p > twoDaysAgo) pkgs
-    pkgList = if (length pkgListTwoDays > 40) then pkgListTwoDays else take 40 pkgs
+    pkgList = if length pkgListTwoDays > 40 then pkgListTwoDays else take 40 pkgs
     updated = maybe now (fst . pkgOriginalUploadInfo) (listToMaybe pkgList)
 
 channel :: UTCTime -> [RSS.ChannelElem]