diff options
Diffstat (limited to 'Omni/Jr/Web.hs')
| -rw-r--r-- | Omni/Jr/Web.hs | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index 44e616a..7ca4a9f 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -223,6 +223,7 @@ type API = :<|> "tasks" :> Capture "id" Text :> "description" :> "edit" :> Get '[Lucid.HTML] DescriptionEditPartial :<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> Post '[Lucid.HTML] DescriptionViewPartial :<|> "tasks" :> Capture "id" Text :> "notes" :> ReqBody '[FormUrlEncoded] NotesForm :> PostRedirect + :<|> "tasks" :> Capture "id" Text :> "comment" :> ReqBody '[FormUrlEncoded] CommentForm :> PostRedirect :<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage :<|> "tasks" :> Capture "id" Text :> "diff" :> Capture "commit" Text :> Get '[Lucid.HTML] TaskDiffPage :<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect @@ -370,6 +371,13 @@ instance FromForm NotesForm where notes <- parseUnique "notes" form Right (NotesForm notes) +newtype CommentForm = CommentForm Text + +instance FromForm CommentForm where + fromForm form = do + commentText <- parseUnique "comment" form + Right (CommentForm commentText) + pageHead :: (Monad m) => Text -> Lucid.HtmlT m () pageHead title = Lucid.head_ <| do @@ -1473,6 +1481,14 @@ instance Lucid.ToHtml TaskDetailPage where Lucid.div_ [Lucid.class_ "detail-section"] <| do Lucid.toHtml (DescriptionViewPartial (TaskCore.taskId task) (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic)) + let comments = TaskCore.taskComments task + Lucid.div_ [Lucid.class_ "detail-section comments-section"] <| do + Lucid.h3_ (Lucid.toHtml ("Comments (" <> tshow (length comments) <> ")")) + if null comments + then Lucid.p_ [Lucid.class_ "empty-msg"] "No comments yet." + else traverse_ (renderComment now) comments + commentForm (TaskCore.taskId task) + let children = filter (maybe False (TaskCore.matchesId (TaskCore.taskId task)) <. TaskCore.taskParent) allTasks unless (null children) <| do Lucid.div_ [Lucid.class_ "detail-section"] <| do @@ -1528,6 +1544,29 @@ instance Lucid.ToHtml TaskDetailPage where Lucid.span_ [Lucid.class_ "child-title"] <| Lucid.toHtml (" - " <> TaskCore.taskTitle child) Lucid.span_ [Lucid.class_ "child-status"] <| Lucid.toHtml (" [" <> tshow (TaskCore.taskStatus child) <> "]") + renderComment :: (Monad m) => UTCTime -> TaskCore.Comment -> Lucid.HtmlT m () + renderComment currentTime c = + Lucid.div_ [Lucid.class_ "comment-card"] <| do + Lucid.p_ [Lucid.class_ "comment-text"] (Lucid.toHtml (TaskCore.commentText c)) + Lucid.span_ [Lucid.class_ "comment-time"] (renderRelativeTimestamp currentTime (TaskCore.commentCreatedAt c)) + + commentForm :: (Monad m) => Text -> Lucid.HtmlT m () + commentForm tid = + Lucid.form_ + [ Lucid.method_ "POST", + Lucid.action_ ("/tasks/" <> tid <> "/comment"), + Lucid.class_ "comment-form" + ] + <| do + Lucid.textarea_ + [ Lucid.name_ "comment", + Lucid.placeholder_ "Add a comment...", + Lucid.rows_ "3", + Lucid.class_ "comment-textarea" + ] + "" + Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Post Comment" + renderCommit :: (Monad m) => Text -> GitCommit -> Lucid.HtmlT m () renderCommit tid c = Lucid.div_ [Lucid.class_ "commit-item"] <| do @@ -2337,6 +2376,7 @@ server = :<|> descriptionEditHandler :<|> descriptionPostHandler :<|> taskNotesHandler + :<|> taskCommentHandler :<|> taskReviewHandler :<|> taskDiffHandler :<|> taskAcceptHandler @@ -2548,6 +2588,11 @@ server = liftIO <| TaskCore.updateRetryNotes tid notes pure <| addHeader ("/tasks/" <> tid) NoContent + taskCommentHandler :: Text -> CommentForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent) + taskCommentHandler tid (CommentForm commentText) = do + _ <- liftIO (TaskCore.addComment tid commentText) + pure <| addHeader ("/tasks/" <> tid) NoContent + taskReviewHandler :: Text -> Servant.Handler TaskReviewPage taskReviewHandler tid = do tasks <- liftIO TaskCore.loadTasks |