diff options
| -rw-r--r-- | lisp/klatre/klatre.lisp | 10 | ||||
| -rw-r--r-- | lisp/klatre/package.lisp | 5 | ||||
| -rw-r--r-- | web/panettone/src/css.lisp | 14 | ||||
| -rw-r--r-- | web/panettone/src/model.lisp | 17 | ||||
| -rw-r--r-- | web/panettone/src/packages.lisp | 13 | ||||
| -rw-r--r-- | web/panettone/src/panettone.lisp | 70 |
6 files changed, 94 insertions, 35 deletions
diff --git a/lisp/klatre/klatre.lisp b/lisp/klatre/klatre.lisp index 50cc510502e8..1c8d4c4d2e5b 100644 --- a/lisp/klatre/klatre.lisp +++ b/lisp/klatre/klatre.lisp @@ -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)))) diff --git a/lisp/klatre/package.lisp b/lisp/klatre/package.lisp index 2e6340167909..21f659ef18b1 100644 --- a/lisp/klatre/package.lisp +++ b/lisp/klatre/package.lisp @@ -10,4 +10,7 @@ ;; String handling #:+dottime-format+ #:format-dottime - #:try-parse-integer)) + #:try-parse-integer + + ;; Function utilities + #:partial)) diff --git a/web/panettone/src/css.lisp b/web/panettone/src/css.lisp index e7a2c814e754..fe6cad66b122 100644 --- a/web/panettone/src/css.lisp +++ b/web/panettone/src/css.lisp @@ -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" diff --git a/web/panettone/src/model.lisp b/web/panettone/src/model.lisp index 0f14cede4e5d..1ea0214f512a 100644 --- a/web/panettone/src/model.lisp +++ b/web/panettone/src/model.lisp @@ -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 ;;; diff --git a/web/panettone/src/packages.lisp b/web/panettone/src/packages.lisp index c5dd6aa5ae1e..327ea023b2c7 100644 --- a/web/panettone/src/packages.lisp +++ b/web/panettone/src/packages.lisp @@ -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)) diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp index 4dc00db23923..6be9cf659b7a 100644 --- a/web/panettone/src/panettone.lisp +++ b/web/panettone/src/panettone.lisp @@ -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))) |