diff --git a/Handler/Feed.hs b/Handler/Feed.hs index fbee2f7..76b0e6f 100644 --- a/Handler/Feed.hs +++ b/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 diff --git a/Stackage/Database.hs b/Stackage/Database.hs index c5defff..d1c2ac1 100644 --- a/Stackage/Database.hs +++ b/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] diff --git a/config/routes b/config/routes index 9baae5e..5bd3315 100644 --- a/config/routes +++ b/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