We are no longer offering accounts on this server. Consider https://gitlab.freedesktop.org/ as a place to host projects.

Commit a9f91a14 authored by David L. L. Thomas's avatar David L. L. Thomas

Merge pull request #271 from mitchellwrosen/move-snowdrift-event

Quick refactor, moved snowdriftEventToFeedEvent to Model.SnowdriftEvent
parents f7094e25 cb0f5663
......@@ -4,9 +4,6 @@ module Handler.Project where
import Import
import Yesod.AtomFeed
import Yesod.RssFeed
import Data.Filter
import Data.Order
import Handler.Comment
......@@ -36,18 +33,21 @@ import View.SnowdriftEvent
import Widgets.Preview
import Widgets.Time
import Data.Default (def)
import qualified Data.Foldable as F
import Data.List (sortBy)
import qualified Data.Map as M
import Data.Maybe (maybeToList)
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Tree (Forest, Tree)
import qualified Data.Tree as Tree
import System.Random (randomIO)
import Text.Cassius (cassiusFile)
import Data.Default (def)
import qualified Data.Foldable as F
import Data.List (sortBy)
import qualified Data.Map as M
import Data.Maybe (maybeToList)
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Tree (Forest, Tree)
import qualified Data.Tree as Tree
import System.Random (randomIO)
import Text.Cassius (cassiusFile)
import Text.Printf
import Yesod.AtomFeed
import Yesod.RssFeed
--------------------------------------------------------------------------------
-- Utility functions
......@@ -944,79 +944,20 @@ getProjectFeedR project_handle = do
[] -> Nothing
(next_event:_) -> (Just . T.pack . show . snowdriftEventTime) next_event
now <- liftIO getCurrentTime
now <- liftIO getCurrentTime
Just route <- getCurrentRoute
render <- getUrlRender
-- If we need to look things up, see if we can grab them from above rather than putting the map in Handler
-- Eventually the html rendering here should be moved to the top level somewhere for sharing with notifications
let eventToFeedEntry (ECommentPosted comment_id comment) =
let user_id = commentUser comment
maybe_user = M.lookup user_id user_map
username = maybe "<unknown user>" (userDisplayName . Entity user_id) maybe_user
discussion = case M.lookup (commentDiscussion comment) discussion_map of
Nothing -> "<unknown discussion>"
Just (DiscussionOnProject _) -> "project discussion"
Just (DiscussionOnWikiPage (Entity _ wiki_page)) -> "wiki discussion for \"" <> wikiPageTarget wiki_page <> "\""
in Just $ FeedEntry
{ feedEntryLink = CommentDirectLinkR comment_id
, feedEntryUpdated = maybe (commentCreatedTs comment) id $ commentApprovedTs comment
, feedEntryTitle = T.unwords [ T.snoc project_handle ':', "new comment posted on", discussion, "by", username ]
, feedEntryContent = [hamlet| |] render
}
eventToFeedEntry (ECommentRethreaded _ rethread) =
Just $ FeedEntry
{ feedEntryLink = CommentDirectLinkR $ rethreadNewComment rethread
, feedEntryUpdated = rethreadTs rethread
, feedEntryTitle = T.unwords [ T.snoc project_handle ':', "comment rethreaded" ]
, feedEntryContent = [hamlet| |] render
}
eventToFeedEntry (EWikiPage _ wiki_page) =
let target = wikiPageTarget wiki_page
in Just $ FeedEntry
{ feedEntryLink = WikiR project_handle $ wikiPageTarget wiki_page
, feedEntryUpdated = wikiPageCreatedTs wiki_page
, feedEntryTitle = T.unwords [ T.snoc project_handle ':', "new wiki page", "\"" <> target <> "\"" ]
, feedEntryContent = [hamlet| |] render
}
eventToFeedEntry (EWikiEdit wiki_edit_id wiki_edit) =
let maybe_wiki_page = M.lookup (wikiEditPage wiki_edit) wiki_page_map
target = maybe (error "missing wiki page for edit") wikiPageTarget maybe_wiki_page
user_id = wikiEditUser wiki_edit
maybe_user = M.lookup user_id user_map
username = maybe "<unknown user>" (userDisplayName . Entity user_id) maybe_user
in Just $ FeedEntry
{ feedEntryLink = WikiEditR project_handle target wiki_edit_id
, feedEntryUpdated = wikiEditTs wiki_edit
, feedEntryTitle = T.unwords [ T.snoc project_handle ':', "wiki page", "\"" <> target <> "\"", "edited by", username ]
, feedEntryContent = [hamlet| |] render
}
-- We might want to show these, but I'm not sure. Leaving them out now, at any rate.
eventToFeedEntry (ENewPledge _ _) = Nothing
eventToFeedEntry (EUpdatedPledge _ _ _) = Nothing
eventToFeedEntry (EDeletedPledge _ _ _ _) = Nothing
-- Graveyard of event types we don't want to put on the feed.
-- Don't match-all here, we don't want to accidentally not consider something.
eventToFeedEntry (ENotificationSent _ _) = Nothing
eventToFeedEntry (ECommentPending _ _) = Nothing
render <- getUrlRender
let feed = Feed "project feed" route HomeR "Snowdrift Community" "" "en" now $
mapMaybe (snowdriftEventToFeedEntry
render
project_handle
user_map
discussion_map
wiki_page_map) events
selectRep $ do
let feed = Feed "project feed" route HomeR "Snowdrift Community" "" "en" now $ mapMaybe eventToFeedEntry events
provideRep $ atomFeed feed
provideRep $ rssFeed feed
provideRep $ defaultLayout $ do
$(widgetFile "project_feed")
toWidget $(cassiusFile "templates/comment.cassius")
......
module Model.SnowdriftEvent
( snowdriftEventNewestToOldest
, snowdriftEventTime
, snowdriftEventToFeedEntry
) where
import Import
import Model.Discussion
import Model.User
import qualified Data.Map as M
import qualified Data.Text as T
import Yesod.Feed (FeedEntry(..))
snowdriftEventNewestToOldest :: SnowdriftEvent -> SnowdriftEvent -> Ordering
snowdriftEventNewestToOldest x y = compare (snowdriftEventTime y) (snowdriftEventTime x)
......@@ -18,3 +26,69 @@ snowdriftEventTime (EWikiPage _ WikiPage{..}) = wikiPageCreatedTs
snowdriftEventTime (ENewPledge _ SharesPledged{..}) = sharesPledgedTs
snowdriftEventTime (EUpdatedPledge _ _ SharesPledged{..}) = sharesPledgedTs
snowdriftEventTime (EDeletedPledge ts _ _ _) = ts
-- Eventually the html rendering here should be moved to the top level somewhere for sharing with notifications
snowdriftEventToFeedEntry
:: (Route App -> Text)
-> Text
-> Map UserId User
-> Map DiscussionId DiscussionOn
-> Map WikiPageId WikiPage
-> SnowdriftEvent
-> Maybe (FeedEntry (Route App))
snowdriftEventToFeedEntry render project_handle user_map discussion_map _ (ECommentPosted comment_id comment) =
let user_id = commentUser comment
maybe_user = M.lookup user_id user_map
username = maybe "<unknown user>" (userDisplayName . Entity user_id) maybe_user
discussion = case M.lookup (commentDiscussion comment) discussion_map of
Nothing -> "<unknown discussion>"
Just (DiscussionOnProject _) -> "project discussion"
Just (DiscussionOnWikiPage (Entity _ wiki_page)) -> "wiki discussion for \"" <> wikiPageTarget wiki_page <> "\""
in Just $ FeedEntry
{ feedEntryLink = CommentDirectLinkR comment_id
, feedEntryUpdated = maybe (commentCreatedTs comment) id $ commentApprovedTs comment
, feedEntryTitle = T.unwords [ T.snoc project_handle ':', "new comment posted on", discussion, "by", username ]
, feedEntryContent = [hamlet| |] render
}
snowdriftEventToFeedEntry render project_handle _ _ _ (ECommentRethreaded _ rethread) =
Just $ FeedEntry
{ feedEntryLink = CommentDirectLinkR $ rethreadNewComment rethread
, feedEntryUpdated = rethreadTs rethread
, feedEntryTitle = T.unwords [ T.snoc project_handle ':', "comment rethreaded" ]
, feedEntryContent = [hamlet| |] render
}
snowdriftEventToFeedEntry render project_handle _ _ _ (EWikiPage _ wiki_page) =
let target = wikiPageTarget wiki_page
in Just $ FeedEntry
{ feedEntryLink = WikiR project_handle $ wikiPageTarget wiki_page
, feedEntryUpdated = wikiPageCreatedTs wiki_page
, feedEntryTitle = T.unwords [ T.snoc project_handle ':', "new wiki page", "\"" <> target <> "\"" ]
, feedEntryContent = [hamlet| |] render
}
snowdriftEventToFeedEntry render project_handle user_map _ wiki_page_map (EWikiEdit wiki_edit_id wiki_edit) =
let maybe_wiki_page = M.lookup (wikiEditPage wiki_edit) wiki_page_map
target = maybe (error "missing wiki page for edit") wikiPageTarget maybe_wiki_page
user_id = wikiEditUser wiki_edit
maybe_user = M.lookup user_id user_map
username = maybe "<unknown user>" (userDisplayName . Entity user_id) maybe_user
in Just $ FeedEntry
{ feedEntryLink = WikiEditR project_handle target wiki_edit_id
, feedEntryUpdated = wikiEditTs wiki_edit
, feedEntryTitle = T.unwords [ T.snoc project_handle ':', "wiki page", "\"" <> target <> "\"", "edited by", username ]
, feedEntryContent = [hamlet| |] render
}
-- We might want to show these, but I'm not sure. Leaving them out now, at any rate.
snowdriftEventToFeedEntry _ _ _ _ _ (ENewPledge _ _) = Nothing
snowdriftEventToFeedEntry _ _ _ _ _ (EUpdatedPledge _ _ _) = Nothing
snowdriftEventToFeedEntry _ _ _ _ _ (EDeletedPledge _ _ _ _) = Nothing
-- Graveyard of event types we don't want to put on the feed.
-- Don't match-all here, we don't want to accidentally not consider something.
snowdriftEventToFeedEntry _ _ _ _ _ (ENotificationSent _ _) = Nothing
snowdriftEventToFeedEntry _ _ _ _ _ (ECommentPending _ _) = Nothing
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment