cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

storage/folder: + parent query

Browse source
This commit is contained in:
Helmut Merz 2024-08-09 18:50:34 +02:00
parent 8aed67f057
commit 919119d649
2 changed files with 10 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
storage/folder.lisp
View file

@ -5,7 +5,7 @@
(:local-nicknames (:shape :scopes/shape) (:local-nicknames (:shape :scopes/shape)
(:tracking :scopes/storage/tracking) (:tracking :scopes/storage/tracking)
(:util :scopes/util)) (:util :scopes/util))
(:export #:folder #:root #:create #:items (:export #:folder #:root #:create #:items #:parent
#:make-container)) #:make-container))
(in-package :scopes/storage/folder) (in-package :scopes/storage/folder)
@ -34,8 +34,13 @@
(pid (tracking:id-str parent))) (pid (tracking:id-str parent)))
(tracking:save (tracking:make-item cont pid name)))) (tracking:save (tracking:make-item cont pid name))))
(defun items (parent) (defun items (f)
(query parent `((:parentid ,(id parent))))) (query f `((:parentid ,(id f)))))
(defun parent (f)
(let ((pid (parse-integer (util:keyword-to-string (shape:head-value f :parentid)))))
(tracking:query-one (tracking:container f)
(tracking:make-where `((:trackid ,pid))))))
;;;; auxiliary functions ;;;; auxiliary functions

2
test/test-storage.lisp
View file

@ -100,4 +100,6 @@
(setf r1 (folder:items root)) (setf r1 (folder:items root))
(== (length r1) 1) (== (length r1) 1)
(== (shape:head-value (car r1) :ref) :dummy-0) (== (shape:head-value (car r1) :ref) :dummy-0)
(setf f2 (folder:parent (car r1)))
(== (tracking:trackid f2) 1)
)) ))