Merge pull request #282 from igrep/fix-277

Try to fix #277 by deleting verbose info
This commit is contained in:
Michael Snoyman 2020-01-13 07:10:33 +02:00 committed by GitHub
commit 1455e63a97
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

View File

@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module Handler.Feed module Handler.Feed
@ -7,10 +8,11 @@ module Handler.Feed
import Data.These import Data.These
import Import import Import
import RIO.Time (getCurrentTime)
import Stackage.Database import Stackage.Database
import Stackage.Snapshot.Diff import Stackage.Snapshot.Diff
import Text.Blaze (text) import Text.Blaze (text)
import RIO.Time (getCurrentTime) import Yesod.Core.Handler (lookupGetParam)
getFeedR :: Handler TypedContent getFeedR :: Handler TypedContent
getFeedR = track "Handler.Feed.getBranchFeedR" $ getBranchFeed Nothing getFeedR = track "Handler.Feed.getBranchFeedR" $ getBranchFeed Nothing
@ -25,7 +27,11 @@ mkFeed :: Maybe SnapshotBranch -> [Entity Snapshot] -> Handler TypedContent
mkFeed _ [] = notFound mkFeed _ [] = notFound
mkFeed mBranch snaps = do mkFeed mBranch snaps = do
entries <- forM snaps $ \(Entity snapid snap) -> do entries <- forM snaps $ \(Entity snapid snap) -> do
content <- getContent snapid snap showsDiff <- doesShowDiff
content <-
if showsDiff
then getContent snapid snap
else return mempty
return FeedEntry return FeedEntry
{ feedEntryLink = SnapshotR (snapshotName snap) StackageHomeR { feedEntryLink = SnapshotR (snapshotName snap) StackageHomeR
, feedEntryUpdated = UTCTime (snapshotCreated snap) 0 , feedEntryUpdated = UTCTime (snapshotCreated snap) 0
@ -54,6 +60,14 @@ mkFeed mBranch snaps = do
branchTitle (LtsMajorBranch x) = "LTS-" <> tshow x branchTitle (LtsMajorBranch x) = "LTS-" <> tshow x
title = "Recent Stackage " <> maybe "" branchTitle mBranch <> " snapshots" title = "Recent Stackage " <> maybe "" branchTitle mBranch <> " snapshots"
doesShowDiff =
(fmap fromPathPiece <$> lookupGetParam "withDiff") >>= \case
Just (Just False) -> return False
Just (Just True) -> return True
Just Nothing -> notFound
Nothing -> return True
getContent :: SnapshotId -> Snapshot -> Handler Html getContent :: SnapshotId -> Snapshot -> Handler Html
getContent sid2 snap = do getContent sid2 snap = do
mprev <- snapshotBefore $ snapshotName snap mprev <- snapshotBefore $ snapshotName snap