From d52886ec157d1caf8bd1248036b956ad2dda2293 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Fri, 30 Aug 2024 19:40:58 +0200
Subject: [PATCH] util: add to property list - and other improvements for
 web/response:interaction cookie stuff

---
 test/test-core.lisp |  5 ++++-
 util/util.lisp      |  7 ++++++-
 web/response.lisp   | 11 ++++-------
 3 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/test/test-core.lisp b/test/test-core.lisp
index 72f5baa..56c9bcb 100644
--- a/test/test-core.lisp
+++ b/test/test-core.lisp
@@ -71,7 +71,10 @@
   (== (util:rtrim '(1 2 nil 3 nil)) '(1 2 nil 3)) 
   (== (util:to-keyword "hello-kitty") :hello-kitty)
   (== (util:loop-plist '(:a "a" :b "b") k v collect (string-upcase k)) '("A" "B"))
-  (== (util:plist-pairs '(:a "a" :b "b")) '((:a "a") (:b "b"))))
+  (== (util:plist-pairs '(:a "a" :b "b")) '((:a "a") (:b "b")))
+  (let ((pl '(:a 0)))
+    (== (util:plist-add pl :b 1) '(:b 1 :a 0))
+    (== pl '(:b 1 :a 0))))
 
 (deftest test-record ()
   (let ((rec (make-instance 'shape:record :head '(:t1))))
diff --git a/util/util.lisp b/util/util.lisp
index 3ee98df..747956d 100644
--- a/util/util.lisp
+++ b/util/util.lisp
@@ -6,7 +6,8 @@
   #+sbcl (:import-from :sb-ext #:add-package-local-nickname)
   (:export #:make-vars-format #:lg #:lgd #:lgi #:lgw
            #:from-unix-time #:to-unix-time
-           #:rfill #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
+           #:rfill #:rtrim 
+           #:loop-plist #:filter-plist #:plist-pairs #:plist-equal #:plist-add
            #:flatten-str #:from-keyword #:to-keyword #:to-integer #:to-string
            #:from-bytes #:to-bytes #:b64-decode #:b64-encode #:from-b64 #:to-b64
            #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
@@ -64,6 +65,10 @@
     (unless (equal (getf l2 k) v)
       (return-from plist-equal nil)))
   t)
+
+(defmacro plist-add (pl k v)
+  `(setf ,pl (cons ,k (cons ,v ,pl))))
+
 ;;;; strings, symbols, keywords, ...
 
 (defun flatten-str (s &key (sep " "))
diff --git a/web/response.lisp b/web/response.lisp
index a676228..f37695a 100644
--- a/web/response.lisp
+++ b/web/response.lisp
@@ -15,18 +15,15 @@
 ;;;; server interaction - receive response message from action processing chain
 ;;; predefined action handlers / default actions
 
-(defun store-msg (ia msg)
+(defun render-msg (ia msg)
   (push msg (messages ia)))
 
 (defun set-cookie (ia msg)
-  (let ((headers (headers (response ia))))
-    (setf headers 
-          (cons :set-cookie (cons (render-cookie (message:data msg)) headers)))
-    headers))
+  (util:plist-add (headers (response ia)) :set-cookie (message:data msg)))
 
 (defvar *interaction-default-actions* 
-  (core:define-actions '(nil store-msg)
-                       '((:web :set-cookie) set-cookie)))
+  (core:define-actions '((:web :set-cookie) set-cookie) 
+                       '(nil render-msg)))
 
 ;;; interaction class and methods