minor refactoring of basic storage code

storage/storage.lisp

@@ -4,8 +4,8 @@
 
 (defpackage :scopes/storage
   (:use :common-lisp)
-  (:export #:*db-config*
-           #:make-storage
+  (:export #:*db-config* #:*db-engine*
+           #:make-engine #:make-storage #:db-params
            #:drop-table))
 
 (in-package :scopes/storage)
@@ -17,14 +17,19 @@
   ((params :initarg :params)
    (config :initarg :config)))
 
+(defun make-engine ()
+  (make-engine-db (getf *db-config* :db-type) *db-config*))
+
 (defclass storage ()
   ((engine :initarg :engine)
    (db)
    (schema)))
 
 (defun make-storage ()
-  (let ((engine (make-engine (getf *db-config* :db-type) *db-config*)))
-    (make-instance 'storage :engine engine)))
+  (make-instance 'storage :engine *db-engine*))
+
+(defun db-params (st)
+  (slot-value (slot-value st 'engine) 'params))
 
 (defun drop-table (st tn)
   st
@@ -33,11 +38,9 @@
 
 ;; db-driver-specific stuff
 
-(defun make-engine (db-type config)
+(defun make-engine-db (db-type config)
   (let ((params 
-          (cond 
-            ((eq db-type :sqlite3)
-             '(:id-type integer :json-type json))
-            ((eq db-type :postgres)
-             '(:id-type bigserial :json-type jsonb)))))
+          (case db-type 
+            (:sqlite3 '(:id-type integer :json-type json))
+            (:postgres '(:id-type bigserial :json-type jsonb)))))
     (make-instance 'db-engine :params params :config config)))

storage/tracking.lisp

@@ -20,17 +20,18 @@
 (defclass container ()
   ((storage :initarg :storage)))
 
-(defun create-table (storage table-name head-fields) 
-  storage
+(defun create-table (st table-name head-fields) 
   (let*
-    ((params (slot-value (slot-value storage 'storage::engine) 'storage::params))
+    ((params (storage:db-params st))
      (id-type (getf params :id-type))
      (json-type (getf params :json-type))
-     (hf-def (mapcar #'(lambda (x) (list x :type 'text)) head-fields)))
-    (print (sxql:yield
-      (sxql:make-statement :create-table table-name
-        (nconc
-          `((trackid :type ,id-type :primary-key t))
-          hf-def
-          `((timestamp :type timestamp)
-            (data :type ,json-type))))))))
+     (hf-def (mapcar #'(lambda (x) (list x :type 'text)) head-fields))
+     (sql 
+       (sxql:yield
+         (sxql:make-statement :create-table table-name
+           (nconc
+             `((trackid :type ,id-type :primary-key t))
+             hf-def
+             `((timestamp :type timestamp)
+               (data :type ,json-type)))))))
+    (print sql)))

test/test-storage.lisp

@@ -8,7 +8,7 @@
                     (:tracking :scopes/storage/tracking) 
                     (:t :scopes/testing))
   (:export #:*db-config-postgres* #:*db-config-sqlite*
-           #:run #:run-all #:run-postgres #:run-sqlite #:try)
+           #:run #:run-all #:run-postgres #:run-sqlite)
   (:import-from :scopes/testing #:==))
 
 (in-package :scopes/test-storage)
@@ -17,11 +17,6 @@
 (defparameter *db-config-postgres* nil)
 (load "test/etc")
 
-(defun try()
-  (setf storage:*db-config* *db-config-sqlite*)
-  (print storage:*db-config*)
-  (print *db-config-postgres*))
-
 (defun run-all ()
   (run-sqlite)
   (run-postgres))
@@ -35,8 +30,9 @@
     (run)))
 
 (defun run ()
-  (let ((st (storage:make-storage))
-        (t:*tst* (t:test-suite)))
+  (let* ((storage:*db-engine* (storage:make-engine))
+         (st (storage:make-storage))
+         (t:*tst* (t:test-suite)))
     (test-track st)
     (t:show-result)))
 
@@ -44,5 +40,4 @@
   (let ((tr (make-instance 'tracking:track)))
     (storage:drop-table st :tracks)
     (tracking:create-table st :tracks '(taskid username))
-    ;(setf (scs:data tr) nil)
     (== (tracking:data tr) nil)))