diff --git a/shape/shape.lisp b/shape/shape.lisp index 22b77f0..37d9b86 100644 --- a/shape/shape.lisp +++ b/shape/shape.lisp @@ -2,10 +2,19 @@ (defpackage :scopes/shape (:use :common-lisp) - (:export #:record)) + (:export #:record #:head-fields #:head #:data + #:head-plist)) (in-package :scopes/shape) (defclass record () - ((head :accessor head :initarg :head) + ((head-fields :reader head-fields :initarg :head-fields :initform '(:taskid :username)) + (head :accessor head :initarg :head) (data :accessor data :initform nil))) + +(defun head-plist (track) + (let (pl (hv (head track))) + (dolist (hf (head-fields track)) + (setf (getf pl hf) (if (car hv) (car hv) "")) + (setf hv (cdr hv))) + pl)) diff --git a/storage/tracking.lisp b/storage/tracking.lisp index 59adce9..55ec5f1 100644 --- a/storage/tracking.lisp +++ b/storage/tracking.lisp @@ -4,9 +4,10 @@ (defpackage :scopes/storage/tracking (:use :common-lisp) - (:local-nicknames (:jzon :com.inuoe.jzon) - (:storage :scopes/storage)) - (:export #:track #:trackid #:head #:head-plist #:time-stamp #:data + (:local-nicknames (:shape :scopes/shape) + (:storage :scopes/storage) + (:jzon :com.inuoe.jzon)) + (:export #:track #:trackid #:time-stamp #:container #:insert #:make-item #:get-track @@ -14,12 +15,9 @@ (in-package :scopes/storage/tracking) -(defclass track () - ((head-fields :reader head-fields :initarg :head-fields :initform '(:taskid :username)) - (trackid :accessor trackid :initform nil) - (head :accessor head :initarg :head) +(defclass track (shape:record) + ((trackid :accessor trackid :initform nil) (time-stamp :accessor time-stamp :initform nil) - (data :accessor data :initform nil) (container :reader container :initarg :container))) (defun timestamp-to-sql (tr ts) @@ -31,26 +29,19 @@ (indexes :reader indexes :initform '((taskid username) (username))) (storage :reader storage :initarg :storage))) -(defmethod head-fields ((cont container)) - (head-fields (make-instance (item-class cont)))) +(defmethod shape:head-fields ((cont container)) + (shape:head-fields (make-instance (item-class cont)))) (defun make-item (cont &rest head) (make-instance (item-class cont) :head head :container cont)) -(defun head-plist (track) - (let (pl (hv (head track))) - (dolist (hf (head-fields track)) - (setf (getf pl hf) (if (car hv) (car hv) "")) - (setf hv (cdr hv))) - pl)) - (defun ensure-timestamp (track) (if (not (time-stamp track)) (setf (time-stamp track) (get-universal-time)))) (defun plist (track) - (let ((vl (head-plist track))) - (with-slots ((trid trackid) (ts time-stamp) data) track + (let ((vl (shape:head-plist track))) + (with-slots ((trid trackid) (ts time-stamp) (data shape:data)) track (if trid (setf (getf vl :trackid) trid)) (if ts (setf (getf vl :timestamp) (timestamp-to-sql track ts))) (if data (setf (getf vl :data) (jzon:stringify data)))) @@ -71,7 +62,7 @@ (defun get-track (cont trid) (let* ((st (storage cont)) (table (storage:qualified-table-name st (table-name cont))) - (cols (append (head-fields cont) '(:timestamp :data))) + (cols (append (shape:head-fields cont) '(:timestamp :data))) (row (storage:normalize-plist (car (storage:query st (sxql:select cols (sxql:from table) @@ -79,11 +70,11 @@ (build-track cont row))) (defun build-track (cont row) - (let* ((hv (mapcar #'(lambda (x) (getf row x)) (head-fields cont))) + (let* ((hv (mapcar #'(lambda (x) (getf row x)) (shape:head-fields cont))) (tr (apply #'make-item cont hv))) (setf (trackid tr) (getf row :trackid)) (setf (time-stamp tr) (getf row :timestamp)) - (setf (data tr) + (setf (shape:data tr) (jzon:parse (getf row :data) :key-fn #'storage:normalize-keyword)) tr)) @@ -92,7 +83,7 @@ ((st (storage cont)) (tn (table-name cont)) (table (storage:qualified-table-name st tn)) - (head-fields (head-fields cont)) + (head-fields (shape:head-fields cont)) (params (storage:params st)) (id-type (getf params :id-type)) (json-type (getf params :json-type)) diff --git a/test/test-storage.lisp b/test/test-storage.lisp index 42d1e15..21a350c 100644 --- a/test/test-storage.lisp +++ b/test/test-storage.lisp @@ -7,6 +7,7 @@ (:local-nicknames (:config :scopes/config) (:core :scopes/core) (:logging :scopes/logging) + (:shape :scopes/shape) (:storage :scopes/storage) (:tracking :scopes/storage/tracking) (:t :scopes/testing)) @@ -40,18 +41,17 @@ (data (make-hash-table)) cont tr tr2) (setf cont (make-instance 'tracking:container :storage st)) - (defparameter cl-user::*cont cont) (storage:drop-table st :tracks) (tracking:create-table cont) (setf tr (tracking:make-item cont "t01" "john")) - (== (tracking:head tr) '("t01" "john")) - (== (tracking:head-plist tr) '(:username "john" :taskid "t01")) - (== (tracking:data tr) nil) + (== (shape:head tr) '("t01" "john")) + (== (shape:head-plist tr) '(:username "john" :taskid "t01")) + (== (shape:data tr) nil) (setf (gethash :desc data) "scopes/storage: queries") - (setf (tracking:data tr) data) + (setf (shape:data tr) data) (tracking:insert tr) (== (tracking:trackid tr) 1) (setf tr2 (tracking:get-track cont 1)) - (== (tracking:head tr2) '("t01" "john")) - (== (gethash :desc (tracking:data tr2)) "scopes/storage: queries") + (== (shape:head tr2) '("t01" "john")) + (== (gethash :desc (shape:data tr2)) "scopes/storage: queries") ))