diff --git a/shape/shape.lisp b/shape/shape.lisp index 5e050be..518d445 100644 --- a/shape/shape.lisp +++ b/shape/shape.lisp @@ -14,9 +14,8 @@ (head :accessor head :initarg :head) (data :accessor data :initarg :data :initform nil))) -(defun head-plist (track) - (let (pl (hv (head track))) - (dolist (hf (head-fields track)) +(defun head-plist (rec) + (let (pl (hv (head rec))) + (dolist (hf (head-fields rec)) (setf pl (cons hf (cons (util:keyword-to-string (pop hv)) pl)))) - (log:info "pl: ~s" pl) pl)) diff --git a/storage/msglog.lisp b/storage/msglog.lisp index 79235d6..3fd77fc 100644 --- a/storage/msglog.lisp +++ b/storage/msglog.lisp @@ -12,12 +12,14 @@ (defclass pmsg (message:message tracking:track) ()) +(defun indexes (cont) + '((domain action class item) (domain class item))) + (defun make-container (storage) (make-instance 'tracking:container :item-class 'pmsg :table-name :messages - :indexes '((domain action class item) - (domain class item)) + :index-factory #'indexes :storage storage)) (defun save (msg cont) diff --git a/storage/tracking.lisp b/storage/tracking.lisp index b750de0..8cba05e 100644 --- a/storage/tracking.lisp +++ b/storage/tracking.lisp @@ -28,10 +28,15 @@ (defun timestamp-to-sql (tr 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 () ((item-class :reader item-class :initarg :item-class :initform 'track) (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))) (defun item-head-fields (cont) @@ -106,7 +111,8 @@ hf-def `((timestamp :type timestamptz :not-null t :default current_timestamp) (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) (let ((i 1) diff --git a/util.lisp b/util.lisp index 768eb76..e8c9962 100644 --- a/util.lisp +++ b/util.lisp @@ -31,7 +31,7 @@ (intern (string-upcase s) :keyword))) (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