add timeline (discussion/comments)

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

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

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

Handler/Query.hs

@@ -2,7 +2,6 @@ module Handler.Query where
 
 import Import
 
-import Handler.Tables (formatSubmitter)
 import Handler.Shared
 import PersistSHA1
 

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]"

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]"

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

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

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)

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

static/images/male-avatar.svg

@@ -0,0 +1,4 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<svg xmlns="http://www.w3.org/2000/svg" version="1.0" width="200" height="200">
+  <path d="M 3.1479956,199.8792 C 3.2975635,189.11012 3.401856,181.58351 3.0839455,167.62229 C 10.105706,158.82749 34.823782,154.79402 41.576501,152.37892 C 50.290941,145.87438 60.163612,140.3389 68.674128,135.43826 C 73.373849,132.73205 73.434971,123.45565 73.090981,117.22608 C 71.529518,108.40367 70.704151,100.79588 64.405541,94.317884 C 64.053201,92.46819 63.024431,88.22384 59.931471,82.679233 C 57.850015,73.360874 49.646154,61.821919 51.707332,55.90224 C 57.196471,40.137595 52.40075,33.731056 55.771462,32.383588 C 63.458756,29.310542 65.537537,22.590118 72.578356,15.841971 C 93.149082,11.923669 89.987081,1.4887794 105.35709,3.5044295 C 124.4076,6.0027415 113.91578,8.8197325 126.98208,15.459115 C 143.03475,23.615971 133.46982,24.442181 148.12438,46.038481 C 156.82644,58.862616 139.87501,59.736843 144.26704,71.085333 C 148.3243,81.568657 138.76017,83.355833 133.93493,94.828249 C 129.30575,105.83459 126.40093,109.0707 131.73108,123.57794 C 136.68074,137.04961 144.89857,130.89422 163.46019,151.07177 C 168.1733,156.1952 185.10612,149.99341 196.76509,164.95509 C 196.75779,172.625 196.92784,183.5909 196.98027,199.93748 C 144.72386,199.75031 3.1479956,199.8792 3.1479956,199.8792 z" fill="#808080"/>
+</svg>

templates/challenge-discussion.hamlet

@@ -0,0 +1,10 @@
+
+<p>
+  <form method=post action=@{ChallengeDiscussionR name}#form enctype=#{formEnctype}>
+    ^{formWidget}
+    <button .btn .btn-primary type="submit">
+       _{MsgSend} <span class="glyphicon glyphicon-upload"></span>
+
+<div .timeline-box>
+  $forall item <- sortedTimelineItems
+    ^{timelineItemWidget item}

templates/challenge.hamlet

@@ -8,6 +8,7 @@
      <li role="presentation"><a href="@{ChallengeSubmissionR (challengeName challenge)}">Submit</a>
      <li role="presentation"><a href="@{ChallengeMySubmissionsR (challengeName challenge)}">My Submissions</a>
      <li role="presentation"><a href="@{ChallengeAllSubmissionsR (challengeName challenge)}">All Submissions</a>
+     <li role="presentation"><a href="@{ChallengeDiscussionR (challengeName challenge)}">Discussion</a>
   <div .col-md-10 role="main">
     <div class="panel panel-default">
       <div class="panel-body">

templates/challenge.lucius

@@ -14,3 +14,20 @@
     height: 400px;
     margin: auto;
 }
+
+.timeline-box {
+    padding-top: 20px
+}
+
+.timeline-item {
+    padding-bottom: 40px
+}
+
+.timeline-item-thumbnail {
+    padding:0px;
+}
+.timeline-item-panel {
+}
+.timeline-item-panel-heading {
+    padding-bottom: 13px
+}

templates/timeline-item.hamlet

@@ -0,0 +1,12 @@
+$case item
+  $of TimelineItem when who what
+    <div class="row timeline-item">
+      <div class="col-sm-1">
+        <div class="timeline-item-thumbnail">
+          <img class="img-responsive user-photo" src="/static/images/male-avatar.svg">
+      <div class="col-sm-11">
+        <div .timeline-item-panel>
+          <div class="timeline-item-panel-heading">
+            <strong>#{formatSubmitter who}
+            <span class="text-muted">&nbsp;&nbsp;#{formatTime defaultTimeLocale "%Y-%m-%d %H:%M" when}
+          <div class="timeline-item-panel-body">#{what}