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

storage/folder: + items (and auxiliary functions)

Browse source
This commit is contained in:
Helmut Merz 2024-08-09 17:42:05 +02:00
parent 20ae39e3c4
commit 8aed67f057
3 changed files with 23 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
storage/folder.lisp
View file

@ -5,7 +5,7 @@
(:local-nicknames (:shape :scopes/shape)
(:tracking :scopes/storage/tracking)
(:util :scopes/util))
(:export #:folder #:root #:create
(:export #:folder #:root #:create #:items
#:make-container))
(in-package :scopes/storage/folder)
@ -15,7 +15,7 @@
(tracking:key-fields :initform '(:parentid :name))))
(defun indexes (cont)
'((parentid name ref) (ref)))
'((parentid name) (ref)))
(defun make-container (storage)
(make-instance 'tracking:container
@ -31,5 +31,16 @@
(defun create (name parent)
(let ((cont (tracking:container parent))
(pid (write-to-string (tracking:trackid parent))))
(pid (tracking:id-str parent)))
(tracking:save (tracking:make-item cont pid name))))
(defun items (parent)
(query parent `((:parentid ,(id parent)))))
;;;; auxiliary functions
(defun id (f)
(tracking:id-str f))
(defun query (f spec)
(tracking:query (tracking:container f) (tracking:make-where spec)))

7
storage/tracking.lisp
View file

@ -8,9 +8,9 @@
(:util :scopes/util)
(:alx :alexandria)
(:jzon :com.inuoe.jzon))
(:export #:track #:trackid #:key-fields #:timestamp
(:export #:track #:trackid #:id-str #:key-fields #:timestamp
#:container #:make-container #:table-name #:storage #:make-item
#:get-track #:query-last #:query-one #:query
#:get-track #:query-last #:query-one #:query #:make-where
#:save #:insert #:update
#:create-indexes #:create-table))
@ -33,6 +33,9 @@
(util:filter-plist hv kf)
hv)))
(defun id-str (tr)
(write-to-string (trackid tr)))
(defun uid (tr)
(format nil "~(~a~)-~a" (short-name (container tr)) (trackid tr)))

5
test/test-storage.lisp
View file

@ -85,7 +85,7 @@
(deftest test-folder (ctx)
(let ((st (storage:storage ctx))
cont root f1 f2 f3)
cont root f1 f2 f3 r1)
(setf cont (folder:make-container st))
(storage:drop-table st :folders)
(tracking:create-table cont)
@ -97,4 +97,7 @@
(== (shape:head-value f1 :parentid) "1")
(setf (shape:head-value f1 :ref) :dummy-0)
(tracking:save f1)
(setf r1 (folder:items root))
(== (length r1) 1)
(== (shape:head-value (car r1) :ref) :dummy-0)
))