module Handler.Discussion where import Import import Handler.Shared import Text.Blaze import Text.Blaze.Html4.Strict (i) import Handler.ShowChallenge import Yesod.Form.Bootstrap3 import Yesod.RssFeed import Data.Text as T (pack) import Database.Persist.Sql data TimelineItem = TimelineItem Text UTCTime (Entity User) Markup getTime (TimelineItem _ stamp _ _) = stamp class ToTimelineItem a where getTimelineItemId :: a -> Text timelineWhen :: a -> UTCTime timelineWhoId :: a -> UserId timelineWho :: a -> Handler (Entity User) timelineWho sItem = do let userId = timelineWhoId sItem user <- runDB $ get404 userId return $ Entity userId user timelineWhat :: a -> Handler Markup toTimelineItem :: a -> Handler TimelineItem toTimelineItem sItem = do let itemIdentifier = getTimelineItemId sItem let when = timelineWhen sItem who <- timelineWho sItem what <- timelineWhat sItem return $ TimelineItem itemIdentifier when who what instance ToTimelineItem (Entity Comment) where getTimelineItemId (Entity commentId comment) = "comment-" ++ (T.pack $ show $ fromSqlKey $ commentId) timelineWhoId (Entity _ comment) = commentAuthor comment timelineWhen (Entity _ comment) = commentPosted comment timelineWhat (Entity _ comment) = return $ toMarkup $ commentText comment instance ToTimelineItem (Entity Submission) where getTimelineItemId (Entity commentId comment) = "submission-" ++ (T.pack $ show $ fromSqlKey $ commentId) timelineWhoId (Entity _ submission) = submissionSubmitter submission timelineWhen (Entity _ submission) = submissionStamp submission timelineWhat (Entity _ submission) = return $ i $ toMarkup ( "submitted a solution:" ++ submissionDescription submission ) getChallengeDiscussionR :: Text -> Handler Html getChallengeDiscussionR name = do (Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName name maybeUser <- maybeAuth (formWidget, formEnctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm (commentForm challengeId) sortedTimelineItems <- getTimelineItems challengeId challengeLayout True challenge (discussionWidget maybeUser formWidget formEnctype name sortedTimelineItems) getTimelineItems :: ChallengeId -> Handler [TimelineItem] getTimelineItems challengeId = do comments <- runDB $ selectList [CommentChallenge ==. challengeId] [Desc CommentPosted] submissions <- runDB $ selectList [SubmissionChallenge ==. challengeId] [Desc SubmissionStamp] timelineItems' <- mapM toTimelineItem comments timelineItems'' <- mapM toTimelineItem submissions return $ sortBy (\item1 item2 -> (getTime item2 `compare` getTime item1)) ( timelineItems' ++ timelineItems'') discussionWidget maybeUser formWidget formEnctype name sortedTimelineItems = $(widgetFile "challenge-discussion") timelineItemWidget item = $(widgetFile "timeline-item") postChallengeDiscussionR :: Text -> Handler TypedContent postChallengeDiscussionR name = do (Entity challengeId _) <- runDB $ getBy404 $ UniqueName name ((result, formWidget), formEnctype) <- runFormPost $ renderBootstrap3 BootstrapBasicForm (commentForm challengeId) stamp <- liftIO getCurrentTime userId <- requireAuthId case result of FormSuccess (challengeId, commentContent) -> do setMessage $ toHtml ("Comment submitted" :: Text) _ <- runDB $ insert $ Comment challengeId userId stamp commentContent return () _ -> do setMessage $ toHtml ("Something went wrong" :: Text) redirect $ ChallengeDiscussionR name commentForm :: Key Challenge -> AForm Handler (ChallengeId, Textarea) commentForm challengeId = (,) <$> pure challengeId <*> areq textareaField (bfs MsgCommentText) Nothing numberOfItemsInFeed :: Int numberOfItemsInFeed = 20 getChallengeDiscussionFeedR :: Text -> Handler RepRss getChallengeDiscussionFeedR name = do (Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName name items <- getTimelineItems challengeId now <- liftIO getCurrentTime render <- getUrlRender rssFeedText Feed { feedTitle = "gonito.net / " ++ (challengeTitle challenge), feedLinkSelf = render HomeR, feedLinkHome = render (ChallengeDiscussionFeedR name), feedAuthor = "gonito.net", feedDescription = toMarkup $ "Comments and submission for a gonito.net challenge — " ++ (challengeTitle challenge), feedLanguage = "en", feedUpdated = case items of (latestItem : _) -> getTime latestItem _ -> now, feedLogo = Nothing, feedEntries = map (getFeedEntry render challenge) (take numberOfItemsInFeed items) } getFeedEntry :: (Route App -> Text) -> Challenge -> TimelineItem -> FeedEntry Text getFeedEntry render challenge (TimelineItem identifier stamp (Entity userId user) contents) = FeedEntry { feedEntryLink = (render (ChallengeDiscussionR (challengeName challenge))) <> "#" <> identifier, feedEntryUpdated = stamp, feedEntryTitle = (challengeTitle challenge) ++ " / " ++ (formatSubmitter user), feedEntryContent = contents, feedEntryEnclosure = Nothing }