Snapshot list

Handler/Snapshots.hs

@@ -3,10 +3,10 @@
 module Handler.Snapshots where
 
 import           Data.Time.Clock
-import qualified Database.Esqueleto as E
 import           Formatting
 import           Formatting.Time
 import           Import
+import Stackage.Database
 
 snapshotsPerPage :: Integral a => a
 snapshotsPerPage = 50
@@ -20,27 +20,14 @@ snapshotsPerPage = 50
 -- inclined, or create a single monolithic file.
 getAllSnapshotsR :: Handler Html
 getAllSnapshotsR = do
-    error "getAllSnapshotsR"
-    {-
     now' <- liftIO getCurrentTime
     currentPageMay <- lookupGetParam "page"
     let currentPage :: Int
         currentPage = fromMaybe 1 (currentPageMay >>= readMay)
-    (totalCount, groups) <- fmap (groupUp now') $ runDB $ do
-        c <- count ([] :: [Filter Stackage])
-        rs <- E.select $ E.from $ \(stackage `E.InnerJoin` user) -> do
-            E.on (stackage E.^. StackageUser E.==. user E.^. UserId)
-            E.orderBy [E.desc $ stackage E.^. StackageUploaded]
-            E.limit snapshotsPerPage
-            E.offset ((fromIntegral currentPage - 1) * snapshotsPerPage)
-            return
-                ( stackage E.^. StackageSlug
-                , stackage E.^. StackageTitle
-                , stackage E.^. StackageUploaded
-                , user E.^. UserDisplay
-                , user E.^. UserHandle
-                )
-        return (c, rs)
+    (totalCount, snapshots) <- getSnapshots
+        snapshotsPerPage
+        ((fromIntegral currentPage - 1) * snapshotsPerPage)
+    let groups = groupUp now' snapshots
 
     let isFirstPage = currentPage == 1
         isLastPage = currentPage * snapshotsPerPage >= totalCount
@@ -49,8 +36,13 @@ getAllSnapshotsR = do
         setTitle "Stackage Server"
         let snapshotsNav = $(widgetFile "snapshots-nav")
         $(widgetFile "all-snapshots")
-  where uncrapify now' c =
-            let (E.Value ident, E.Value title, E.Value uploaded, E.Value display, E.Value handle') = c
-            in (ident,title,format (diff True) (diffUTCTime uploaded now'),display,handle')
-        groupUp now' (c, rs) = (c, (groupBy (on (==) (\(_,_,uploaded,_,_) -> uploaded)) . map (uncrapify now')) rs)
-        -}
+  where uncrapify now' snapshot =
+            ( snapshotName snapshot
+            , snapshotTitle snapshot
+            , format (diff True)
+                $ diffUTCTime
+                    (UTCTime (snapshotCreated snapshot) 0)
+                    now'
+            )
+        groupUp now' = groupBy (on (==) (\(_,_,uploaded) -> uploaded))
+                     . map (uncrapify now')

Stackage/Database.hs

@@ -27,6 +27,7 @@ module Stackage.Database
     , getPackage
     , prettyName
     , getSnapshotsForPackage
+    , getSnapshots
     ) where
 
 import Database.Sqlite (SqliteException)
@@ -588,3 +589,14 @@ getSnapshotsForPackage pname = run $ do
         return $ case ms of
             Nothing -> Nothing
             Just s -> Just (s, snapshotPackageVersion sp)
+
+getSnapshots
+    :: GetStackageDatabase m
+    => Int -- ^ limit
+    -> Int -- ^ offset
+    -> m (Int, [Snapshot])
+getSnapshots l o = run $ (,)
+    <$> count ([] :: [Filter Snapshot])
+    <*> fmap (map entityVal) (selectList
+        []
+        [LimitTo l, OffsetBy o, Desc SnapshotCreated])

templates/all-snapshots.hamlet

@@ -3,15 +3,13 @@
         <h1>Snapshots
         ^{snapshotsNav}
         $forall stackages <- groups
-            $forall (_, _, uploaded, _, _) <- take 1 stackages
+            $forall (_, _, uploaded) <- take 1 stackages
                 <h3>
                     #{uploaded}
             <ul .snapshots>
-                $forall (ident, title, _uploaded, display, handle) <- stackages
+                $forall (ident, title, _uploaded) <- stackages
                     <li>
                         <strong>
                             <a href=@{SnapshotR ident StackageHomeR}>
                                 #{title}
-                        <p>
-                            #{display} (#{handle})
         ^{snapshotsNav}

templates/stackage-home.hamlet

@@ -61,4 +61,4 @@ $newline never
                                 #{pliName pli}
                                 -#{pliVersion pli}
                         <td>
-                            #{pliSynopsis pli}
+                            #{strip $ pliSynopsis pli}