mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

revert: "feat(web/panettone): Allow requesting JSON"

Browse source 
This reverts commit 77c09076ec.

Reason for revert: It doesn't work - attempting to request any of the pages now gives:

[ERROR]] No keys match in SWITCH. Testing against
         "text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9"
         with EQUAL.

Change-Id: Ic4c795fd2a971003a6823a3b68ddee9a03b9f7c9
Reviewed-on: https://cl.tvl.fyi/c/depot/+/3061
Reviewed-by: tazjin <mail@tazj.in>
Tested-by: BuildkiteCI
This commit is contained in:
grfn 2021-04-30 11:51:51 +00:00
parent 216c3f73b9
commit 17239c597d
2 changed files with 4 additions and 41 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
web/panettone/src/packages.lisp
View file

@ -69,11 +69,9 @@
:panettone.authentication
:panettone.inline-markdown)
(:import-from :defclass-std :defclass/std)
(:import-from :alexandria :if-let :when-let :switch :alist-hash-table
:assoc-value :eswitch)
(:import-from :alexandria :if-let :when-let :switch :alist-hash-table)
(:import-from :cl-ppcre :split)
(:import-from :bordeaux-threads :make-thread)
(:import-from :cl-json :encode-json :encode-json-to-string)
(:import-from
:panettone.model
:id :subject :body :author-dn :issue-id :status :created-at

41
web/panettone/src/panettone.lisp
View file

@ -50,43 +50,12 @@
markdown-body)))))
(values))
;;;
;;; Responses
;;;
(defun request-format ()
"Returns the content type requested by the current hunchentoot request as a
symbol equal to either `:html' or `:json', defaulting to `:html' if not
specified."
(eswitch ((hunchentoot:header-in* :accept) :test #'equal)
("application/json" :json)
("text/html" :html)
("*/*" :html)))
(defun format->mime (format)
(ecase format
(:json "application/json")
(:html "text/html")))
(defmacro format-case (&rest clauses)
"Execute the cdr of the element in CLAUSES whose car is equal to the current
request format, a symbol that can be either `:JSON' or `:HTML'"
(let ((format (gensym "format")))
`(let ((,format (request-format)))
(setf (hunchentoot:content-type*) (format->mime ,format))
(case ,format ,@clauses))))
(defmethod encode-json ((ts local-time:timestamp)
&optional (stream json:*json-output*))
(encode-json (local-time:format-rfc3339-timestring
nil ts)
stream))
;;;
;;; Views
;;;
(defvar *title* "Panettone")
(setf (who:html-mode) :html5)
(defun render/nav ()
@ -500,9 +469,7 @@ given subject an body (in a thread, to avoid blocking)"
(defroute index ("/" :decorators (@auth-optional)) ()
(let ((issues (model:list-issues :status :open)))
(format-case
(:html (render/index :issues issues))
(:json (encode-json-to-string issues)))))
(render/index :issues issues)))
(defroute settings ("/settings" :method :get :decorators (@auth)) ()
(render/settings))
@ -551,9 +518,7 @@ given subject an body (in a thread, to avoid blocking)"
(let* ((issue (model:get-issue id))
(*title* (format nil "~A | Panettone"
(subject issue))))
(format-case
(:html (render/issue issue))
(:json (encode-json-to-string issue)))))
(render/issue issue)))
(defroute edit-issue
("/issues/:id/edit" :decorators (@auth @handle-issue-not-found))