basic record definitions moved from storage/tracking to shape

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))

storage/tracking.lisp

@@ -4,9 +4,10 @@
 
 (defpackage :scopes/storage/tracking
   (:use :common-lisp)
-  (:local-nicknames (:jzon :com.inuoe.jzon)
+  (:local-nicknames (:shape :scopes/shape)
-                    (:storage :scopes/storage))
+                    (:storage :scopes/storage)
-  (:export #:track #:trackid #:head #:head-plist #:time-stamp #:data
+                    (: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 ()
+(defclass track (shape:record)
-  ((head-fields :reader head-fields :initarg :head-fields :initform '(:taskid :username))
+  ((trackid :accessor trackid :initform nil)
-   (trackid :accessor trackid :initform nil)
-   (head :accessor head :initarg :head)
    (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))
+(defmethod shape:head-fields ((cont container))
-  (head-fields (make-instance (item-class cont))))
+  (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)))
+  (let ((vl (shape:head-plist track)))
-    (with-slots ((trid trackid) (ts time-stamp) data) 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))

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"))
+    (== (shape:head tr) '("t01" "john"))
-    (== (tracking:head-plist tr) '(:username "john" :taskid "t01"))
+    (== (shape:head-plist tr) '(:username "john" :taskid "t01"))
-    (== (tracking:data tr) nil)
+    (== (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"))
+    (== (shape:head tr2) '("t01" "john"))
-    (== (gethash :desc (tracking:data tr2)) "scopes/storage: queries")
+    (== (gethash :desc (shape:data tr2)) "scopes/storage: queries")
     ))