From 974937cba7794d26d55ca2628b4274f162d0f58e Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Fri, 30 Aug 2024 14:47:09 +0200
Subject: [PATCH] web/response:interaction: simplify action definition with
 core:define-actions

---
 core/core.lisp    | 10 +++++++++-
 web/response.lisp | 15 +++++++++------
 2 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/core/core.lisp b/core/core.lisp
index 2fb270b..4f2a68d 100644
--- a/core/core.lisp
+++ b/core/core.lisp
@@ -7,7 +7,7 @@
                     (:shape :scopes/shape)
                     (:util :scopes/util)
                     (:alx :alexandria))
-  (:export #:action-spec
+  (:export #:action-spec #:define-actions
            #:*root* #:default-setup #:default-actions 
            #:find-service #:setup-services
            #:base-context #:context #:add-action #:config #:name #:send #:shutdown
@@ -22,6 +22,14 @@
   ((pattern :reader pattern :initarg :pattern :initform nil)
    (handlers :accessor handlers :initarg :handlers)))
 
+(defun define-action (pattern &rest handlers)
+  (make-instance 'action-spec :pattern pattern :handlers handlers))
+
+(defun define-actions (&rest acts)
+  (mapcar #'(lambda (act) 
+              (apply #'define-action (car act) (cdr act))) 
+          acts))
+
 (defun select (msg acts)
   (let ((h (shape:head msg))
         (hdlrs nil))
diff --git a/web/response.lisp b/web/response.lisp
index d0b115a..7e038b8 100644
--- a/web/response.lisp
+++ b/web/response.lisp
@@ -14,18 +14,21 @@
 
 ;;;; server interaction - receive response message from action processing chain
 
+(defun store-msg (ia msg)
+  (push msg (messages ia)))
+
+(defvar *interaction-default-actions* 
+  ;(list (core::define-action nil #'store-msg)))
+  (core:define-actions (list nil #'store-msg)))
+
 (defclass interaction (core:base-context)
-  ((core:default-actions :initform 
-     (list (make-instance 'core:action-spec :handlers (list #'store-msg))))
-   (response :reader response :initarg :response)
+  ((core:default-actions :initform *interaction-default-actions*)
+   (response :reader nilresponse :initarg :response)
    (messages :accessor messages :initform nil)))
 
 (defmethod print-object ((ia interaction) s)
   (shape:print-fields ia s 'messages))
 
-(defun store-msg (ia msg)
-  (push msg (messages ia)))
-
 (defun add-cookies (iact)
   (let ((headers (resp (response iact))))
     (dolist (cdata (cookie-data iact))