storage/msglog: fixes, improvements, tests OK

storage/storage.lisp

@@ -6,12 +6,13 @@
   (:use :common-lisp)
   (:local-nicknames (:config :scopes/config)
                     (:core :scopes/core)
+                    (:util :scopes/util)
                     (:alx :alexandria))
   (:export #:config 
            #:storage #:params #:setup
            #:qualified-table-name
            #:do-sql #:query #:drop-table
-           #:normalize-keyword #:normalize-plist))
+           #:normalize-plist))
 
 (in-package :scopes/storage)
 
@@ -82,14 +83,11 @@
 
 ;;;; utilities
 
-(defun normalize-keyword (kw)
-  (intern (string-upcase kw) :keyword))
-
 (defun normalize-plist (pl)
   (let ((res nil))
     (alx:doplist (k v pl res)
       (push v res)
-      (push (normalize-keyword k) res))))
+      (push (util:to-keyword k) res))))
 
 (defun ts-string (ts)
   (format nil "~a" (local-time:universal-to-timestamp ts)))

storage/tracking.lisp

@@ -6,6 +6,8 @@
   (:use :common-lisp)
   (:local-nicknames (:shape :scopes/shape)
                     (:storage :scopes/storage)
+                    (:util :scopes/util)
+                    (:alx :alexandria)
                     (:jzon :com.inuoe.jzon))
   (:export #:track #:trackid #:time-stamp
            #:container #:insert
@@ -73,12 +75,13 @@
 
 (defun setup-track (tr row)
   ;(log:info "tr: ~s, row: ~s" tr row)
-  (let ((hv (mapcar #'(lambda (x) (getf row x)) (shape:head-fields tr))))
+  (let ((hv (mapcar #'(lambda (x) (util:to-keyword (getf row x)))
+                    (shape:head-fields tr))))
     (setf (shape:head tr) hv)
     (setf (trackid tr) (getf row :trackid))
     (setf (time-stamp tr) (getf row :timestamp))
     (setf (shape:data tr) 
-          (jzon:parse (getf row :data) :key-fn #'storage:normalize-keyword))
+          (jzon:parse (getf row :data) :key-fn #'util:to-keyword))
     tr))
 
  (defun create-table (cont) 

test/test-storage.lisp

@@ -12,7 +12,8 @@
                     (:shape :scopes/shape)
                     (:storage :scopes/storage)
                     (:tracking :scopes/storage/tracking) 
-                    (:t :scopes/testing))
+                    (:t :scopes/testing)
+                    (:alx :alexandria))
   (:export #:run #:run-all #:run-postgres #:run-sqlite)
   (:import-from :scopes/testing #:deftest #:==))
 
@@ -46,8 +47,8 @@
     (setf cont (make-instance 'tracking:container :storage st))
     (storage:drop-table st :tracks)
     (tracking:create-table cont)
-    (setf tr (tracking:make-item cont "t01" "john"))
-    (== (shape:head tr) '("t01" "john"))
+    (setf tr (tracking:make-item cont :t01 :john))
+    (== (shape:head tr) '(:t01 :john))
     (== (shape:head-plist tr) '(:username "john" :taskid "t01"))
     (== (shape:data tr) nil)
     (setf (gethash :desc data) "scopes/storage: queries")
@@ -55,7 +56,7 @@
     (tracking:insert tr)
     (== (tracking:trackid tr) 1)
     (setf tr2 (tracking:get-track cont 1))
-    (== (shape:head tr2) '("t01" "john"))
+    (== (shape:head tr2) '(:t01 :john))
     (== (gethash :desc (shape:data tr2)) "scopes/storage: queries")
     ))
 
@@ -66,9 +67,12 @@
     (setf cont (msglog:make-container st))
     (storage:drop-table st :messages)
     (tracking:create-table cont)
-    (setf msg (message:create '(:test :data :field :info) :data '(:info "test data")))
+    (setf msg (message:create '(:test :data :field) 
+                              :data (alx:plist-hash-table '(:info "test data"))))
     (setf pm (msglog:save msg cont))
     (== (tracking:trackid pm) 1)
     (setf pm2 (tracking:get-track cont 1))
-    (log:info "pm2: ~s" pm2)
+    ;(log:info "pm2: ~s" pm2)
+    (== (shape:head pm2) '(:test :data :field nil))
+    (== (gethash :info (shape:data pm2)) "test data")
     ))

util.lisp

@@ -23,7 +23,9 @@
       (str:join sep (mapcar #'(lambda (s) (format nil pattern s)) k)))))
 
 (defun to-keyword (s)
-  (intern (string-upcase s) :keyword))
+  (if (string= s "")
+    nil
+    (intern (string-upcase s) :keyword)))
 
 (defmacro loop-plist (plist kvar vvar &body body)
   `(loop for (,kvar ,vvar . _) on ,plist by #'cddr ,@body))