haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-12 04:08:29 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Improved memory usage

Browse Source
This commit is contained in:
Michael Snoyman 2014-11-17 14:19:20 +02:00
parent f0377d4f26
commit 48185bdf0e
1 changed files with 6 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
Data/Hackage.hs
View File

@ -39,6 +39,8 @@ import Data.Foldable (foldMap)
import qualified Data.Traversable as T import qualified Data.Traversable as T
import qualified Data.Version import qualified Data.Version
import Text.ParserCombinators.ReadP (readP_to_S) import Text.ParserCombinators.ReadP (readP_to_S)
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Blaze.Html (unsafeByteString)
sinkUploadHistory :: Monad m => Consumer (Entity Uploaded) m UploadHistory sinkUploadHistory :: Monad m => Consumer (Entity Uploaded) m UploadHistory
sinkUploadHistory = sinkUploadHistory =
@ -244,6 +246,7 @@ getMetadata name version hash' gpd = do
#else #else
[PD.licenseFile pd] [PD.licenseFile pd]
#endif #endif
let collapseHtml = unsafeByteString . toStrict . renderHtml
return Metadata return Metadata
{ metadataName = name { metadataName = name
, metadataVersion = version , metadataVersion = version
@ -266,9 +269,9 @@ getMetadata name version hash' gpd = do
, metadataExes = length $ PD.executables pd , metadataExes = length $ PD.executables pd
, metadataTestSuites = length $ PD.testSuites pd , metadataTestSuites = length $ PD.testSuites pd
, metadataBenchmarks = length $ PD.benchmarks pd , metadataBenchmarks = length $ PD.benchmarks pd
, metadataReadme = fromMaybe (toHtml $ Textarea $ pack $ PD.description pd) mreadme , metadataReadme = collapseHtml $ fromMaybe (toHtml $ Textarea $ pack $ PD.description pd) mreadme
, metadataChangelog = mchangelog , metadataChangelog = collapseHtml <$> mchangelog
, metadataLicenseContent = mlicenseContent , metadataLicenseContent = collapseHtml <$> mlicenseContent
} }
where where
goTree (PD.CondNode _ deps comps) = concatMap goDep deps ++ concatMap goComp comps goTree (PD.CondNode _ deps comps) = concatMap goDep deps ++ concatMap goComp comps