cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

web/response: provide classes for content types, render HTML content (work in progress)

Browse source
This commit is contained in:
Helmut Merz 2024-07-13 10:56:29 +02:00
parent c094b0b9ee
commit 036d367439
1 changed files with 31 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
web/response.lisp
View file

@ -8,13 +8,28 @@
(in-package :scopes/web/response) (in-package :scopes/web/response)
(defclass plain-text-response () (defclass response ()
((context :initarg :context) ((context :reader context :initarg :context)
(env :initarg :env))) (env :reader env :initarg :env)
(ctype :reader ctype :allocation :class)))
(defclass json-response (plain-text-response) ()) (defgeneric render-content (resp msg))
(defclass html-response (plain-text-response) ()) (defclass plain-text-response (response)
((ctype :initform "text/plain")))
(defclass json-response (response)
((ctype :initform "application/json")))
;;;; html response
(defclass html-response (response)
((ctype :initform "text/html")))
(defmethod render-content ((resp html-response) msg)
(getf (message:data msg) :info))
;;;; common definitions
(defun setup (ctx env) (defun setup (ctx env)
(let* ((headers (getf env :headers)) (let* ((headers (getf env :headers))
@ -22,21 +37,20 @@
(make-instance resp-class :context ctx :env env))) (make-instance resp-class :context ctx :env env)))
(defun select-response-class (accept) (defun select-response-class (accept)
(let ((accept (string-downcase accept)))
(cond (cond
((null accept) 'html-response)
((str:containsp "html" accept) 'html-response) ((str:containsp "html" accept) 'html-response)
((str:containsp "json" accept) 'json-response) ((str:containsp "json" accept) 'json-response)
((str:containsp "plain" accept) 'plain-text-response) ((str:containsp "plain" accept) 'plain-text-response)
(t 'html-response))) (t 'html-response))))
(defun render (resp msg) (defun render (resp msg)
(let ((headers '(:content-type "text/plain"))
(rcode 200)
(content (getf (message:data msg) :info)))
; process special message heads, e.g. (:system :error ...) ; process special message heads, e.g. (:system :error ...)
; => set status code, provide additional data elements ; => set status code, provide additional data elements
; (gethash "accept" (getf env :headers)) => select output format ; set additional headers
; set headers, render body (let ((headers (list :content-type (ctype resp)))
(rcode 200)
(content (render-content resp msg)))
(list rcode headers (list content)))) (list rcode headers (list content))))
(defun render-not-found(resp) (defun render-not-found(resp)