diff options
Diffstat (limited to 'Omni/Jr')
| -rw-r--r-- | Omni/Jr/Web.hs | 45 | ||||
| -rw-r--r-- | Omni/Jr/Web/Style.hs | 45 |
2 files changed, 90 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 diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs index fbaaa82..11475d9 100644 --- a/Omni/Jr/Web/Style.hs +++ b/Omni/Jr/Web/Style.hs @@ -35,6 +35,7 @@ stylesheet = do commitStyles markdownStyles retryBannerStyles + commentStyles taskMetaStyles timeFilterStyles sortDropdownStyles @@ -1247,6 +1248,41 @@ retryBannerStyles = do color "#991b1b" fontWeight (weight 500) +commentStyles :: Css +commentStyles = do + ".comments-section" ? do + marginTop (px 12) + ".comment-card" ? do + backgroundColor "#f9fafb" + border (px 1) solid "#e5e7eb" + borderRadius (px 4) (px 4) (px 4) (px 4) + padding (px 10) (px 12) (px 10) (px 12) + marginBottom (px 8) + ".comment-text" ? do + margin (px 0) (px 0) (px 6) (px 0) + fontSize (px 13) + color "#374151" + whiteSpace preWrap + ".comment-time" ? do + fontSize (px 11) + color "#9ca3af" + ".comment-form" ? do + marginTop (px 12) + display flex + flexDirection column + Stylesheet.key "gap" ("8px" :: Text) + ".comment-textarea" ? do + width (pct 100) + padding (px 8) (px 10) (px 8) (px 10) + fontSize (px 13) + border (px 1) solid "#d0d0d0" + borderRadius (px 4) (px 4) (px 4) (px 4) + Stylesheet.key "resize" ("vertical" :: Text) + minHeight (px 60) + ".comment-textarea" # focus ? do + Stylesheet.key "outline" ("none" :: Text) + borderColor "#0066cc" + timeFilterStyles :: Css timeFilterStyles = do ".time-filter" ? do @@ -1624,6 +1660,15 @@ darkModeStyles = borderColor "#6b7280" ".sort-dropdown-item.active" ? do backgroundColor "#1e3a5f" + ".comment-card" ? do + backgroundColor "#374151" + borderColor "#4b5563" + ".comment-text" ? color "#d1d5db" + ".comment-time" ? color "#9ca3af" + ".comment-textarea" ? do + backgroundColor "#374151" + borderColor "#4b5563" + color "#f3f4f6" -- Responsive dark mode: dropdown content needs background on mobile query Media.screen [Media.maxWidth (px 600)] <| do ".navbar-dropdown-content" ? do |
