From 036d36743942937d46426688b30370481482210e Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Sat, 13 Jul 2024 10:56:29 +0200
Subject: [PATCH] web/response: provide classes for content types, render HTML
 content (work in progress)

---
 web/response.lisp | 48 ++++++++++++++++++++++++++++++-----------------
 1 file changed, 31 insertions(+), 17 deletions(-)

diff --git a/web/response.lisp b/web/response.lisp
index 4c23a77..afa643c 100644
--- a/web/response.lisp
+++ b/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)
-  (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)))
+  (let ((accept (string-downcase accept)))
+    (cond 
+      ((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"))
+  ; process special message heads, e.g. (:system :error ...)
+  ;   => set status code, provide additional data elements
+  ;      set additional headers
+  (let ((headers (list :content-type (ctype resp)))
         (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
+        (content (render-content resp msg)))
     (list rcode headers (list content))))
 
 (defun render-not-found(resp)