43 lines
1.4 KiB
Common Lisp
43 lines
1.4 KiB
Common Lisp
;;;; cl-scopes/web/response - set up and render server response
|
|
|
|
(defpackage :scopes/web/response
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:message :scopes/core/message))
|
|
(:export #:setup
|
|
#:render #:render-not-found))
|
|
|
|
(in-package :scopes/web/response)
|
|
|
|
(defclass plain-text-response ()
|
|
((context :initarg :context)
|
|
(env :initarg :env)))
|
|
|
|
(defclass json-response (plain-text-response) ())
|
|
|
|
(defclass html-response (plain-text-response) ())
|
|
|
|
(defun setup (ctx env)
|
|
(let* ((headers (getf env :headers))
|
|
(resp-class (select-response-class (gethash "accept" headers))))
|
|
(make-instance resp-class :context ctx :env env)))
|
|
|
|
(defun select-response-class (accept)
|
|
(cond
|
|
((null accept) 'html-response)
|
|
((str:containsp "html" accept) 'html-response)
|
|
((str:containsp "json" accept) 'json-response)
|
|
((str:containsp "plain" accept) 'plain-text-response)
|
|
(t 'html-response)))
|
|
|
|
(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 ...)
|
|
; => set status code, provide additional data elements
|
|
; (gethash "accept" (getf env :headers)) => select output format
|
|
; set headers, render body
|
|
(list rcode headers (list content))))
|
|
|
|
(defun render-not-found(resp)
|
|
(list 404 '(:content-type "text/plain") '("Not found")))
|