feat(web/panettone): Allow editing issues
Allow editing both the subject and the body of issues, recording events indicating the edit and displaying those events in the issue history. Fixes: #14 Change-Id: I9ed05271ce9bf6bda4e56f15e249c0f28c862b27 Reviewed-on: https://cl.tvl.fyi/c/depot/+/1517 Tested-by: BuildkiteCI Reviewed-by: tazjin <mail@tazj.in>
This commit is contained in:
Griffin Smith
glittershark
parent
2646e57aae
commit
b6bab664db
4 changed files with 146 additions and 41 deletions
|
|
@ -4,6 +4,9 @@
|
|||
(defparameter color/black
|
||||
"rgb(24, 24, 24)")
|
||||
|
||||
(defparameter color/light-gray
|
||||
"#EEE")
|
||||
|
||||
(defparameter color/gray
|
||||
"#8D8D8D")
|
||||
|
||||
|
|
@ -105,7 +108,8 @@
|
|||
((:and input (:= type "submit"))
|
||||
:-webkit-appearance "none"
|
||||
:border "none"
|
||||
:cursor "pointer")
|
||||
:cursor "pointer"
|
||||
:font-size "1rem")
|
||||
|
||||
,@(button '(:and input (:= type "submit")))
|
||||
|
||||
|
|
@ -126,6 +130,16 @@
|
|||
:justify-content "space-between"
|
||||
:align-items "center"
|
||||
|
||||
,@(button '.edit-issue)
|
||||
|
||||
(.created-by-at
|
||||
:flex 1)
|
||||
|
||||
(.edit-issue
|
||||
:background-color ,color/light-gray
|
||||
:flex 0
|
||||
:margin-right "0.5rem")
|
||||
|
||||
(.close-issue
|
||||
:background-color ,color/failure))))
|
||||
|
||||
|
|
|
|||
|
|
@ -74,6 +74,9 @@
|
|||
(cl-postgres:to-sql-string "open"))
|
||||
(defmethod cl-postgres:to-sql-string ((kw (eql :closed)))
|
||||
(cl-postgres:to-sql-string "closed"))
|
||||
(defmethod cl-postgres:to-sql-string ((ts local-time:timestamp))
|
||||
(cl-postgres:to-sql-string
|
||||
(local-time:timestamp-to-unix ts)))
|
||||
|
||||
(defmethod initialize-instance :after
|
||||
((issue issue) &rest initargs &key &allow-other-keys)
|
||||
|
|
@ -292,6 +295,29 @@ the issue doesn't exist, signals `issue-not-found'"
|
|||
:new-value status)
|
||||
(values)))
|
||||
|
||||
(defun update-issue (issue &rest attrs)
|
||||
"Update the fields of ISSUE with the given ATTRS, which is a plist of slot and
|
||||
value, and record events for the updates"
|
||||
(let ((set-fields
|
||||
(iter (for slot in '(subject body))
|
||||
(for new-value = (getf attrs slot))
|
||||
(appending
|
||||
(let ((previous-value (slot-value issue slot)))
|
||||
(when (and new-value (not (equalp
|
||||
new-value
|
||||
previous-value)))
|
||||
(record-issue-event (id issue)
|
||||
:field slot
|
||||
:previous-value previous-value
|
||||
:new-value new-value)
|
||||
(setf (slot-value issue slot) new-value)
|
||||
(list slot new-value)))))))
|
||||
(execute
|
||||
(sql-compile
|
||||
`(:update issues
|
||||
:set ,@set-fields
|
||||
:where (:= id ,(id issue)))))))
|
||||
|
||||
(defun create-issue-comment (&rest attrs &key issue-id &allow-other-keys)
|
||||
"Insert a new issue comment into the database with the given ATTRS and
|
||||
ISSUE-ID, which should be a plist of initforms, and return an instance of
|
||||
|
|
|
|||
|
|
@ -19,8 +19,8 @@
|
|||
|
||||
(defpackage panettone.model
|
||||
(:nicknames :model)
|
||||
(:use :cl :panettone.util :klatre :postmodern)
|
||||
(:import-from :alexandria :if-let :define-constant)
|
||||
(:use :cl :panettone.util :klatre :postmodern :iterate)
|
||||
(:import-from :alexandria :if-let :when-let :define-constant)
|
||||
(:export
|
||||
:connect-postgres :ddl/init
|
||||
|
||||
|
|
@ -29,7 +29,7 @@
|
|||
:field :previous-value :new-value
|
||||
|
||||
:get-issue :issue-exists-p :list-issues :create-issue :set-issue-status
|
||||
:delete-issue :issue-not-found
|
||||
:update-issue :delete-issue :issue-not-found
|
||||
|
||||
:issue-events
|
||||
|
||||
|
|
|
|||
|
|
@ -107,6 +107,20 @@
|
|||
(when ,footer
|
||||
(render/footer-nav)))))))
|
||||
|
||||
(defun form-button (&key
|
||||
class
|
||||
input-class
|
||||
href
|
||||
label
|
||||
(method "post"))
|
||||
(who:with-html-output (*standard-output*)
|
||||
(:form :class class
|
||||
:method method
|
||||
:action href
|
||||
(:input :type "submit"
|
||||
:class input-class
|
||||
:value label))))
|
||||
|
||||
(defun render/alert (message)
|
||||
"Render an alert box for MESSAGE, if non-null"
|
||||
(check-type message (or null string))
|
||||
|
|
@ -209,28 +223,38 @@
|
|||
(:a :href "/" "View open isues"))
|
||||
(render/issue-list :issues issues))))
|
||||
|
||||
(defun render/new-issue (&optional message)
|
||||
(defun render/issue-form (&optional issue message)
|
||||
(render ()
|
||||
(:header
|
||||
(:h1 "New Issue"))
|
||||
(:h1
|
||||
(who:esc
|
||||
(if (id issue) "Edit Issue" "New Issue"))))
|
||||
(:main
|
||||
(render/alert message)
|
||||
(:form :method "post"
|
||||
:action "/issues"
|
||||
:action (if (id issue)
|
||||
(format nil "/issues/~A"
|
||||
(id issue))
|
||||
"/issues")
|
||||
:class "issue-form"
|
||||
(:div
|
||||
(:input :type "text"
|
||||
:id "subject"
|
||||
:name "subject"
|
||||
:placeholder "Subject"))
|
||||
:placeholder "Subject"
|
||||
:value (subject issue)))
|
||||
|
||||
(:div
|
||||
(:textarea :name "body"
|
||||
:placeholder "Description"
|
||||
:rows 10))
|
||||
:rows 10
|
||||
(who:esc (body issue))))
|
||||
|
||||
(:input :type "submit"
|
||||
:value "Create Issue")))))
|
||||
:value
|
||||
(if (id issue)
|
||||
"Save Issue"
|
||||
"Create Issue"))))))
|
||||
|
||||
(defun render/new-comment (issue-id)
|
||||
(who:with-html-output (*standard-output*)
|
||||
|
|
@ -261,19 +285,28 @@
|
|||
(who:esc (format-dottime (created-at comment)))))))))
|
||||
|
||||
(defmethod render/issue-history-item ((event model:issue-event))
|
||||
(when (string= (field event) "STATUS")
|
||||
(let ((user (find-user-by-dn (acting-user-dn event))))
|
||||
(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)))))))))
|
||||
(:li
|
||||
:class "event"
|
||||
(who:esc (displayname user))
|
||||
(if (string= (field event) "STATUS")
|
||||
(who:htm
|
||||
(who:esc
|
||||
(switch ((new-value event) :test #'string=)
|
||||
("OPEN" " reopened ")
|
||||
("CLOSED" " closed ")))
|
||||
" this issue ")
|
||||
(who:htm
|
||||
" changed the "
|
||||
(who:esc (string-downcase (field event)))
|
||||
" of this issue from \""
|
||||
(who:esc (previous-value event))
|
||||
"\" to \""
|
||||
(who:esc (new-value event))
|
||||
"\""))
|
||||
" at "
|
||||
(who:esc (format-dottime (created-at event)))))))
|
||||
|
||||
(defun render/issue (issue)
|
||||
(check-type issue model:issue)
|
||||
|
|
@ -291,20 +324,26 @@
|
|||
|
||||
(when *user*
|
||||
(who:htm
|
||||
(:form :class "set-issue-status"
|
||||
:method "post"
|
||||
:action (format nil "/issues/~A/~A"
|
||||
issue-id
|
||||
(case issue-status
|
||||
(:open "close")
|
||||
(:closed "open")))
|
||||
(:input :type "submit"
|
||||
:class (case issue-status
|
||||
(:open "close-issue")
|
||||
(:closed "open-issue"))
|
||||
:value (case issue-status
|
||||
(:open "Close")
|
||||
(:closed "Reopen")))))))
|
||||
(when (string= (author-dn issue)
|
||||
(dn *user*))
|
||||
(who:htm
|
||||
(:a :class "edit-issue"
|
||||
:href (format nil "/issues/~A/edit"
|
||||
issue-id)
|
||||
"Edit")))
|
||||
(form-button
|
||||
:class "set-issue-status"
|
||||
:href (format nil "/issues/~A/~A"
|
||||
issue-id
|
||||
(case issue-status
|
||||
(:open "close")
|
||||
(:closed "open")))
|
||||
:input-class (case issue-status
|
||||
(:open "close-issue")
|
||||
(:closed "open-issue"))
|
||||
:label (case issue-status
|
||||
(:open "Close")
|
||||
(:closed "Reopen"))))))
|
||||
(:p (who:str (render-markdown (body issue))))
|
||||
(let* ((comments (issue-comments issue))
|
||||
(events (issue-events issue))
|
||||
|
|
@ -388,17 +427,19 @@
|
|||
(render/closed-issues :issues issues)))
|
||||
|
||||
(defroute new-issue ("/issues/new" :decorators (@auth)) ()
|
||||
(render/new-issue))
|
||||
(render/issue-form))
|
||||
|
||||
(defroute handle-create-issue
|
||||
("/issues" :method :post :decorators (@auth @txn))
|
||||
(&post subject body)
|
||||
(if (string= subject "")
|
||||
(render/new-issue "Subject is required")
|
||||
(render/issue-form
|
||||
(make-instance 'model:issue :subject subject :body body)
|
||||
"Subject is required")
|
||||
(progn
|
||||
(model:create-issue :subject subject
|
||||
:body body
|
||||
:author-dn (dn *user*))
|
||||
:body body
|
||||
:author-dn (dn *user*))
|
||||
(hunchentoot:redirect "/"))))
|
||||
|
||||
(defroute show-issue
|
||||
|
|
@ -409,6 +450,30 @@
|
|||
(subject issue))))
|
||||
(render/issue issue)))
|
||||
|
||||
(defroute edit-issue
|
||||
("/issues/:id/edit" :decorators (@auth @handle-issue-not-found))
|
||||
(&path (id 'integer))
|
||||
(let* ((issue (model:get-issue id))
|
||||
(*title* "Edit Issue | Panettone"))
|
||||
(render/issue-form issue)))
|
||||
|
||||
(defroute update-issue
|
||||
("/issues/:id" :decorators (@auth @handle-issue-not-found @txn)
|
||||
;; NOTE: this should be a put, but we're all HTML forms
|
||||
;; right now and those don't support PUT
|
||||
:method :post)
|
||||
(&path (id 'integer) &post subject body)
|
||||
(let ((issue (model:get-issue id)))
|
||||
;; only the original author can edit an issue
|
||||
(if (string-equal (author-dn issue)
|
||||
(dn *user*))
|
||||
(progn
|
||||
(model:update-issue issue
|
||||
'model:subject subject
|
||||
'model:body body)
|
||||
(hunchentoot:redirect (format nil "/issues/~A" id)))
|
||||
(render/not-found "Issue"))))
|
||||
|
||||
(defroute handle-create-comment
|
||||
("/issues/:id/comments"
|
||||
:decorators (@auth @handle-issue-not-found @txn)
|
||||
|
|
@ -435,7 +500,7 @@
|
|||
|
||||
(defroute open-issue
|
||||
("/issues/:id/open" :decorators (@auth)
|
||||
:method :post)
|
||||
:method :post)
|
||||
(&path (id 'integer))
|
||||
(model:set-issue-status id :open)
|
||||
(hunchentoot:redirect (format nil "/issues/~A" id)))
|
||||
|
|
|
|||
Loading…
Reference in a new issue