mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-12 12:18:29 +01:00
50 lines
1.7 KiB
Haskell
50 lines
1.7 KiB
Haskell
{-# LANGUAGE TupleSections, OverloadedStrings #-}
|
|
|
|
module Handler.Snapshots where
|
|
|
|
import Data.Time.Clock
|
|
import Formatting
|
|
import Formatting.Time
|
|
import Import
|
|
import Stackage.Database
|
|
|
|
snapshotsPerPage :: Integral a => a
|
|
snapshotsPerPage = 50
|
|
|
|
-- This is a handler function for the GET request method on the HomeR
|
|
-- resource pattern. All of your resource patterns are defined in
|
|
-- config/routes
|
|
--
|
|
-- The majority of the code you will write in Yesod lives in these handler
|
|
-- functions. You can spread them across multiple files if you are so
|
|
-- inclined, or create a single monolithic file.
|
|
getAllSnapshotsR :: Handler Html
|
|
getAllSnapshotsR = do
|
|
now' <- liftIO getCurrentTime
|
|
currentPageMay <- lookupGetParam "page"
|
|
let currentPage :: Int
|
|
currentPage = fromMaybe 1 (currentPageMay >>= readMay)
|
|
totalCount <- countSnapshots Nothing
|
|
(map entityVal -> snapshots) <-
|
|
getSnapshots Nothing snapshotsPerPage
|
|
((fromIntegral currentPage - 1) * snapshotsPerPage)
|
|
let groups = groupUp now' snapshots
|
|
|
|
let isFirstPage = currentPage == 1
|
|
isLastPage = currentPage * snapshotsPerPage >= totalCount
|
|
|
|
defaultLayout $ do
|
|
setTitle "Stackage Server"
|
|
let snapshotsNav = $(widgetFile "snapshots-nav")
|
|
$(widgetFile "all-snapshots")
|
|
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')
|