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

Clip package list to 5000 to avoid memory exhaustion

Browse Source
This commit is contained in:
Michael Snoyman 2014-12-19 10:12:55 +02:00
parent 3d36e2dc28
commit d8925a9fed
2 changed files with 32 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
Handler/StackageHome.hs
View File

@ -25,26 +25,32 @@ getStackageHomeR slug = do
defaultLayout $ do defaultLayout $ do
setTitle $ toHtml $ stackageTitle stackage setTitle $ toHtml $ stackageTitle stackage
cachedWidget (20 * 60) ("package-list-" ++ toPathPiece slug) $ do cachedWidget (20 * 60) ("package-list-" ++ toPathPiece slug) $ do
packages' <- handlerToWidget $ runDB $ E.select $ E.from $ \(u,m,p) -> do let maxPackages = 5000
E.where_ $ (packageListClipped, packages') <- handlerToWidget $ runDB $ do
(m E.^. MetadataName E.==. u E.^. UploadedName) E.&&. packages' <- E.select $ E.from $ \(u,m,p) -> do
(m E.^. MetadataName E.==. p E.^. PackageName') E.&&. E.where_ $
(p E.^. PackageStackage E.==. E.val sid) (m E.^. MetadataName E.==. u E.^. UploadedName) E.&&.
E.orderBy [E.asc $ u E.^. UploadedName] (m E.^. MetadataName E.==. p E.^. PackageName') E.&&.
E.groupBy ( u E.^. UploadedName (p E.^. PackageStackage E.==. E.val sid)
, m E.^. MetadataSynopsis E.orderBy [E.asc $ u E.^. UploadedName]
) E.groupBy ( u E.^. UploadedName
return , m E.^. MetadataSynopsis
( u E.^. UploadedName )
, m E.^. MetadataSynopsis E.limit maxPackages
, E.max_ (p E.^. PackageVersion) return
, E.max_ $ E.case_ ( u E.^. UploadedName
[ ( p E.^. PackageHasHaddocks , m E.^. MetadataSynopsis
, p E.^. PackageVersion , E.max_ (p E.^. PackageVersion)
) , E.max_ $ E.case_
] [ ( p E.^. PackageHasHaddocks
(E.val (Version "")) , p E.^. PackageVersion
) )
]
(E.val (Version ""))
)
packageCount <- count [PackageStackage ==. sid]
let packageListClipped = packageCount > maxPackages
return (packageListClipped, packages')
let packages = flip map packages' $ \(name, syn, latestVersion, forceNotNull -> mversion) -> let packages = flip map packages' $ \(name, syn, latestVersion, forceNotNull -> mversion) ->
( E.unValue name ( E.unValue name
, fmap unVersion $ E.unValue latestVersion , fmap unVersion $ E.unValue latestVersion

6
templates/stackage-home.hamlet
View File

@ -37,6 +37,12 @@ $newline never
<div .container .content> <div .container .content>
<div .packages> <div .packages>
$if packageListClipped
<p>
Note: due to a large number of packages, not all packages are display.
For a full listing, please see #
<a href=@{SnapshotR slug StackageMetadataR}>the metadata listing
.
<table .table> <table .table>
<thead> <thead>
<th>Package <th>Package