diff --git a/scopes.asd b/scopes.asd index a9e9ca3..e92a0f1 100644 --- a/scopes.asd +++ b/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")) diff --git a/storage/storage.lisp b/storage/storage.lisp index 3d1cf9a..3a6630c 100644 --- a/storage/storage.lisp +++ b/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-pg) ts) - (format nil "~a" (local-time:universal-to-timestamp ts)))) + (:method ((engine db-engine) ts) 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))) + diff --git a/storage/tracking.lisp b/storage/tracking.lisp index 9a62b4d..af272ab 100644 --- a/storage/tracking.lisp +++ b/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) - (let ((vl (head-proplist track))) +(defun plist (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)) diff --git a/test/test-storage.lisp b/test/test-storage.lisp index bc0a3fc..65e34b3 100644 --- a/test/test-storage.lisp +++ b/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)