storage: use config mechanism for providing database settings

scopes.asd

@@ -21,3 +21,9 @@
   :components ((:file "test/test-storage"))
   :perform (test-op (o c) 
     (symbol-call :scopes/test-storage :run-all)))
+
+(defsystem :scopes/test-sqlite
+  :depends-on (:scopes)
+  :components ((:file "test/test-storage"))
+  :perform (test-op (o c) 
+    (symbol-call :scopes/test-storage :run-sqlite)))

storage/storage.lisp

@@ -4,8 +4,10 @@
 
 (defpackage :scopes/storage
   (:use :common-lisp)
-  (:local-nicknames (:alx :alexandria))
+  (:local-nicknames (:config :scopes/config)
-  (:export #:*db-config*
+                    (:alx :alexandria))
+  (:export #:config
+           #:*db-config*
            #:make-engine #:make-storage #:engine
            #:timestamp-to-sql
            #:db-options #:db-params #:qualified-table-name
@@ -15,7 +17,13 @@
 
 (in-package :scopes/storage)
 
-(defparameter *db-config* nil)
+;;;; config
+
+(defclass config (config:base)
+  ((config:env-slots :initform '(db-name db-user db-password))
+   (db-config :reader db-config :initarg :db-config)))
+
+;;;; db configurations
 
 (defvar *backends*
   '(:dbi dbi-make-engine))
@@ -32,9 +40,10 @@
    (params :initarg :params)
    (config :reader config :initarg :config)))
 
-(defun make-engine () 
+(defun make-engine (cfg)
-  (let ((backend (getf *db-config* :backend)))
+  (let* ((dbconf (db-config cfg))
-    (funcall (getf *backends* backend) *db-config*)))
+         (backend (getf dbconf :backend)))
+    (funcall (getf *backends* backend) dbconf)))
 
 (defgeneric timestamp-to-sql (engine ts)
   (:method ((engine db-engine) ts) ts))

test/config-postgres.lisp

@@ -1,6 +1,8 @@
 ;;; cl-scopes/test/config-postgres.lisp
 ;;; use: `(load "test/...")` from package scopes/test-storage
 
+(in-package :scopes/test-storage)
+
 (defparameter db-config-postgres
   '(:backend :dbi
     :db-type :postgres
@@ -13,4 +15,7 @@
     :options
 	 (:schema "testing")))
 
-(setf scopes/test-storage:*db-config-test* db-config-postgres)
+(config:root)
+
+(config:add :storage :class 'storage:config :setup #'core:default-setup
+            :db-config db-config-postgres)

test/config-sqlite.lisp

@@ -1,6 +1,8 @@
 ;;; cl-scopes/test/config-sqlite.lisp
 ;;; use: `(load "test/...")` from package scopes/test-storage
 
+(in-package :scopes/test-storage)
+
 (defparameter db-config-sqlite
   `(:backend :dbi
     :db-type :sqlite3
@@ -9,5 +11,7 @@
        ,(namestring (scopes/testing:test-path "test.db" "data")))
     :options nil))
 
-(setf scopes/test-storage:*db-config-test* db-config-sqlite)
+(config:root)
 
+(config:add :storage :class 'storage:config :setup #'core:default-setup
+            :db-config db-config-sqlite)

test/test-storage.lisp

@@ -4,7 +4,9 @@
 
 (defpackage :scopes/test-storage
   (:use :common-lisp)
-  (:local-nicknames (:storage :scopes/storage)
+  (:local-nicknames (:config :scopes/config)
+                    (:core :scopes/core)
+                    (:storage :scopes/storage)
                     (:tracking :scopes/storage/tracking) 
                     (:t :scopes/testing))
   (:export #:*db-config-test*
@@ -13,26 +15,24 @@
 
 (in-package :scopes/test-storage)
 
-(defparameter *db-config-test* nil)
-
 (defun run-all ()
   (run-sqlite)
   (run-postgres))
 
 (defun run-sqlite ()
   (load (t:test-path "config-sqlite"))
-  (let ((storage:*db-config* *db-config-test*)
+  (let ((t:*test-suite* (t:test-suite "sqlite")))
-        (t:*test-suite* (t:test-suite "sqlite")))
     (run)))
 
 (defun run-postgres ()
   (load (t:test-path "config-postgres"))
-  (let ((storage:*db-config* *db-config-test*)
+  (let ((t:*test-suite* (t:test-suite "postgres")))
-        (t:*test-suite* (t:test-suite "postgres")))
     (run)))
 
 (defun run ()
-  (let* ((engine (storage:make-engine))
+  (core:setup-services)
+  (let* ((cfg (core:config (core:find-service :storage)))
+         (engine (storage:make-engine cfg))
          (st (storage:make-storage engine)))
     (setf (storage:schema st) (getf (storage:db-options st) :schema))
     (test-track st)