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:
parent
8e7ba41a34
commit
94796399e2
6 changed files with 94 additions and 35 deletions
|
@ -94,3 +94,13 @@ separated by SEP."
|
||||||
(check-type str string)
|
(check-type str string)
|
||||||
(handler-case (parse-integer str)
|
(handler-case (parse-integer str)
|
||||||
(sb-int:simple-parse-error (_) nil)))
|
(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))))
|
||||||
|
|
|
@ -10,4 +10,7 @@
|
||||||
|
|
||||||
;; String handling
|
;; String handling
|
||||||
#:+dottime-format+ #:format-dottime
|
#:+dottime-format+ #:format-dottime
|
||||||
#:try-parse-integer))
|
#:try-parse-integer
|
||||||
|
|
||||||
|
;; Function utilities
|
||||||
|
#:partial))
|
||||||
|
|
|
@ -64,8 +64,9 @@
|
||||||
(.comment-count
|
(.comment-count
|
||||||
:color ,color/gray)))
|
:color ,color/gray)))
|
||||||
|
|
||||||
(defparameter comment-styles
|
(defparameter issue-history-styles
|
||||||
`((.issue-comments
|
`((.issue-history
|
||||||
|
:list-style "none"
|
||||||
:border-top "1px" "solid" ,color/gray
|
:border-top "1px" "solid" ,color/gray
|
||||||
:padding-top "1rem"
|
:padding-top "1rem"
|
||||||
:padding-left "2rem"
|
:padding-left "2rem"
|
||||||
|
@ -75,12 +76,15 @@
|
||||||
:margin 0
|
:margin 0
|
||||||
:padding-top "1rem")
|
:padding-top "1rem")
|
||||||
|
|
||||||
(.comment
|
((:or .comment .event)
|
||||||
:padding-top "1rem"
|
:padding-top "1rem"
|
||||||
:padding-bottom "1rem"
|
:padding-bottom "1rem"
|
||||||
:border-bottom "1px" "solid" ,color/gray
|
:border-bottom "1px" "solid" ,color/gray
|
||||||
|
|
||||||
(p :margin 0)))))
|
(p :margin 0))
|
||||||
|
|
||||||
|
(.event
|
||||||
|
:color ,color/gray))))
|
||||||
|
|
||||||
(defparameter form-styles
|
(defparameter form-styles
|
||||||
`(((:or (:and input (:or (:= type "text")
|
`(((:or (:and input (:or (:= type "text")
|
||||||
|
@ -129,7 +133,7 @@
|
||||||
`(,@form-styles
|
`(,@form-styles
|
||||||
,@issue-list-styles
|
,@issue-list-styles
|
||||||
,@issue-styles
|
,@issue-styles
|
||||||
,@comment-styles
|
,@issue-history-styles
|
||||||
|
|
||||||
(body
|
(body
|
||||||
:font-family "sans-serif"
|
:font-family "sans-serif"
|
||||||
|
|
|
@ -55,6 +55,7 @@
|
||||||
(body :col-type string :initarg :body :accessor body :col-default "")
|
(body :col-type string :initarg :body :accessor body :col-default "")
|
||||||
(author-dn :col-type string :initarg :author-dn :accessor author-dn)
|
(author-dn :col-type string :initarg :author-dn :accessor author-dn)
|
||||||
(comments :type list :accessor issue-comments)
|
(comments :type list :accessor issue-comments)
|
||||||
|
(events :type list :accessor issue-events)
|
||||||
(num-comments :type integer :accessor num-comments)
|
(num-comments :type integer :accessor num-comments)
|
||||||
(status :col-type issue_status
|
(status :col-type issue_status
|
||||||
:initarg :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))
|
:where (:= 'issue-id issue-id))
|
||||||
(:asc 'created-at))))
|
(: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
|
;;; Writing
|
||||||
;;;
|
;;;
|
||||||
|
|
|
@ -24,13 +24,15 @@
|
||||||
(:export
|
(:export
|
||||||
:connect-postgres :ddl/init
|
:connect-postgres :ddl/init
|
||||||
|
|
||||||
:issue
|
:issue :issue-comment :issue-event
|
||||||
:issue-comment
|
:id :subject :body :author-dn :issue-id :status :created-at :acting-user-dn
|
||||||
:id :subject :body :author-dn :issue-id :status :created-at
|
:field :previous-value :new-value
|
||||||
|
|
||||||
:get-issue :issue-exists-p :list-issues :create-issue :set-issue-status
|
:get-issue :issue-exists-p :list-issues :create-issue :set-issue-status
|
||||||
:delete-issue :issue-not-found
|
:delete-issue :issue-not-found
|
||||||
|
|
||||||
|
:issue-events
|
||||||
|
|
||||||
:issue-comments :num-comments :create-issue-comment))
|
:issue-comments :num-comments :create-issue-comment))
|
||||||
|
|
||||||
(defpackage panettone
|
(defpackage panettone
|
||||||
|
@ -38,10 +40,11 @@
|
||||||
:panettone.util
|
:panettone.util
|
||||||
:panettone.authentication)
|
:panettone.authentication)
|
||||||
(:import-from :defclass-std :defclass/std)
|
(:import-from :defclass-std :defclass/std)
|
||||||
(:import-from :alexandria :if-let :when-let)
|
(:import-from :alexandria :if-let :when-let :switch)
|
||||||
(:import-from
|
(:import-from
|
||||||
:panettone.model
|
:panettone.model
|
||||||
:id :subject :body :author-dn :issue-id :status :created-at
|
: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)
|
(:shadow :next)
|
||||||
(:export :start-pannetone :config :main))
|
(:export :start-pannetone :config :main))
|
||||||
|
|
|
@ -189,6 +189,36 @@
|
||||||
(:input :type "submit"
|
(:input :type "submit"
|
||||||
:value "Comment"))))
|
: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)
|
(defun render/issue (issue)
|
||||||
(check-type issue model:issue)
|
(check-type issue model:issue)
|
||||||
(let ((issue-id (id issue))
|
(let ((issue-id (id issue))
|
||||||
|
@ -220,22 +250,18 @@
|
||||||
(:open "Close")
|
(:open "Close")
|
||||||
(:closed "Reopen")))))))
|
(:closed "Reopen")))))))
|
||||||
(:p (who:esc (body issue)))
|
(: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
|
(who:htm
|
||||||
(:div
|
(:ol
|
||||||
:class "issue-comments"
|
:class "issue-history"
|
||||||
(dolist (comment comments)
|
(dolist (item history)
|
||||||
(let ((author (author comment)))
|
(render/issue-history-item item))
|
||||||
(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)))))))))
|
|
||||||
(when *user*
|
(when *user*
|
||||||
(render/new-comment (id issue))))))))))
|
(render/new-comment (id issue))))))))))
|
||||||
|
|
||||||
|
@ -321,14 +347,10 @@
|
||||||
(defroute show-issue
|
(defroute show-issue
|
||||||
("/issues/:id" :decorators (@auth-optional @handle-issue-not-found))
|
("/issues/:id" :decorators (@auth-optional @handle-issue-not-found))
|
||||||
(&path (id 'integer))
|
(&path (id 'integer))
|
||||||
(handler-case
|
(let* ((issue (model:get-issue id))
|
||||||
(let* ((issue (model:get-issue id))
|
(*title* (format nil "~A | Panettone"
|
||||||
(*title* (format nil "~A | Panettone"
|
(subject issue))))
|
||||||
(subject issue))))
|
(render/issue issue)))
|
||||||
(render/issue issue))
|
|
||||||
(issue-not-found (_)
|
|
||||||
(declare (ignore _))
|
|
||||||
(render/not-found "Issue"))))
|
|
||||||
|
|
||||||
(defroute handle-create-comment
|
(defroute handle-create-comment
|
||||||
("/issues/:id/comments"
|
("/issues/:id/comments"
|
||||||
|
@ -356,7 +378,7 @@
|
||||||
|
|
||||||
(defroute open-issue
|
(defroute open-issue
|
||||||
("/issues/:id/open" :decorators (@auth)
|
("/issues/:id/open" :decorators (@auth)
|
||||||
:method :put)
|
:method :post)
|
||||||
(&path (id 'integer))
|
(&path (id 'integer))
|
||||||
(model:set-issue-status id :open)
|
(model:set-issue-status id :open)
|
||||||
(hunchentoot:redirect (format nil "/issues/~A" id)))
|
(hunchentoot:redirect (format nil "/issues/~A" id)))
|
||||||
|
|
Loading…
Reference in a new issue