From 685df331b0eba999764576299bcaf6a9cd8e367d Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Sat, 31 Jan 2026 23:01:12 +0100 Subject: [PATCH] util, shape: improve / fix property list and head handling facilities --- shape/shape.lisp | 20 +++++++++----------- storage/tracking.lisp | 2 +- test/test-core.lisp | 3 ++- test/test-storage.lisp | 2 +- util/util.lisp | 8 ++++++-- 5 files changed, 19 insertions(+), 16 deletions(-) diff --git a/shape/shape.lisp b/shape/shape.lisp index e37a630..9f556c0 100644 --- a/shape/shape.lisp +++ b/shape/shape.lisp @@ -6,7 +6,8 @@ (:mop :closer-mop)) (:export #:meta #:get-meta #:create #:record-meta #:record #:print-fields #:print-slots - #:head-fields #:head #:head-value #:head-plist #:head-update + #:head #:head-fields #:head-value + #:head-plist #:head-plist-str #:head-update #:data-fields #:data #:data-value)) (in-package :scopes/shape) @@ -52,19 +53,16 @@ (defun (setf head-value) (val rec key) (setf (elt (head rec) (position key (head-fields rec))) val)) -(defun head-plist (rec &key (transform-value #'util:from-keyword)) - (let (pl (hv (head rec))) - (dolist (hf (head-fields rec)) - (setf pl (cons hf (cons (funcall transform-value (pop hv)) pl)))) - pl)) +(defun head-plist (rec &key (transform-value #'identity)) + (loop for k in (head-fields rec) and v in (head rec) + append (list k (funcall transform-value v)))) -(defun head-plist-n (rec) - (loop for k in (head-fields rec) and v in (head rec) nconc (list k v))) +(defun head-plist-str (rec) + (head-plist rec :transform-value #'util:from-keyword)) (defun head-update (rec &rest plst) - (reverse - (util:loop-plist (head-plist rec :transform-value #'identity) k v - collect (or (getf plst k) v)))) + (util:loop-plist (head-plist rec) k v + collect (or (getf plst k) v))) (defun data-value (rec key) (getf (data rec) key)) diff --git a/storage/tracking.lisp b/storage/tracking.lisp index e2e1a37..ad585a2 100644 --- a/storage/tracking.lisp +++ b/storage/tracking.lisp @@ -191,7 +191,7 @@ (setf (timestamp track) (get-universal-time)))) (defun plist (track) - (let ((vl (shape:head-plist track)) + (let ((vl (shape:head-plist-str track)) (data (shape:data track))) (with-slots ((trid trackid) (ts timestamp)) track (when trid (setf (getf vl :trackid) trid)) diff --git a/test/test-core.lisp b/test/test-core.lisp index b137dc0..7f564cc 100644 --- a/test/test-core.lisp +++ b/test/test-core.lisp @@ -86,6 +86,7 @@ (== (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:map-plist '(:a "a" :b "b") #'string-upcase) '(: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)) @@ -115,7 +116,7 @@ (== (shape:head-value rec :taskid) :t1) (setf (shape:head-value rec :username) :u1) (== (shape:head-value rec :username) :u1) - (== (shape:head-plist rec) '(:username "u1" :taskid "t1")) + (== (shape:head-plist-str rec) '(:taskid "t1" :username "u1")) )) (deftest test-util-async () diff --git a/test/test-storage.lisp b/test/test-storage.lisp index 4ae2a5b..b4398da 100644 --- a/test/test-storage.lisp +++ b/test/test-storage.lisp @@ -51,7 +51,7 @@ (tracking:create-table cont) (setf tr (tracking:make-item cont :t01 :john)) (== (shape:head tr) '(:t01 :john)) - (== (shape:head-plist tr) '(:username "john" :taskid "t01")) + (== (shape:head-plist-str tr) '(:taskid "t01" :username "john")) (== (shape:data tr) nil) (setf (shape:data tr) '(:desc "scopes/storage: queries")) (tracking:insert tr) diff --git a/util/util.lisp b/util/util.lisp index 6ab37a1..61281dd 100644 --- a/util/util.lisp +++ b/util/util.lisp @@ -9,7 +9,8 @@ #:from-unix-time #:to-unix-time #:ptr #:rfill #:rtrim - #:loop-plist #:filter-plist #:plist-pairs #:plist-equal #:plist-add + #:loop-plist #:filter-plist #:map-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 @@ -73,7 +74,10 @@ `(loop for (,kvar ,vvar . nil) on ,plist by #'cddr ,@body)) (defun filter-plist (pl keys) - (loop-plist pl k v when (find k keys) append (list k v))) + (loop-plist pl k v when (find k keys) nconc (list k v))) + +(defun map-plist (pl fn) + (loop-plist pl k v nconc (list k (funcall fn v)))) (defun plist-pairs (pl) (loop-plist pl k v collect (list k v)))