Prototype package pages

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

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")

config/routes

@@ -24,3 +24,4 @@
 /progress/#Int ProgressR GET
 /system SystemR GET
 /haddock/#PackageSetIdent/*Texts HaddockR GET
+/package/#PackageName PackageR GET

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

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