diff options
author | Griffin Smith <grfn@gws.fyi> | 2020-07-23T01·43-0400 |
---|---|---|
committer | glittershark <grfn@gws.fyi> | 2020-07-23T22·20+0000 |
commit | a107d8e335e331d445f857e1be4a9108a7dd3c8b (patch) | |
tree | 2325f4aa3b04f820c1b4228a16e8a143c07343fb | |
parent | d445136140cbd89599940c489efecefa544d1bd6 (diff) |
feat(web/panettone): Add support for comments r/1443
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>
-rw-r--r-- | web/panettone/src/css.lisp | 24 | ||||
-rw-r--r-- | web/panettone/src/panettone.lisp | 61 |
2 files changed, 78 insertions, 7 deletions
diff --git a/web/panettone/src/css.lisp b/web/panettone/src/css.lisp index f20ddf1dd4b0..3f8e33826ce7 100644 --- a/web/panettone/src/css.lisp +++ b/web/panettone/src/css.lisp @@ -57,7 +57,28 @@ :outline "none" (.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 `(((:or (:and input (:or (:= type "text") @@ -85,6 +106,7 @@ (defparameter styles `(,@form-styles ,@issue-list-styles + ,@comment-styles (body :font-family "sans-serif" diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp index 288f278f12da..e8b948fc3394 100644 --- a/web/panettone/src/panettone.lisp +++ b/web/panettone/src/panettone.lisp @@ -8,7 +8,8 @@ (defclass/std issue-comment () ((body :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) ((subject body :type string :std "") @@ -234,7 +235,14 @@ updated issue" (:span :class "issue-number" (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 () (render @@ -258,9 +266,18 @@ updated issue" (:input :type "submit" :value "Create Issue"))))) -(comment - (format nil "foo: ~A" "foo") - ) +(defun render/new-comment (issue-id) + (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) (check-type issue issue) @@ -271,7 +288,24 @@ updated issue" (who:esc (format nil "#~A" (get-id issue))))) (:main (: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) (render @@ -326,6 +360,21 @@ updated issue" (issue-not-found (_) (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") () (setf (hunchentoot:content-type*) "text/css") (apply #'lass:compile-and-write panettone.css:styles)) |