From 2b2519498f6ac47fdebb612606a4e2dff07d38c3 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Wed, 31 Jul 2024 13:42:37 +0200
Subject: [PATCH] fix util:rtrim; work in progress: tracking:save

---
 storage/tracking.lisp | 25 ++++++++++++++++++-------
 test/test-core.lisp   |  2 +-
 util.lisp             |  3 +--
 3 files changed, 20 insertions(+), 10 deletions(-)

diff --git a/storage/tracking.lisp b/storage/tracking.lisp
index 9877b2c..b4c5f9e 100644
--- a/storage/tracking.lisp
+++ b/storage/tracking.lisp
@@ -52,6 +52,16 @@
   (query1 cont (make-where (list (list :trackid trid)))))
   ;(query1 cont (list := :trackid trid)))
 
+(defun save (cont track)
+  (let ((*build-track-data* #'identity)
+        (tr0 (query-last cont (shape:head-plist track)))
+        (new-data (alx:plist-hash-table (shape:data track))))
+    (if tr0
+      (if (equalp (shape:data tr0) new-data)
+        nil ; or insert <= insert-when == :always
+        (update track new-data)) ; or insert <= insert-when == :changed
+      (insert track new-data))))
+
 (defun query1 (cont crit)
   (let* ((tr (make-item cont))
          (st (storage cont))
@@ -65,25 +75,25 @@
              (sxql:limit 1)))))))
     (setup-track tr row)))
 
-(defun insert (track)
+(defun insert (track &optional data)
   (ensure-timestamp track)
   (let* ((cont (container track))
          (st (storage cont))
          (table (storage:qualified-table-name st (table-name cont)))
          (res (car (storage:query st
            (sxql:insert-into table
-             (apply #'sxql:make-clause ':set= (plist track))
+             (apply #'sxql:make-clause ':set= (plist track data))
              (sxql:returning :trackid))))))
     (setf (trackid track) (cadr res))
     track))
 
-(defun update (track)
+(defun update (track &optional data)
   (ensure-timestamp track)
   (let* ((cont (container track))
          (st (storage cont))
          (table (storage:qualified-table-name st (table-name cont))))
     (sxql:update table
-      (apply #'sxql:make-clause ':set= (plist track))
+      (apply #'sxql:make-clause ':set= (plist track data))
       (where (:= :trackid (trackid track))))))
 
 ;;;; auxiliary functions for queries, ...
@@ -118,9 +128,10 @@
   (if (not (time-stamp track))
     (setf (time-stamp track) (get-universal-time))))
 
-(defun plist (track)
-  (let ((vl (shape:head-plist track)))
-    (with-slots ((trid trackid) (ts time-stamp) (data shape:data)) track
+(defun plist (track &optional data)
+  (let ((vl (shape:head-plist track))
+        (data (or data (shape:data track))))
+    (with-slots ((trid trackid) (ts time-stamp)) track
       (when trid (setf (getf vl :trackid) trid))
       (when ts (setf (getf vl :timestamp) (timestamp-to-sql track ts)))
       (when data
diff --git a/test/test-core.lisp b/test/test-core.lisp
index b6eabc0..3a43b9d 100644
--- a/test/test-core.lisp
+++ b/test/test-core.lisp
@@ -62,7 +62,7 @@
       (t:show-result))))
 
 (deftest test-util ()
-  (== (util:rtrim '(1 2 nil 3 nil)) '(1 2)) 
+  (== (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")))
 
diff --git a/util.lisp b/util.lisp
index 5ff5085..382f3ed 100644
--- a/util.lisp
+++ b/util.lisp
@@ -12,8 +12,7 @@
 ;;;; lists and loops
 
 (defun rtrim (lst)
-  (if (car lst)
-    (cons (car lst) (rtrim (cdr lst)))))
+  (nreverse (member-if #'identity (reverse lst))))
 
 (defmacro loop-plist (plist kvar vvar &body body)
   `(loop for (,kvar ,vvar . nil) on ,plist by #'cddr ,@body))