From 41307c3343d5e9cd895aee13448652054e517d90 Mon Sep 17 00:00:00 2001
From: Chris Done <chrisdone@gmail.com>
Date: Sun, 14 Dec 2014 21:53:00 +0100
Subject: [PATCH] List packages in snapshot page

---
 Handler/StackageHome.hs        | 39 ++++++++++++++++++++++++++-
 templates/stackage-home.hamlet | 48 ++++++++++++++++++++++------------
 templates/stackage-home.lucius | 10 +++++++
 3 files changed, 80 insertions(+), 17 deletions(-)

diff --git a/Handler/StackageHome.hs b/Handler/StackageHome.hs
index 4927049..1286581 100644
--- a/Handler/StackageHome.hs
+++ b/Handler/StackageHome.hs
@@ -23,9 +23,46 @@ getStackageHomeR slug = do
                        then Just False
                        else Nothing
         base = maybe 0 (const 1) minclusive :: Int
+    Entity sid _stackage <- runDB $ getBy404 $ UniqueSnapshot slug
     defaultLayout $ do
         setTitle $ toHtml $ stackageTitle stackage
-        $(widgetFile "stackage-home")
+        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_ $ E.case_
+                        [ ( p E.^. PackageHasHaddocks
+                          , p E.^. PackageVersion
+                          )
+                        ]
+                        (E.val (Version ""))
+                    )
+            let packages = flip map packages' $ \(name, syn, forceNotNull -> mversion) ->
+                    ( E.unValue name
+                    , mversion
+                    , strip $ E.unValue syn
+                    , (<$> mversion) $ \version -> HaddockR slug $ return $ concat
+                        [ toPathPiece $ E.unValue name
+                        , "-"
+                        , version
+                        ]
+                    )
+                forceNotNull (E.Value Nothing) = Nothing
+                forceNotNull (E.Value (Just (Version v)))
+                    | null v = Nothing
+                    | otherwise = Just v
+            $(widgetFile "stackage-home")
+  where strip x = fromMaybe x (stripSuffix "." x)
+        mback = Just (SnapshotR slug StackageHomeR, "Return to snapshot")
 
 getStackageMetadataR :: SnapSlug -> Handler TypedContent
 getStackageMetadataR slug = do
diff --git a/templates/stackage-home.hamlet b/templates/stackage-home.hamlet
index 063c034..f69b085 100644
--- a/templates/stackage-home.hamlet
+++ b/templates/stackage-home.hamlet
@@ -6,25 +6,9 @@ $newline never
         Published on #{yearMonthDay (stackageUploaded stackage)}
         $if hasBundle
            <span .separator>
-           <span>
-               <a href=@{SnapshotR slug StackageMetadataR} title="View metadata on this snapshot, such as package versions">
-                   \Metadata
-           <span .separator>
-           <span>
-               <a href=@{SnapshotR slug StackageBundleR} title="This is useful for making modifications to an existing snapshot">
-                   \Bundle
-           <span .separator>
            <span>
                <a href=@{SnapshotR slug StackageCabalConfigR} title="If you want to stick with upstream Hackage but get a stable package set">
                    \cabal.config
-           <span .separator>
-           <span>
-               <a href=@{SnapshotR slug SnapshotPackagesR} title="List of included packages">
-                   \Packages
-           $if stackageHasHaddocks stackage
-               <span .separator>
-               <span>
-                   <a href=@{HaddockR slug []}>Haddocks
     $if isOwner
         <p>
             You are the owner of this snapshot. You can #
@@ -148,3 +132,35 @@ $newline never
 
             <p>
                 Now you're ready to install packages!
+
+    <h3>
+        Packages
+
+<div .container .content>
+    <div .packages>
+        <table .table>
+            <thead>
+                <th>Package
+                <th>Docs
+                <th>Synopsis
+            <tbody>
+                $forall (name,mversion,synopsis,mdoc) <- packages
+                    <tr>
+                        <td>
+                            <a href=@{PackageR name}>
+                                #{name}
+                                $maybe version <- mversion
+                                    -#{asText version}
+                        <td>
+                            $maybe doc <- mdoc
+                                <a href=@{doc}>Docs
+                        <td>
+                            #{synopsis}
+
+
+<div .container>
+    <p .bottom-links>
+        $if hasBundle
+           <span>
+               <a href=@{SnapshotR slug StackageBundleR} title="This is useful for making modifications to an existing snapshot">
+                   \Bundle
diff --git a/templates/stackage-home.lucius b/templates/stackage-home.lucius
index ee8cc5b..0bd7e2a 100644
--- a/templates/stackage-home.lucius
+++ b/templates/stackage-home.lucius
@@ -67,3 +67,13 @@ h3 > small {
 p + ul {
   margin-top: 1em;
 }
+
+.bottom-links {
+  margin-top: 0.5em;
+  border-top: 1px solid #ddd;
+  padding-top: 0.5em;
+}
+
+.packages > .table td,.packages > .table th {
+  padding-left: 0;
+}