mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-12 04:08:29 +01:00
104 lines
4.2 KiB
Haskell
104 lines
4.2 KiB
Haskell
module Handler.Feed
|
|
( getFeedR
|
|
, getBranchFeedR
|
|
) where
|
|
|
|
import Import
|
|
import Stackage.Database
|
|
import Data.These
|
|
import Stackage.Snapshot.Diff
|
|
import Text.Blaze (text)
|
|
|
|
getFeedR :: Handler TypedContent
|
|
getFeedR = track "Handler.Feed.getBranchFeedR" $ getBranchFeed Nothing
|
|
|
|
getBranchFeedR :: SnapshotBranch -> Handler TypedContent
|
|
getBranchFeedR = track "Handler.Feed.getBranchFeedR" . getBranchFeed . Just
|
|
|
|
getBranchFeed :: Maybe SnapshotBranch -> Handler TypedContent
|
|
getBranchFeed mBranch = mkFeed mBranch =<< getSnapshots mBranch 20 0
|
|
|
|
mkFeed :: Maybe SnapshotBranch -> [Entity Snapshot] -> Handler TypedContent
|
|
mkFeed _ [] = notFound
|
|
mkFeed mBranch snaps = do
|
|
entries <- forM snaps $ \(Entity snapid snap) -> do
|
|
content <- getContent snapid snap
|
|
return FeedEntry
|
|
{ feedEntryLink = SnapshotR (snapshotName snap) StackageHomeR
|
|
, feedEntryUpdated = UTCTime (snapshotCreated snap) 0
|
|
, feedEntryTitle = prettyName (snapshotName snap) (snapshotGhc snap)
|
|
, feedEntryContent = content
|
|
, feedEntryEnclosure = Nothing
|
|
}
|
|
updated <-
|
|
case entries of
|
|
[] -> liftIO getCurrentTime
|
|
x:_ -> return $ feedEntryUpdated x
|
|
newsFeed Feed
|
|
{ feedTitle = title
|
|
, feedLinkSelf = FeedR
|
|
, feedLinkHome = HomeR
|
|
, feedAuthor = "Stackage Project"
|
|
, feedDescription = text title
|
|
, feedLanguage = "en"
|
|
, feedUpdated = updated
|
|
, feedEntries = entries
|
|
, feedLogo = Nothing
|
|
}
|
|
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
|
|
mprev <- snapshotBefore $ snapshotName snap
|
|
case mprev of
|
|
Nothing -> return "No previous snapshot found for comparison"
|
|
Just (sid1, name1) -> do
|
|
snapDiff <- getSnapshotDiff sid1 sid2
|
|
let name2 = snapshotName snap
|
|
withUrlRenderer
|
|
[hamlet|
|
|
<p>Difference between #{prettyNameShort name1} and #{prettyNameShort $ snapshotName snap}
|
|
<table border=1 cellpadding=5>
|
|
<thead>
|
|
<tr>
|
|
<th align=right>Package name
|
|
<th align=right>Old
|
|
<th align=left>New
|
|
<tbody>
|
|
$forall (pkgname@(PackageName name), VersionChange change, versionDiff) <- toVersionedDiffList snapDiff
|
|
<tr>
|
|
<th align=right>#{name}
|
|
$case change
|
|
$of This old
|
|
<td align=right>
|
|
<a href=@{packageUrl name1 pkgname old}#changes>
|
|
#{old}
|
|
<td>
|
|
$of That new
|
|
<td align=right>
|
|
<td>
|
|
<a href=@{packageUrl name2 pkgname new}#changes>
|
|
#{new}
|
|
$of These old new
|
|
$maybe (common, left, right) <- versionDiff
|
|
<td align=right>
|
|
<a href=@{packageUrl name1 pkgname old}#changes>
|
|
#{common}#
|
|
<del style="background-color: #fcc">#{left}
|
|
<td>
|
|
<a href=@{packageUrl name2 pkgname new}#changes>
|
|
#{common}#
|
|
<ins style="background-color: #cfc">#{right}
|
|
$nothing
|
|
<td align=right>
|
|
<a href=@{packageUrl name1 pkgname old}#changes>
|
|
#{old}
|
|
<td>
|
|
<a href=@{packageUrl name2 pkgname new}#changes>
|
|
#{new}
|
|
|]
|