work in progress: access to SQL DB: create/drop table, config via etc.lisp

scopes.asd

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

storage/storage.lisp

@@ -4,11 +4,20 @@
 
 (defpackage :scopes/storage
   (:use :common-lisp)
-  (:export #:storage))
+  (:export #:*db-params* 
+		   #:storage
+		   #:drop-table))
 
 (in-package :scopes/storage)
 
+(defparameter *db-params* nil)
+
 (defclass storage ()
   ((db :initarg :db)
    (config :initarg :config)
    (schema :initarg :schema)))
+
+(defun drop-table (st tn)
+  st
+  (print (sxql:yield
+	(sxql:drop-table tn :if-exists t))))

storage/tracking.lisp

@@ -6,7 +6,7 @@
   (:use :common-lisp)
   (:export #:track #:time-stamp #:data
 		   #:container
-		   #:crtable))
+		   #:create-table))
 
 (in-package :scopes/storage/tracking)
 
@@ -19,9 +19,15 @@
 (defclass container ()
   ((storage :initarg :storage)))
 
-(defun crtable (tn) 
-  (sxql:yield
-	(sxql:make-statement :create-table tn
-      (list
-		(list 'trackid :type 'bigserial :primary-key t)
-		(list 'taskid :type 'text)))))
+(defun create-table (storage table-name head-fields) 
+  storage
+  (let 
+	((id-type 'bigserial)
+	 (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 jsonb))))))))

test/etc.lisp

@@ -0,0 +1,10 @@
+;;; cl-scopes/test/etc.lisp
+
+(defparameter db-params-sqlite
+  '(:db-type :sqlite3))
+
+(defparameter db-params-postgres
+  '(:db-type :postgres))
+
+(setf storage:*db-params* db-params-sqlite)
+(setf *db-params-postgres* db-params-postgres)

test/test-storage.lisp

@@ -4,18 +4,28 @@
 
 (defpackage :scopes/test-storage
   (:use :common-lisp)
-  (:local-nicknames (:tracking :scopes/storage/tracking) 
+  (:local-nicknames (:storage :scopes/storage)
+					(:tracking :scopes/storage/tracking) 
 					(:t :scopes/testing))
-  (:export #:run))
+  (:export #:run #:try))
 
 (in-package :scopes/test-storage)
 
+(defparameter *db-params-postgres* nil)
+(load "test/etc")
+(defun try()
+  (print storage:*db-params*)
+  (print *db-params-postgres*))
+
 (defun run ()
-  (let ((tst (t:test-suite)))
-    (test-track tst)
+  (let ((st (make-instance 'storage:storage))
+		(tst (t:test-suite)))
+    (test-track tst st)
     (t:result tst)))
 
-(defun test-track (tst)
+(defun test-track (tst st)
   (let ((tr (make-instance 'tracking:track)))
+	(storage:drop-table st :tracks)
+	(tracking:create-table st :tracks '(trackid username))
 	;(setf (scs:data tr) nil)
 	(t:assert-eq tst (tracking:data tr) nil)))