Merge pull request #130 from fpco/more-feeds

Add /feed/lts and /feed/nightly

Handler/Feed.hs

@@ -1,14 +1,33 @@
-module Handler.Feed where
+module Handler.Feed
+    ( getFeedR
+    , getLtsFeedR
+    , getLtsMajorFeedR
+    , getNightlyFeedR
+    ) where
 
 import Import
 import Stackage.Database
 import           Data.These
 import Stackage.Snapshot.Diff
 import qualified Data.HashMap.Strict as HashMap
+import Text.Blaze (text)
 
 getFeedR :: Handler TypedContent
-getFeedR = do
-    (_, snaps) <- getSnapshots 20 0
+getFeedR = mkFeed "" . snd =<< getSnapshots 20 0
+
+getLtsFeedR :: Handler TypedContent
+getLtsFeedR = mkFeed "LTS" . snd =<< getLtsSnapshots 20 0
+
+getLtsMajorFeedR :: LtsMajor -> Handler TypedContent
+getLtsMajorFeedR (LtsMajor v) =
+    mkFeed ("LTS-" <> tshow v) . snd =<< getLtsMajorSnapshots v 20 0
+
+getNightlyFeedR :: Handler TypedContent
+getNightlyFeedR = mkFeed "Nightly" . snd =<< getNightlySnapshots 20 0
+
+mkFeed :: Text -> [Entity Snapshot] -> Handler TypedContent
+mkFeed _ [] = notFound
+mkFeed branch snaps = do
     entries <- forM snaps $ \(Entity snapid snap) -> do
         content <- getContent snapid snap
         return FeedEntry
@@ -22,11 +41,11 @@ getFeedR = do
             [] -> liftIO getCurrentTime
             x:_ -> return $ feedEntryUpdated x
     newsFeed Feed
-        { feedTitle = "Recent Stackage snapshots"
+        { feedTitle = "Recent Stackage " <> branch <> " snapshots"
         , feedLinkSelf = FeedR
         , feedLinkHome = HomeR
         , feedAuthor = "Stackage Project"
-        , feedDescription = "Recent Stackage snapshots"
+        , feedDescription = text ("Recent Stackage " <> branch <> " snapshots")
         , feedLanguage = "en"
         , feedUpdated = updated
         , feedEntries = entries

Stackage/Database.hs

@@ -33,6 +33,9 @@ module Stackage.Database
     , prettyNameShort
     , getSnapshotsForPackage
     , getSnapshots
+    , getLtsSnapshots
+    , getLtsMajorSnapshots
+    , getNightlySnapshots
     , currentSchema
     , last5Lts5Nightly
     , snapshotsJSON
@@ -666,6 +669,54 @@ getSnapshots l o = run $ (,)
         []
         [LimitTo l, OffsetBy o, Desc SnapshotCreated]
 
+getLtsSnapshots :: GetStackageDatabase m
+                => Int -- ^ limit
+                -> Int -- ^ offset
+                -> m (Int, [Entity Snapshot])
+getLtsSnapshots l o = run $ do
+    ltsCount <- count ([] :: [Filter Lts])
+    snapshots <- E.select $ E.from $
+        \(lts `E.InnerJoin` snapshot) -> do
+            E.on $ lts E.^. LtsSnap E.==. snapshot E.^. SnapshotId
+            E.orderBy [ E.desc (lts E.^. LtsMajor)
+                      , E.desc (lts E.^. LtsMinor) ]
+            E.limit $ fromIntegral l
+            E.offset $ fromIntegral o
+            return snapshot
+    return (ltsCount, snapshots)
+
+getLtsMajorSnapshots :: GetStackageDatabase m
+                => Int -- ^ Major version
+                -> Int -- ^ limit
+                -> Int -- ^ offset
+                -> m (Int, [Entity Snapshot])
+getLtsMajorSnapshots v l o = run $ do
+    ltsCount <- count ([] :: [Filter Lts])
+    snapshots <- E.select $ E.from $
+        \(lts `E.InnerJoin` snapshot) -> do
+            E.on $ lts E.^. LtsSnap E.==. snapshot E.^. SnapshotId
+            E.orderBy [E.desc (lts E.^. LtsMinor)]
+            E.where_ ((lts E.^. LtsMajor) E.==. (E.val v))
+            E.limit $ fromIntegral l
+            E.offset $ fromIntegral o
+            return snapshot
+    return (ltsCount, snapshots)
+
+getNightlySnapshots :: GetStackageDatabase m
+                => Int -- ^ limit
+                -> Int -- ^ offset
+                -> m (Int, [Entity Snapshot])
+getNightlySnapshots l o = run $ do
+    nightlyCount <- count ([] :: [Filter Nightly])
+    snapshots <- E.select $ E.from $
+        \(nightly `E.InnerJoin` snapshot) -> do
+            E.on $ nightly E.^. NightlySnap E.==. snapshot E.^. SnapshotId
+            E.orderBy [E.desc (nightly E.^. NightlyDay)]
+            E.limit $ fromIntegral l
+            E.offset $ fromIntegral o
+            return snapshot
+    return (nightlyCount, snapshots)
+
 last5Lts5Nightly :: GetStackageDatabase m => m [SnapName]
 last5Lts5Nightly = run $ do
     ls <- selectList [] [Desc LtsMajor, Desc LtsMinor, LimitTo 5]

config/routes

@@ -45,4 +45,8 @@
 /download/snapshots.json DownloadSnapshotsJsonR GET
 /download/lts-snapshots.json DownloadLtsSnapshotsJsonR GET
 /download/#SupportedArch/#Text DownloadGhcLinksR GET
+
 /feed FeedR GET
+!/feed/#LtsMajor LtsMajorFeedR GET
+/feed/lts LtsFeedR GET
+/feed/nightly NightlyFeedR GET