diff --git a/Handler/Snapshots.hs b/Handler/Snapshots.hs index 998f828..565e0e5 100644 --- a/Handler/Snapshots.hs +++ b/Handler/Snapshots.hs @@ -2,8 +2,11 @@ module Handler.Snapshots where -import Import +import Data.Time.Clock import qualified Database.Esqueleto as E +import Formatting +import Formatting.Time +import Import -- This is a handler function for the GET request method on the HomeR -- resource pattern. All of your resource patterns are defined in @@ -14,16 +17,18 @@ import qualified Database.Esqueleto as E -- inclined, or create a single monolithic file. getAllSnapshotsR :: Handler Html getAllSnapshotsR = do - stackages <- runDB $ 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] - return - ( stackage E.^. StackageIdent - , stackage E.^. StackageTitle - , stackage E.^. StackageUploaded - , user E.^. UserDisplay - , user E.^. UserHandle - ) + now <- liftIO getCurrentTime + groups <- fmap (groupBy (on (==) (\(_,_,uploaded,_,_) -> uploaded)) . map (uncrapify now)) $ + runDB $ 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] + return + ( stackage E.^. StackageIdent + , stackage E.^. StackageTitle + , stackage E.^. StackageUploaded + , user E.^. UserDisplay + , user E.^. UserHandle + ) defaultLayout $ do setTitle "Stackage Server" $(combineStylesheets 'StaticR @@ -31,3 +36,6 @@ getAllSnapshotsR = do , css_bootstrap_responsive_css ]) $(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) diff --git a/stackage-server.cabal b/stackage-server.cabal index b23f2f5..4ad4b54 100644 --- a/stackage-server.cabal +++ b/stackage-server.cabal @@ -78,7 +78,7 @@ library BangPatterns build-depends: - base >= 4 + base >= 4 , aeson >= 0.6 , aws , base16-bytestring @@ -128,6 +128,7 @@ library , yesod-form >= 1.3.14 , yesod-static >= 1.2 , zlib + , unordered-containers -- Avoid https://github.com/haskell/cabal/issues/1202 , Cabal >= 1.18 , lifted-base diff --git a/templates/all-snapshots.hamlet b/templates/all-snapshots.hamlet index a608a65..39d13d0 100644 --- a/templates/all-snapshots.hamlet +++ b/templates/all-snapshots.hamlet @@ -1,8 +1,14 @@
+ #{display} (#{handle}) diff --git a/templates/all-snapshots.lucius b/templates/all-snapshots.lucius index f0e751c..fd79238 100644 --- a/templates/all-snapshots.lucius +++ b/templates/all-snapshots.lucius @@ -1 +1,23 @@ -.snapshots > li { line-height: 1.5em; } +.snapshots > li { + list-style-type: none; + margin: 0 0 1.5em 0; +} + +.snapshots > li > p { + margin-top: 0.5em; + padding: 0; +} + +.snapshots { + margin: 1em 0 0 0; + padding: 0; +} + +h3 { + border-bottom: 1px solid #aaa; + padding-bottom: 0.25em; +} + +h1 { + margin-bottom: 0.5em; +}