From 639e3110933a0f0994531b9e78b7f8ee31dce276 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 23 Oct 2014 02:29:21 +0300
Subject: [PATCH] Prototype package pages

---
 Application.hs           |  1 +
 Handler/Package.hs       | 27 +++++++++++++++++++++++++++
 config/routes            |  1 +
 stackage-server.cabal    |  1 +
 templates/package.hamlet | 27 +++++++++++++++++++++++++++
 5 files changed, 57 insertions(+)
 create mode 100644 Handler/Package.hs
 create mode 100644 templates/package.hamlet

diff --git a/Application.hs b/Application.hs
index 3362dce..3e09450 100644
--- a/Application.hs
+++ b/Application.hs
@@ -53,6 +53,7 @@ import           Handler.Alias
 import           Handler.Progress
 import           Handler.System
 import           Handler.Haddock
+import           Handler.Package
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
diff --git a/Handler/Package.hs b/Handler/Package.hs
new file mode 100644
index 0000000..0d8a03f
--- /dev/null
+++ b/Handler/Package.hs
@@ -0,0 +1,27 @@
+module Handler.Package where
+
+import Import
+import qualified Database.Esqueleto as E
+import Database.Esqueleto ((^.), (&&.), Value (Value))
+
+getPackageR :: PackageName -> Handler Html
+getPackageR pn = do
+    let maxSnaps = 10
+        asInt :: Int -> Int
+        asInt = id
+        haddocksLink ident version =
+            HaddockR ident [concat [toPathPiece pn, "-", toPathPiece version]]
+    (latestVersion, packages) <- runDB $ do
+        mupload <- selectFirst [UploadedName ==. pn] [Desc UploadedUploaded]
+        Entity _ (Uploaded _ latestVersion _) <- maybe notFound return mupload
+        packages <- E.select $ E.from $ \(p, s) -> do
+            E.where_ $ (p ^. PackageStackage E.==. s ^. StackageId)
+                   &&. (p ^. PackageName' E.==. E.val pn)
+            E.orderBy [E.desc $ s ^. StackageUploaded]
+            E.limit maxSnaps
+            --selectList [PackageName' ==. pn] [LimitTo 10, Desc PackageStackage]
+            return (p ^. PackageVersion, s ^. StackageTitle, s ^. StackageIdent, s ^. StackageHasHaddocks)
+        return (latestVersion, packages)
+    defaultLayout $ do
+        setTitle $ toHtml pn
+        $(widgetFile "package")
diff --git a/config/routes b/config/routes
index f62745c..b0b0637 100644
--- a/config/routes
+++ b/config/routes
@@ -24,3 +24,4 @@
 /progress/#Int ProgressR GET
 /system SystemR GET
 /haddock/#PackageSetIdent/*Texts HaddockR GET
+/package/#PackageName PackageR GET
diff --git a/stackage-server.cabal b/stackage-server.cabal
index 0b139a9..ac93940 100644
--- a/stackage-server.cabal
+++ b/stackage-server.cabal
@@ -42,6 +42,7 @@ library
                      Handler.Progress
                      Handler.System
                      Handler.Haddock
+                     Handler.Package
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT
diff --git a/templates/package.hamlet b/templates/package.hamlet
new file mode 100644
index 0000000..5a0288f
--- /dev/null
+++ b/templates/package.hamlet
@@ -0,0 +1,27 @@
+<div .container>
+    <div .alert .alert-warn>
+        <b>NOTHING TO SEE HERE MOVE ALONG
+        We'll announce when this is ready
+    <h1>#{pn}
+    <h2>Latest uploaded version: #{latestVersion}
+
+    $if null packages
+        <p>Not included in any snapshots
+    $else
+        $if length packages == maxSnaps
+            <h2>Last #{asInt maxSnaps} snapshots included in
+        $else
+            <h2>Snapshots included in
+        <ul>
+            $forall (Value version, Value title, Value ident, Value hasHaddocks) <- packages
+                <li>
+                    <a href=@{StackageHomeR ident}>#{title}
+                    (version #{version})
+                    $if hasHaddocks
+                        <a href=@{haddocksLink ident version}>(haddocks)
+    <h2>FIXME
+    <ul>
+        <li>Make the page look decent
+        <li>Add: tags, upvote/downvote a tag, submit new tags. Tags could be used for stability, category, etc
+        <li>Add: disqus comments
+        <li>Add: vote on package