mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-12 12:18:29 +01:00
Use StackageBranch for Feed
This commit is contained in:
parent
be32c1a177
commit
62c0789ca6
@ -1,8 +1,6 @@
|
||||
module Handler.Feed
|
||||
( getFeedR
|
||||
, getLtsFeedR
|
||||
, getLtsMajorFeedR
|
||||
, getNightlyFeedR
|
||||
, getBranchFeedR
|
||||
) where
|
||||
|
||||
import Import
|
||||
@ -13,21 +11,14 @@ import qualified Data.HashMap.Strict as HashMap
|
||||
import Text.Blaze (text)
|
||||
|
||||
getFeedR :: Handler TypedContent
|
||||
getFeedR = mkFeed "" . snd =<< getSnapshots 20 0
|
||||
getFeedR = mkFeed Nothing . snd =<< getSnapshots 20 0
|
||||
|
||||
getLtsFeedR :: Handler TypedContent
|
||||
getLtsFeedR = mkFeed "LTS" . snd =<< getLtsSnapshots 20 0
|
||||
getBranchFeedR :: StackageBranch -> Handler TypedContent
|
||||
getBranchFeedR branch = mkFeed (Just branch) . snd =<< getBranchSnapshots branch 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 :: Maybe StackageBranch -> [Entity Snapshot] -> Handler TypedContent
|
||||
mkFeed _ [] = notFound
|
||||
mkFeed branch snaps = do
|
||||
mkFeed mBranch snaps = do
|
||||
entries <- forM snaps $ \(Entity snapid snap) -> do
|
||||
content <- getContent snapid snap
|
||||
return FeedEntry
|
||||
@ -41,15 +32,20 @@ mkFeed branch snaps = do
|
||||
[] -> liftIO getCurrentTime
|
||||
x:_ -> return $ feedEntryUpdated x
|
||||
newsFeed Feed
|
||||
{ feedTitle = "Recent Stackage " <> branch <> " snapshots"
|
||||
{ feedTitle = title
|
||||
, feedLinkSelf = FeedR
|
||||
, feedLinkHome = HomeR
|
||||
, feedAuthor = "Stackage Project"
|
||||
, feedDescription = text ("Recent Stackage " <> branch <> " snapshots")
|
||||
, feedDescription = text title
|
||||
, feedLanguage = "en"
|
||||
, feedUpdated = updated
|
||||
, feedEntries = entries
|
||||
}
|
||||
where
|
||||
branchTitle NightlyBranch = "Nightly"
|
||||
branchTitle LtsBranch = "LTS"
|
||||
branchTitle (LtsMajorBranch x) = "LTS-" <> tshow x
|
||||
title = "Recent Stackage " <> maybe "" branchTitle mBranch <> " snapshots"
|
||||
|
||||
getContent :: SnapshotId -> Snapshot -> Handler Html
|
||||
getContent sid2 snap = do
|
||||
|
||||
@ -37,6 +37,7 @@ module Stackage.Database
|
||||
, getLtsSnapshots
|
||||
, getLtsMajorSnapshots
|
||||
, getNightlySnapshots
|
||||
, getBranchSnapshots
|
||||
, currentSchema
|
||||
, last5Lts5Nightly
|
||||
, snapshotsJSON
|
||||
@ -71,6 +72,7 @@ import System.IO.Temp
|
||||
import qualified Database.Esqueleto as E
|
||||
import Data.Yaml (decode)
|
||||
import qualified Data.Aeson as A
|
||||
import Types (StackageBranch(..))
|
||||
|
||||
currentSchema :: Int
|
||||
currentSchema = 1
|
||||
@ -675,6 +677,15 @@ getSnapshots l o = run $ (,)
|
||||
[]
|
||||
[LimitTo l, OffsetBy o, Desc SnapshotCreated]
|
||||
|
||||
getBranchSnapshots :: GetStackageDatabase m
|
||||
=> StackageBranch
|
||||
-> Int -- ^ limit
|
||||
-> Int -- ^ offset
|
||||
-> m (Int, [Entity Snapshot])
|
||||
getBranchSnapshots NightlyBranch = getNightlySnapshots
|
||||
getBranchSnapshots LtsBranch = getLtsSnapshots
|
||||
getBranchSnapshots (LtsMajorBranch x) = getLtsMajorSnapshots x
|
||||
|
||||
getLtsSnapshots :: GetStackageDatabase m
|
||||
=> Int -- ^ limit
|
||||
-> Int -- ^ offset
|
||||
|
||||
@ -47,9 +47,7 @@
|
||||
/download/#SupportedArch/#Text DownloadGhcLinksR GET
|
||||
|
||||
/feed FeedR GET
|
||||
!/feed/#LtsMajor LtsMajorFeedR GET
|
||||
/feed/lts LtsFeedR GET
|
||||
/feed/nightly NightlyFeedR GET
|
||||
/feed/#StackageBranch BranchFeedR GET
|
||||
|
||||
/stack DownloadStackListR GET
|
||||
/stack/#Text DownloadStackR GET
|
||||
|
||||
Loading…
Reference in New Issue
Block a user