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

web/response.lisp

@@ -8,13 +8,28 @@
 
 (in-package :scopes/web/response)
 
-(defclass plain-text-response ()
-  ((context :initarg :context)
-   (env :initarg :env)))
+(defclass response ()
+  ((context :reader context :initarg :context)
+   (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)
   (let* ((headers (getf env :headers))
@@ -22,21 +37,20 @@
     (make-instance resp-class :context ctx :env env)))
 
 (defun select-response-class (accept)
+  (let ((accept (string-downcase 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)))
+      (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
+  ;      set additional headers
+  (let ((headers (list :content-type (ctype resp)))
+        (rcode 200)
+        (content (render-content resp msg)))
     (list rcode headers (list content))))
 
 (defun render-not-found(resp)