diff --git a/exes/BuildClient.hs b/exes/BuildClient.hs index da90a8fbf..f72d6e251 100644 --- a/exes/BuildClient.hs +++ b/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) diff --git a/src/Distribution/Client.hs b/src/Distribution/Client.hs index 27a2e6416..246f61ee7 100644 --- a/src/Distribution/Client.hs +++ b/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)) diff --git a/src/Distribution/Client/ParseApacheLogs.hs b/src/Distribution/Client/ParseApacheLogs.hs index 29fb68037..69685f0bf 100644 --- a/src/Distribution/Client/ParseApacheLogs.hs +++ b/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 { diff --git a/src/Distribution/Server/Features/AdminFrontend.hs b/src/Distribution/Server/Features/AdminFrontend.hs index c05beb549..7c01ccda4 100644 --- a/src/Distribution/Server/Features/AdminFrontend.hs +++ b/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 diff --git a/src/Distribution/Server/Features/BuildReports/BuildReport.hs b/src/Distribution/Server/Features/BuildReports/BuildReport.hs index bae640118..1d85cce5f 100644 --- a/src/Distribution/Server/Features/BuildReports/BuildReport.hs +++ b/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,9 +630,9 @@ 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 @@ -641,11 +640,11 @@ instance Data.Aeson.ToJSON PkgDetails where 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 diff --git a/src/Distribution/Server/Features/BuildReports/Render.hs b/src/Distribution/Server/Features/BuildReports/Render.hs index 39d99cea7..e3464ba90 100644 --- a/src/Distribution/Server/Features/BuildReports/Render.hs +++ b/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 diff --git a/src/Distribution/Server/Features/EditCabalFiles.hs b/src/Distribution/Server/Features/EditCabalFiles.hs index 5f073fa57..6b1154024 100644 --- a/src/Distribution/Server/Features/EditCabalFiles.hs +++ b/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 diff --git a/src/Distribution/Server/Features/HoogleData.hs b/src/Distribution/Server/Features/HoogleData.hs index df5da968c..7c893eea7 100644 --- a/src/Distribution/Server/Features/HoogleData.hs +++ b/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(..), diff --git a/src/Distribution/Server/Features/Html/HtmlUtilities.hs b/src/Distribution/Server/Features/Html/HtmlUtilities.hs index 78256ef12..3c1d616da 100644 --- a/src/Distribution/Server/Features/Html/HtmlUtilities.hs +++ b/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 diff --git a/src/Distribution/Server/Features/PackageCandidates.hs b/src/Distribution/Server/Features/PackageCandidates.hs index 9bb3ba077..d222beb3f 100644 --- a/src/Distribution/Server/Features/PackageCandidates.hs +++ b/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) diff --git a/src/Distribution/Server/Features/PreferredVersions/State.hs b/src/Distribution/Server/Features/PreferredVersions/State.hs index d4c389746..3c4881b1f 100644 --- a/src/Distribution/Server/Features/PreferredVersions/State.hs +++ b/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) diff --git a/src/Distribution/Server/Features/Search/BM25F.hs b/src/Distribution/Server/Features/Search/BM25F.hs index 817bd2e21..7a8c28eea 100644 --- a/src/Distribution/Server/Features/Search/BM25F.hs +++ b/src/Distribution/Server/Features/Search/BM25F.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - -- | See: -- -- * \"The Probabilistic Relevance Framework: BM25 and Beyond\" diff --git a/src/Distribution/Server/Features/Search/DocFeatVals.hs b/src/Distribution/Server/Features/Search/DocFeatVals.hs index 096364276..1a755779d 100644 --- a/src/Distribution/Server/Features/Search/DocFeatVals.hs +++ b/src/Distribution/Server/Features/Search/DocFeatVals.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Distribution.Server.Features.Search.DocFeatVals ( DocFeatVals, featureValue, diff --git a/src/Distribution/Server/Features/Search/ExtractDescriptionTerms.hs b/src/Distribution/Server/Features/Search/ExtractDescriptionTerms.hs index 539d3bd14..24a8334df 100644 --- a/src/Distribution/Server/Features/Search/ExtractDescriptionTerms.hs +++ b/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] diff --git a/src/Distribution/Server/Features/Security.hs b/src/Distribution/Server/Features/Security.hs index 5494b6e98..91a178401 100644 --- a/src/Distribution/Server/Features/Security.hs +++ b/src/Distribution/Server/Features/Security.hs @@ -1,5 +1,4 @@ {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE BangPatterns #-} -- | TUF security features diff --git a/src/Distribution/Server/Features/ServerIntrospect.hs b/src/Distribution/Server/Features/ServerIntrospect.hs index 73b70b339..ec8de5102 100644 --- a/src/Distribution/Server/Features/ServerIntrospect.hs +++ b/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 diff --git a/src/Distribution/Server/Features/StaticFiles.hs b/src/Distribution/Server/Features/StaticFiles.hs index 84261cb72..2ed6832ac 100644 --- a/src/Distribution/Server/Features/StaticFiles.hs +++ b/src/Distribution/Server/Features/StaticFiles.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NamedFieldPuns, RecordWildCards, BangPatterns #-} +{-# LANGUAGE NamedFieldPuns #-} module Distribution.Server.Features.StaticFiles ( initStaticFilesFeature ) where diff --git a/src/Distribution/Server/Features/Tags.hs b/src/Distribution/Server/Features/Tags.hs index 7f15e4c64..6654aac82 100644 --- a/src/Distribution/Server/Features/Tags.hs +++ b/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 -+#*."] diff --git a/src/Distribution/Server/Features/Upload.hs b/src/Distribution/Server/Features/Upload.hs index c63ae5a95..7bb1f7fe8 100644 --- a/src/Distribution/Server/Features/Upload.hs +++ b/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) diff --git a/src/Distribution/Server/Features/UserSignup.hs b/src/Distribution/Server/Features/UserSignup.hs index 4efe78682..24d3c38cb 100644 --- a/src/Distribution/Server/Features/UserSignup.hs +++ b/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 diff --git a/src/Distribution/Server/Framework/BlobStorage.hs b/src/Distribution/Server/Framework/BlobStorage.hs index 461afb75c..3ccf1067f 100644 --- a/src/Distribution/Server/Framework/BlobStorage.hs +++ b/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 diff --git a/src/Distribution/Server/Framework/HtmlFormWrapper.hs b/src/Distribution/Server/Framework/HtmlFormWrapper.hs index 48a968618..2564f6c4a 100644 --- a/src/Distribution/Server/Framework/HtmlFormWrapper.hs +++ b/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 ) diff --git a/src/Distribution/Server/Packages/Types.hs b/src/Distribution/Server/Packages/Types.hs index 54980ed7a..220e90a17 100644 --- a/src/Distribution/Server/Packages/Types.hs +++ b/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) diff --git a/src/Distribution/Server/Packages/Unpack.hs b/src/Distribution/Server/Packages/Unpack.hs index bfa0e3c20..6836ade11 100644 --- a/src/Distribution/Server/Packages/Unpack.hs +++ b/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 diff --git a/src/Distribution/Server/Pages/Package.hs b/src/Distribution/Server/Pages/Package.hs index 32467060b..6bc46205a 100644 --- a/src/Distribution/Server/Pages/Package.hs +++ b/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' = diff --git a/src/Distribution/Server/Pages/PackageFromTemplate.hs b/src/Distribution/Server/Pages/PackageFromTemplate.hs index 091c953c9..d54883fa2 100644 --- a/src/Distribution/Server/Pages/PackageFromTemplate.hs +++ b/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$" diff --git a/src/Distribution/Server/Pages/Recent.hs b/src/Distribution/Server/Pages/Recent.hs index 03abd53c4..708f63a36 100644 --- a/src/Distribution/Server/Pages/Recent.hs +++ b/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] diff --git a/src/Distribution/Server/Util/CabalRevisions.hs b/src/Distribution/Server/Util/CabalRevisions.hs index 6f4633468..f417dee1e 100644 --- a/src/Distribution/Server/Util/CabalRevisions.hs +++ b/src/Distribution/Server/Util/CabalRevisions.hs @@ -690,7 +690,6 @@ changesOkSet what render old new = do logChange (Change Normal ("removed " ++ what) (renderSet removed) "") unless (Set.null added) $ logChange (Change Normal ("added " ++ what) "" (renderSet added)) - return () where added = new Set.\\ old removed = old Set.\\ new diff --git a/src/Distribution/Server/Util/Markdown.hs b/src/Distribution/Server/Util/Markdown.hs index 36db1a0fb..bc8fb84a6 100644 --- a/src/Distribution/Server/Util/Markdown.hs +++ b/src/Distribution/Server/Util/Markdown.hs @@ -47,7 +47,7 @@ instance ToPlainText (HHtml a) where toPlainText (HHtml x) = toPlainText x instance Rangeable (Html a) => Rangeable (HHtml a) where - ranged sr (HHtml x) = (HHtml $ ranged sr x) + ranged sr (HHtml x) = HHtml $ ranged sr x instance (Rangeable (Html a), Rangeable (HHtml a)) => IsInline (HHtml a) where lineBreak = HHtml lineBreak diff --git a/src/Distribution/Server/Util/ServeTarball.hs b/src/Distribution/Server/Util/ServeTarball.hs index eb9507d84..b4391f6d2 100644 --- a/src/Distribution/Server/Util/ServeTarball.hs +++ b/src/Distribution/Server/Util/ServeTarball.hs @@ -129,9 +129,9 @@ loadTarEntry tarfile off = do serveTarEntry :: FilePath -> TarIndex.TarEntryOffset -> FilePath -> IO Response serveTarEntry tarfile off fname = do Right (size, body) <- loadTarEntry tarfile off - return . ((setHeader "Content-Length" (show size)) . - (setHeader "Content-Type" mimeType)) $ - resultBS 200 body + return . setHeader "Content-Length" (show size) + . setHeader "Content-Type" mimeType + $ resultBS 200 body where mimeType = mime fname constructTarIndexFromFile :: FilePath -> IO TarIndex diff --git a/tests/Distribution/Server/Packages/UnpackTest.hs b/tests/Distribution/Server/Packages/UnpackTest.hs index 5db1732f7..1d0fd0e64 100644 --- a/tests/Distribution/Server/Packages/UnpackTest.hs +++ b/tests/Distribution/Server/Packages/UnpackTest.hs @@ -22,7 +22,7 @@ testPermissions :: FilePath -- ^ .tar.gz file to te -> (Tar.Entry -> Maybe CombinedTarErrs) -- ^ Converter to create errors if necessary -> Assertion testPermissions tarPath mangler = do - entries <- return . Tar.read . GZip.decompress =<< BL.readFile tarPath + entries <- Tar.read . GZip.decompress <$> BL.readFile tarPath let mappedEntries = Tar.foldEntries Tar.Next Tar.Done (Tar.Fail . FormatError) entries when (checkEntries mangler mappedEntries /= checkUselessPermissions mappedEntries) $ assertFailure ("Permissions check did not match expected for: " ++ tarPath) diff --git a/tests/HttpUtils.hs b/tests/HttpUtils.hs index 5263dec74..a688efa7d 100644 --- a/tests/HttpUtils.hs +++ b/tests/HttpUtils.hs @@ -136,7 +136,7 @@ execPostFile expectedCode auth req field (filename, fileContents) = req' = setRequestBody req ("multipart/form-data; boundary=" ++ boundary, body) - unlines' = concat . map (++ "\r\n") + unlines' = concatMap (++ "\r\n") body = unlines' [ "--" ++ boundary , "Content-Disposition: form-data; name=" ++ show field ++ "; filename=" ++ show filename