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

storage/tracking: provide indexes via factory function, with default based on head-fields

Browse source
This commit is contained in:
Helmut Merz 2024-07-29 18:50:49 +02:00
parent d363a3dde3
commit bc28565dea
4 changed files with 16 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
shape/shape.lisp
View file

@ -14,9 +14,8 @@
(head :accessor head :initarg :head) (head :accessor head :initarg :head)
(data :accessor data :initarg :data :initform nil))) (data :accessor data :initarg :data :initform nil)))
(defun head-plist (track) (defun head-plist (rec)
(let (pl (hv (head track))) (let (pl (hv (head rec)))
(dolist (hf (head-fields track)) (dolist (hf (head-fields rec))
(setf pl (cons hf (cons (util:keyword-to-string (pop hv)) pl)))) (setf pl (cons hf (cons (util:keyword-to-string (pop hv)) pl))))
(log:info "pl: ~s" pl)
pl)) pl))

6
storage/msglog.lisp
View file

@ -12,12 +12,14 @@
(defclass pmsg (message:message tracking:track) ()) (defclass pmsg (message:message tracking:track) ())
(defun indexes (cont)
'((domain action class item) (domain class item)))
(defun make-container (storage) (defun make-container (storage)
(make-instance 'tracking:container (make-instance 'tracking:container
:item-class 'pmsg :item-class 'pmsg
:table-name :messages :table-name :messages
:indexes '((domain action class item) :index-factory #'indexes
(domain class item))
:storage storage)) :storage storage))
(defun save (msg cont) (defun save (msg cont)

10
storage/tracking.lisp
View file

@ -28,10 +28,15 @@
(defun timestamp-to-sql (tr ts) (defun timestamp-to-sql (tr ts)
(funcall (getf (storage:params (storage (container tr))) :ts-sql) ts)) (funcall (getf (storage:params (storage (container tr))) :ts-sql) ts))
(defun default-indexes (cont)
(maplist #'identity (item-head-fields cont)))
;'((taskid username) (username)))
(defclass container () (defclass container ()
((item-class :reader item-class :initarg :item-class :initform 'track) ((item-class :reader item-class :initarg :item-class :initform 'track)
(table-name :reader table-name :initarg :table-name :initform :tracks) (table-name :reader table-name :initarg :table-name :initform :tracks)
(indexes :reader indexes :initarg :indexes :initform '((taskid username) (username))) (index-factory :reader index-factory :initarg :index-factory
:initform #'default-indexes)
(storage :reader storage :initarg :storage))) (storage :reader storage :initarg :storage)))
(defun item-head-fields (cont) (defun item-head-fields (cont)
@ -106,7 +111,8 @@
hf-def hf-def
`((timestamp :type timestamptz :not-null t :default current_timestamp) `((timestamp :type timestamptz :not-null t :default current_timestamp)
(data :type ,json-type :not-null t :default |'{}'|))))) (data :type ,json-type :not-null t :default |'{}'|)))))
(create-indexes st table tn (indexes cont)))) (create-indexes st table tn
(funcall (index-factory cont) cont))))
(defun create-indexes (st table tname ixs) (defun create-indexes (st table tname ixs)
(let ((i 1) (let ((i 1)

2
util.lisp
View file

@ -31,7 +31,7 @@
(intern (string-upcase s) :keyword))) (intern (string-upcase s) :keyword)))
(defmacro loop-plist (plist kvar vvar &body body) (defmacro loop-plist (plist kvar vvar &body body)
`(loop for (,kvar ,vvar . _) on ,plist by #'cddr ,@body)) `(loop for (,kvar ,vvar . nil) on ,plist by #'cddr ,@body))
;;;; directory and pathname utilities ;;;; directory and pathname utilities