minor refactorings; + utility for SQL results: normalize-plist

scopes.asd

@@ -6,7 +6,7 @@
   :version "0.0.1"
   :homepage "https://www.cyberconcepts.org"
   :description ""
-  :depends-on (:com.inuoe.jzon :dbi :local-time :str :sxql)
+  :depends-on (:alexandria :com.inuoe.jzon :dbi :local-time :str :sxql)
   :components ((:file "forge/forge")
                (:file "storage/storage")
                (:file "storage/tracking" :depends-on ("storage/storage"))

storage/storage.lisp

@@ -4,12 +4,14 @@
 
 (defpackage :scopes/storage
   (:use :common-lisp)
+  (:local-nicknames (:alx :alexandria))
   (:export #:*db-config*
            #:make-engine #:make-storage #:engine
            #:timestamp-to-sql
            #:db-options #:db-params #:qualified-table-name
            #:do-sql #:query #:drop-table
-           #:schema))
+           #:schema
+           #:normalize-plist))
 
 (in-package :scopes/storage)
 
@@ -30,16 +32,12 @@
    (params :initarg :params)
    (config :reader config :initarg :config)))
 
-(defclass db-engine-pg (db-engine) ())
-
 (defun make-engine () 
   (let ((backend (getf *db-config* :backend)))
     (funcall (getf *backends* backend) *db-config*)))
 
 (defgeneric timestamp-to-sql (engine ts)
-  (:method ((engine db-engine) ts) ts)
+  (:method ((engine db-engine) ts) ts))
-  (:method ((engine db-engine-pg) ts)
-    (format nil "~a" (local-time:universal-to-timestamp ts))))
 
 (defclass storage ()
   ((engine :reader engine :initarg :engine)
@@ -89,7 +87,18 @@
   (let ((table (qualified-table-name st tn)))
     (do-sql st (sxql:drop-table table :if-exists t))))
 
-;;; backend-/driver-specific stuff
+;;;; utilities
+
+(defun normalize-keyword (kw)
+  (intern (string-upcase (symbol-name kw)) :keyword))
+
+(defun normalize-plist (pl)
+  (let ((res nil))
+    (alx:doplist (k v pl res)
+      (push v res)
+      (push (normalize-keyword k) res))))
+
+;;;; backend-/driver-specific stuff
 
 (defun dbi-make-engine (config)
   (let* ((db-type (getf config :db-type))
@@ -101,3 +110,8 @@
                    :connect #'(lambda () 
                                 (apply #'dbi:connect-cached db-type conn-args)))))
 
+(defclass db-engine-pg (db-engine) ())
+
+(defmethod timestamp-to-sql ((engine db-engine-pg) ts)
+  (format nil "~a" (local-time:universal-to-timestamp ts)))
+

storage/tracking.lisp

@@ -6,7 +6,7 @@
   (:use :common-lisp)
   (:local-nicknames (:jzon :com.inuoe.jzon)
                     (:storage :scopes/storage))
-  (:export #:track #:trackid #:head #:head-proplist #:time-stamp #:data
+  (:export #:track #:trackid #:head #:head-plist #:time-stamp #:data
            #:container 
            #:make-item
            #:insert
@@ -35,7 +35,7 @@
 (defun make-item (cont &rest head)
   (funcall (slot-value cont 'item-factory) cont head))
 
-(defun head-proplist (track)
+(defun head-plist (track)
   (let (pl (hv (head track)))
     (dolist (hf (head-fields (container track)))
       (setf (getf pl hf) (if (car hv) (car hv) ""))
@@ -46,8 +46,8 @@
   (if (not (time-stamp track))
     (setf (time-stamp track) (get-universal-time))))
 
-(defun proplist (track)
+(defun plist (track)
-  (let ((vl (head-proplist track)))
+  (let ((vl (head-plist track)))
     (with-slots ((trid trackid) (ts time-stamp) data) track
       (if trid (setf (getf vl :trackid) trid))
       (if ts (setf (getf vl :timestamp) 
@@ -62,7 +62,7 @@
          (table (storage:qualified-table-name st (table-name cont)))
          (res (car (storage:query st
            (sxql:insert-into table
-             (apply #'sxql:make-clause ':set= (proplist track))
+             (apply #'sxql:make-clause ':set= (plist track))
              (sxql:returning :trackid))))))
     (setf (trackid track) (cadr res))
     track))

test/test-storage.lisp

@@ -44,7 +44,7 @@
     (tracking:create-table cont)
     (setf tr (tracking:make-item cont "t01" "john"))
     (== (tracking:head tr) '("t01" "john"))
-    (== (tracking:head-proplist tr) '(:username "john" :taskid "t01"))
+    (== (tracking:head-plist tr) '(:username "john" :taskid "t01"))
     (== (tracking:data tr) nil)
     (setf (gethash :desc data) "scopes/storage: queries")
     (setf (tracking:data tr) data)