diff --git a/Application.hs b/Application.hs index 8dbabf7..e92622b 100644 --- a/Application.hs +++ b/Application.hs @@ -36,6 +36,7 @@ import qualified Data.IntMap as IntMap -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! import Handler.Common +import Handler.Discussion import Handler.Fay import Handler.Graph import Handler.Home diff --git a/Foundation.hs b/Foundation.hs index 57367b2..1ef6100 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -113,6 +113,7 @@ instance Yesod App where isAuthorized (ChallengeReadmeR _) _ = return Authorized isAuthorized (ChallengeAllSubmissionsR _) _ = return Authorized isAuthorized (ChallengeGraphDataR _) _ = return Authorized + isAuthorized (ChallengeDiscussionR _) _ = return Authorized -- Default to Authorized for now. isAuthorized _ _ = isTrustedAuthorized diff --git a/Handler/Discussion.hs b/Handler/Discussion.hs new file mode 100644 index 0000000..3cfff2e --- /dev/null +++ b/Handler/Discussion.hs @@ -0,0 +1,90 @@ +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 + +data TimelineItem = TimelineItem UTCTime User Markup + +getTime (TimelineItem stamp _ _) = stamp + +class ToTimelineItem a where + timelineWhen :: a -> UTCTime + + timelineWhoId :: a -> UserId + timelineWho :: a -> Handler User + timelineWho sItem = runDB $ get404 $ timelineWhoId sItem + + timelineWhat :: a -> Handler Markup + toTimelineItem :: a -> Handler TimelineItem + + toTimelineItem sItem = do + let when = timelineWhen sItem + who <- timelineWho sItem + what <- timelineWhat sItem + return $ TimelineItem when who what + +instance ToTimelineItem (Entity Comment) where + timelineWhoId (Entity _ comment) = commentAuthor comment + timelineWhen (Entity _ comment) = commentPosted comment + timelineWhat (Entity _ comment) = return $ toMarkup $ commentText comment + +instance ToTimelineItem (Entity Submission) where + 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 + (formWidget, formEnctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm (commentForm challengeId) + comments <- runDB $ selectList [CommentChallenge ==. challengeId] [Desc CommentPosted] + submissions <- runDB $ selectList [SubmissionChallenge ==. challengeId] [Desc SubmissionStamp] + timelineItems' <- mapM toTimelineItem comments + timelineItems'' <- mapM toTimelineItem submissions + let sortedTimelineItems = sortBy (\item1 item2 -> (getTime item2 `compare` getTime item1)) ( + timelineItems' ++ timelineItems'') + challengeLayout True challenge (discussionWidget formWidget formEnctype name sortedTimelineItems) + +discussionWidget 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) + case result of + FormSuccess comment -> do + userId <- requireAuthId + + if commentAuthor comment == userId + then + do + setMessage $ toHtml ("Comment submitted" :: Text) + _ <- runDB $ insert comment + return () + else + do + setMessage $ toHtml ("Wrong user ID" :: Text) + return () + _ -> do + setMessage $ toHtml ("Something went wrong" :: Text) + + redirect $ ChallengeDiscussionR name + +commentForm :: Key Challenge -> AForm Handler Comment +commentForm challengeId = Comment + <$> pure challengeId + <*> lift requireAuthId + <*> lift (liftIO getCurrentTime) + <*> areq textareaField (bfs MsgCommentText) Nothing diff --git a/Handler/Query.hs b/Handler/Query.hs index fb4565c..d6b48c8 100644 --- a/Handler/Query.hs +++ b/Handler/Query.hs @@ -2,7 +2,6 @@ module Handler.Query where import Import -import Handler.Tables (formatSubmitter) import Handler.Shared import PersistSHA1 diff --git a/Handler/Shared.hs b/Handler/Shared.hs index 650d494..9e68724 100644 --- a/Handler/Shared.hs +++ b/Handler/Shared.hs @@ -315,3 +315,12 @@ gatherSHA1ForCollectionOfFiles :: [FilePath] -> IO ByteString gatherSHA1ForCollectionOfFiles files = do contentss <- mapM readFile $ sort files return $ CHS.finalize $ foldl' CHS.update CHS.init contentss + +formatSubmitter :: User -> Text +formatSubmitter user = if userIsAnonymous user + then + "[anonymised]" + else + case userName user of + Just name -> name + Nothing -> "[name not given]" diff --git a/Handler/Tables.hs b/Handler/Tables.hs index 6bbba77..49fc19d 100644 --- a/Handler/Tables.hs +++ b/Handler/Tables.hs @@ -160,13 +160,3 @@ getEvaluationMap s@(Entity submissionId submission) = do let evaluations = catMaybes maybeEvaluations let m = Map.fromList $ map (\(Entity _ e) -> (evaluationTest e, e)) evaluations return (s, Entity (submissionSubmitter submission) user, m) - - -formatSubmitter :: User -> Text -formatSubmitter user = if userIsAnonymous user - then - "[anonymised]" - else - case userName user of - Just name -> name - Nothing -> "[name not given]" diff --git a/config/models b/config/models index 6fbb4c8..94a1983 100644 --- a/config/models +++ b/config/models @@ -61,6 +61,11 @@ Evaluation errorMessage Text Maybe stamp UTCTime default=now() UniqueEvaluationTestChecksum test checksum +Comment + challenge ChallengeId + author UserId + posted UTCTime default=now() + text Textarea Out submission SubmissionId test TestId diff --git a/config/routes b/config/routes index a5d1275..d70085a 100644 --- a/config/routes +++ b/config/routes @@ -18,6 +18,7 @@ /challenge-all-submissions/#Text ChallengeAllSubmissionsR GET /challenge-how-to/#Text ChallengeHowToR GET /challenge-graph-data/#Text ChallengeGraphDataR GET +/challenge-discussion/#Text ChallengeDiscussionR GET POST /q QueryFormR GET POST /q/#Text QueryResultsR GET diff --git a/gonito.cabal b/gonito.cabal index aa9e52e..ba52d02 100644 --- a/gonito.cabal +++ b/gonito.cabal @@ -31,6 +31,7 @@ library SharedTypes Handler.Common Handler.CreateChallenge + Handler.Discussion Handler.Fay Handler.Graph Handler.Home @@ -120,6 +121,8 @@ library , regex-tdfa , optparse-applicative , wai-handler-fastcgi + , blaze-markup + , blaze-html executable gonito if flag(library-only) diff --git a/messages/en.msg b/messages/en.msg index 4b7bea1..1e6d6be 100644 --- a/messages/en.msg +++ b/messages/en.msg @@ -21,3 +21,5 @@ SshPubKey: your SSH public key Home: home Search: search GitCommitSha1: Git commit SHA1 hash +CommentText: Write a comment +Send: Send diff --git a/static/images/male-avatar.svg b/static/images/male-avatar.svg new file mode 100644 index 0000000..a0750bc --- /dev/null +++ b/static/images/male-avatar.svg @@ -0,0 +1,4 @@ + + \ No newline at end of file diff --git a/templates/challenge-discussion.hamlet b/templates/challenge-discussion.hamlet new file mode 100644 index 0000000..eb047fa --- /dev/null +++ b/templates/challenge-discussion.hamlet @@ -0,0 +1,10 @@ + +
+