feat(web/panettone): Display issue history

Display the history of an issue (which currently is just opening and
closing) inline with the issue's comments on the issue show page

Change-Id: Id167bceef765cb4c24e86983d1dcd6624d0e5956
Reviewed-on: https://cl.tvl.fyi/c/depot/+/1497
Tested-by: BuildkiteCI
Reviewed-by: tazjin <mail@tazj.in>
This commit is contained in:
Griffin Smith 2020-07-28 18:29:30 -04:00 committed by glittershark
parent 8e7ba41a34
commit 94796399e2
6 changed files with 94 additions and 35 deletions

View file

@ -94,3 +94,13 @@ separated by SEP."
(check-type str string)
(handler-case (parse-integer str)
(sb-int:simple-parse-error (_) nil)))
;;;
;;; Function utilities
;;;
(defun partial (f &rest args)
"Return a function that calls F with ARGS prepended to any remaining
arguments"
(lambda (&rest more-args)
(apply f (append args more-args))))

View file

@ -10,4 +10,7 @@
;; String handling
#:+dottime-format+ #:format-dottime
#:try-parse-integer))
#:try-parse-integer
;; Function utilities
#:partial))

View file

@ -64,8 +64,9 @@
(.comment-count
:color ,color/gray)))
(defparameter comment-styles
`((.issue-comments
(defparameter issue-history-styles
`((.issue-history
:list-style "none"
:border-top "1px" "solid" ,color/gray
:padding-top "1rem"
:padding-left "2rem"
@ -75,12 +76,15 @@
:margin 0
:padding-top "1rem")
(.comment
((:or .comment .event)
:padding-top "1rem"
:padding-bottom "1rem"
:border-bottom "1px" "solid" ,color/gray
(p :margin 0)))))
(p :margin 0))
(.event
:color ,color/gray))))
(defparameter form-styles
`(((:or (:and input (:or (:= type "text")
@ -129,7 +133,7 @@
`(,@form-styles
,@issue-list-styles
,@issue-styles
,@comment-styles
,@issue-history-styles
(body
:font-family "sans-serif"

View file

@ -55,6 +55,7 @@
(body :col-type string :initarg :body :accessor body :col-default "")
(author-dn :col-type string :initarg :author-dn :accessor author-dn)
(comments :type list :accessor issue-comments)
(events :type list :accessor issue-events)
(num-comments :type integer :accessor num-comments)
(status :col-type issue_status
:initarg :status
@ -221,6 +222,22 @@ NOTE: This makes a database query, so be wary of N+1 queries"
:where (:= 'issue-id issue-id))
(:asc 'created-at))))
(defmethod slot-unbound (cls (issue issue) (slot (eql 'events)))
(declare (ignore cls) (ignore slot))
(setf (issue-events issue) (issue-events (id issue))))
(defmethod issue-events ((issue-id integer))
"Return a list of all events with the given ISSUE-ID, sorted oldest first.
NOTE: This makes a database query, so be wary of N+1 queries"
(query-dao
'issue-event
(:order-by
(:select '*
:from 'issue-events
:where (:= 'issue-id issue-id))
(:asc 'created-at))))
;;;
;;; Writing
;;;

View file

@ -24,13 +24,15 @@
(:export
:connect-postgres :ddl/init
:issue
:issue-comment
:id :subject :body :author-dn :issue-id :status :created-at
:issue :issue-comment :issue-event
:id :subject :body :author-dn :issue-id :status :created-at :acting-user-dn
:field :previous-value :new-value
:get-issue :issue-exists-p :list-issues :create-issue :set-issue-status
:delete-issue :issue-not-found
:issue-events
:issue-comments :num-comments :create-issue-comment))
(defpackage panettone
@ -38,10 +40,11 @@
:panettone.util
:panettone.authentication)
(:import-from :defclass-std :defclass/std)
(:import-from :alexandria :if-let :when-let)
(:import-from :alexandria :if-let :when-let :switch)
(:import-from
:panettone.model
:id :subject :body :author-dn :issue-id :status :created-at
:issue-comments :num-comments)
:field :previous-value :new-value :acting-user-dn
:issue-comments :num-comments :issue-events)
(:shadow :next)
(:export :start-pannetone :config :main))

View file

@ -189,6 +189,36 @@
(:input :type "submit"
:value "Comment"))))
(defgeneric render/issue-history-item (item))
(defmethod render/issue-history-item ((comment model:issue-comment))
(who:with-html-output (*standard-output*)
(who:htm
(:li
:class "comment"
(:p (who:esc (body comment)))
(:p
:class "comment-info"
(:span :class "username"
(who:esc (displayname (author comment)))
" at "
(who:esc (format-dottime (created-at comment)))))))))
(defmethod render/issue-history-item ((event model:issue-event))
(when (string= (field event) "STATUS")
(who:with-html-output (*standard-output*)
(let ((user (find-user-by-dn (acting-user-dn event))))
(who:htm
(:li
:class "event"
(who:esc (displayname user))
(who:esc
(switch ((new-value event) :test #'string=)
("OPEN" " reopened ")
("CLOSED" " closed ")))
" this issue at "
(who:esc (format-dottime (created-at event)))))))))
(defun render/issue (issue)
(check-type issue model:issue)
(let ((issue-id (id issue))
@ -220,22 +250,18 @@
(:open "Close")
(:closed "Reopen")))))))
(:p (who:esc (body issue)))
(let ((comments (issue-comments issue)))
(let* ((comments (issue-comments issue))
(events (issue-events issue))
(history (merge 'list
comments
events
#'local-time:timestamp<
:key #'created-at)))
(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)))))))))
(:ol
:class "issue-history"
(dolist (item history)
(render/issue-history-item item))
(when *user*
(render/new-comment (id issue))))))))))
@ -321,14 +347,10 @@
(defroute show-issue
("/issues/:id" :decorators (@auth-optional @handle-issue-not-found))
(&path (id 'integer))
(handler-case
(let* ((issue (model:get-issue id))
(*title* (format nil "~A | Panettone"
(subject issue))))
(render/issue issue))
(issue-not-found (_)
(declare (ignore _))
(render/not-found "Issue"))))
(let* ((issue (model:get-issue id))
(*title* (format nil "~A | Panettone"
(subject issue))))
(render/issue issue)))
(defroute handle-create-comment
("/issues/:id/comments"
@ -356,7 +378,7 @@
(defroute open-issue
("/issues/:id/open" :decorators (@auth)
:method :put)
:method :post)
(&path (id 'integer))
(model:set-issue-status id :open)
(hunchentoot:redirect (format nil "/issues/~A" id)))