From 7c4b22d5f8fff9b3997e6687838032448cf23118 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Fri, 26 Jul 2024 08:51:08 +0200
Subject: [PATCH] web/response: provide dynamic response via responder / writer
 calls

---
 web/response.lisp | 34 +++++++++++++++++++++++++---------
 web/server.lisp   | 17 ++---------------
 2 files changed, 27 insertions(+), 24 deletions(-)

diff --git a/web/response.lisp b/web/response.lisp
index f483f9f..e537a47 100644
--- a/web/response.lisp
+++ b/web/response.lisp
@@ -2,11 +2,11 @@
 
 (defpackage :scopes/web/response
   (:use :common-lisp)
-  (:local-nicknames (:dom :scopes/web/dom)
+  (:local-nicknames (:core :scopes/core)
+                    (:dom :scopes/web/dom)
                     (:message :scopes/core/message)
                     (:shape :scopes/shape))
-  (:export #:setup
-           #:html-response
+  (:export #:interaction #:setup #:html-response
            #:render #:render-content #:render-not-found))
 
 (in-package :scopes/web/response)
@@ -26,6 +26,18 @@
 (defclass json-response (response)
   ((ctype :initform "application/json")))
 
+;;;; server interaction - receive response message from action processing chain
+
+(defclass interaction ()
+  ((messages :accessor messages :initform nil)))
+
+(defmethod print-object ((ia interaction) s)
+  (format s "<interaction ~s>" (messages ia)))
+
+(defmethod core:send ((ia interaction) msg)
+  (log:debug "receiving ~s" msg)
+  (push msg (messages ia)))
+
 ;;;; html response
 
 (defclass html-response (response)
@@ -52,15 +64,19 @@
 (defun html-response-class (html-responder)
   (or html-responder *html-response-class* 'html-response))
 
-(defun render (resp msgs)
-  ; process special message heads, e.g. (:system :error ...)
+(defun render (resp iact)
+  ; pre-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 (mapcar #'(lambda (m) (render-content resp m)) msgs)))
-        ;(content (render-content resp msg)))
-    (list rcode headers content)))
+        (rcode 200))
+    #'(lambda (responder)
+        (let ((writer (funcall responder (list rcode headers))))
+          (dolist (msg (messages iact))
+            (funcall writer (render-content resp msg)))
+          (funcall writer nil :close t)))))
+    ;    (content (mapcar #'(lambda (m) (render-content resp m)) (messages iact))))
+    ;(list rcode headers content)))
 
 (defun render-not-found(resp)
   (list 404 '(:content-type "text/plain") '("Not found")))
diff --git a/web/server.lisp b/web/server.lisp
index a935b13..890d375 100644
--- a/web/server.lisp
+++ b/web/server.lisp
@@ -83,29 +83,16 @@
       (lack/component:call file-app env))))
 
 (defun message-handler (ctx env &key html-responder)
-  (let* ((iact (make-instance 'interaction))
+  (let* ((iact (make-instance 'response:interaction))
          (msg (message:create 
                 (head env) :data (plist (post-data env)) :sender iact))
          (resp (response:setup ctx env :html-responder html-responder)))
     (log:debug "msg ~s" msg)
     ; (check-auth ctx msg env) => (response:render-unauthorized resp)
     (if (core:handle-message ctx msg)
-      (response:render resp (messages iact))
+      (response:render resp iact)
       (response:render-not-found resp))))
 
-;;;; server interaction - receive response message from action processing chain
-
-(defclass interaction ()
-  ((messages :accessor messages :initform nil)))
-
-(defmethod print-object ((ia interaction) s)
-  (format s "<interaction ~s>" (messages ia)))
-
-(defmethod core:send ((ia interaction) msg)
-  (log:debug "receiving ~s" msg)
-  (push msg (messages ia)))
-  ;(setf (message ia) msg))
-
 ;;;; helper functions
 
 (defun head (env)