From d8925a9fedcf68c7c1d4dda8742c877247050ebc Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 19 Dec 2014 10:12:55 +0200
Subject: [PATCH] Clip package list to 5000 to avoid memory exhaustion

---
 Handler/StackageHome.hs        | 46 +++++++++++++++++++---------------
 templates/stackage-home.hamlet |  6 +++++
 2 files changed, 32 insertions(+), 20 deletions(-)

diff --git a/Handler/StackageHome.hs b/Handler/StackageHome.hs
index 3c3a044..f067719 100644
--- a/Handler/StackageHome.hs
+++ b/Handler/StackageHome.hs
@@ -25,26 +25,32 @@ getStackageHomeR slug = do
     defaultLayout $ do
         setTitle $ toHtml $ stackageTitle stackage
         cachedWidget (20 * 60) ("package-list-" ++ toPathPiece slug) $ do
-            packages' <- handlerToWidget $ runDB $ E.select $ E.from $ \(u,m,p) -> do
-                E.where_ $
-                    (m E.^. MetadataName E.==. u E.^. UploadedName) E.&&.
-                    (m E.^. MetadataName E.==. p E.^. PackageName') E.&&.
-                    (p E.^. PackageStackage E.==. E.val sid)
-                E.orderBy [E.asc $ u E.^. UploadedName]
-                E.groupBy ( u E.^. UploadedName
-                          , m E.^. MetadataSynopsis
-                          )
-                return
-                    ( u E.^. UploadedName
-                    , m E.^. MetadataSynopsis
-                    , E.max_ (p E.^. PackageVersion)
-                    , E.max_ $ E.case_
-                        [ ( p E.^. PackageHasHaddocks
-                          , p E.^. PackageVersion
-                          )
-                        ]
-                        (E.val (Version ""))
-                    )
+            let maxPackages = 5000
+            (packageListClipped, packages') <- handlerToWidget $ runDB $ do
+                packages' <- E.select $ E.from $ \(u,m,p) -> do
+                    E.where_ $
+                        (m E.^. MetadataName E.==. u E.^. UploadedName) E.&&.
+                        (m E.^. MetadataName E.==. p E.^. PackageName') E.&&.
+                        (p E.^. PackageStackage E.==. E.val sid)
+                    E.orderBy [E.asc $ u E.^. UploadedName]
+                    E.groupBy ( u E.^. UploadedName
+                              , m E.^. MetadataSynopsis
+                              )
+                    E.limit maxPackages
+                    return
+                        ( u E.^. UploadedName
+                        , m E.^. MetadataSynopsis
+                        , E.max_ (p E.^. PackageVersion)
+                        , E.max_ $ E.case_
+                            [ ( p E.^. PackageHasHaddocks
+                              , 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) ->
                     ( E.unValue name
                     , fmap unVersion $ E.unValue latestVersion
diff --git a/templates/stackage-home.hamlet b/templates/stackage-home.hamlet
index df2e2ed..bd9f7f8 100644
--- a/templates/stackage-home.hamlet
+++ b/templates/stackage-home.hamlet
@@ -37,6 +37,12 @@ $newline never
 
 <div .container .content>
     <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>
             <thead>
                 <th>Package