feat(web/panettone): Add support for comments

Add a new-comment form and list all issue comments on the issue page

Change-Id: Ia74083484614ba0ca0f2879276f717f709d0f42f
Reviewed-on: https://cl.tvl.fyi/c/depot/+/1351
Tested-by: BuildkiteCI
Reviewed-by: eta <eta@theta.eu.org>
This commit is contained in:
Griffin Smith 2020-07-22 21:43:30 -04:00 committed by glittershark
parent d445136140
commit a107d8e335
2 changed files with 78 additions and 7 deletions

View file

@ -57,7 +57,28 @@
:outline "none" :outline "none"
(.issue-subject (.issue-subject
:color ,color/primary))))) :color ,color/primary)))
(.comment-count
:color ,color/gray)))
(defparameter comment-styles
`((.issue-comments
:border-top "1px" "solid" ,color/gray
:padding-top "1rem"
:padding-left "2rem"
(.comment-info
:color ,color/gray
:margin 0
:padding-top "1rem")
(.comment
:padding-top "1rem"
:padding-bottom "1rem"
:border-bottom "1px" "solid" ,color/gray
(p :margin 0)))))
(defparameter form-styles (defparameter form-styles
`(((:or (:and input (:or (:= type "text") `(((:or (:and input (:or (:= type "text")
@ -85,6 +106,7 @@
(defparameter styles (defparameter styles
`(,@form-styles `(,@form-styles
,@issue-list-styles ,@issue-list-styles
,@comment-styles
(body (body
:font-family "sans-serif" :font-family "sans-serif"

View file

@ -8,7 +8,8 @@
(defclass/std issue-comment () (defclass/std issue-comment ()
((body :type string) ((body :type string)
(author-dn :type string) (author-dn :type string)
(created-at :type local-time:timestamp))) (created-at :type local-time:timestamp
:std (local-time:now))))
(defclass/std issue (cl-prevalence:object-with-id) (defclass/std issue (cl-prevalence:object-with-id)
((subject body :type string :std "") ((subject body :type string :std "")
@ -234,7 +235,14 @@ updated issue"
(:span :class "issue-number" (:span :class "issue-number"
(who:esc (format nil "#~A" issue-id))) (who:esc (format nil "#~A" issue-id)))
" - " " - "
(created-by-at issue)))))))))) (created-by-at issue)
(let ((num-comments (length (issue-comments issue))))
(unless (zerop num-comments)
(who:htm
(:span :class "comment-count"
" - "
(who:esc
(format nil "~A comment~:p" num-comments)))))))))))))))
(defun render/new-issue () (defun render/new-issue ()
(render (render
@ -258,9 +266,18 @@ updated issue"
(:input :type "submit" (:input :type "submit"
:value "Create Issue"))))) :value "Create Issue")))))
(comment (defun render/new-comment (issue-id)
(format nil "foo: ~A" "foo") (who:with-html-output (*standard-output*)
) (:form
:class "new-comment"
:method "post"
:action (format nil "/issues/~A/comments" issue-id)
(:div
(:textarea :name "body"
:placeholder "Leave a comment"
:rows 5))
(:input :type "submit"
:value "Comment"))))
(defun render/issue (issue) (defun render/issue (issue)
(check-type issue issue) (check-type issue issue)
@ -271,7 +288,24 @@ updated issue"
(who:esc (format nil "#~A" (get-id issue))))) (who:esc (format nil "#~A" (get-id issue)))))
(:main (:main
(:p (created-by-at issue)) (:p (created-by-at issue))
(:p (who:esc (body issue)))))) (:p (who:esc (body issue)))
(let ((comments (issue-comments issue)))
(who:htm
(:div
:class "issue-comments"
(dolist (comment comments)
(let ((author (author comment)))
(who:htm
(:div
:class "comment"
(:p (who:esc (body comment)))
(:p
:class "comment-info"
(:span :class "username"
(who:esc (displayname author))
" at "
(who:esc (format-dottime (created-at comment)))))))))
(render/new-comment (get-id issue))))))))
(defun render/not-found (entity-type) (defun render/not-found (entity-type)
(render (render
@ -326,6 +360,21 @@ updated issue"
(issue-not-found (_) (issue-not-found (_)
(render/not-found "Issue")))) (render/not-found "Issue"))))
(defroute handle-create-comment
("/issues/:id/comments" :decorators (@auth)
:method :post)
(&path (id 'integer) &post body)
(handler-case
(progn
(cl-prevalence:execute-transaction
(add-comment *p-system* id
:body body
:author-dn (dn *user*)))
(cl-prevalence:snapshot *p-system*)
(hunchentoot:redirect (format nil "/issues/~A" id)))
(issue-not-found (_)
(render/not-found "Issue"))))
(defroute styles ("/main.css") () (defroute styles ("/main.css") ()
(setf (hunchentoot:content-type*) "text/css") (setf (hunchentoot:content-type*) "text/css")
(apply #'lass:compile-and-write panettone.css:styles)) (apply #'lass:compile-and-write panettone.css:styles))