From a107d8e335e331d445f857e1be4a9108a7dd3c8b Mon Sep 17 00:00:00 2001
From: Griffin Smith <grfn@gws.fyi>
Date: Wed, 22 Jul 2020 21:43:30 -0400
Subject: 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>
---
 web/panettone/src/css.lisp       | 24 +++++++++++++++-
 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 f20ddf1dd4..3f8e33826c 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 288f278f12..e8b948fc33 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))
-- 
cgit 1.4.1