use config class for storage setup (instead of prop list)
This commit is contained in:
parent
c653247670
commit
5b41d12756
5 changed files with 24 additions and 43 deletions
|
@ -4,7 +4,7 @@
|
||||||
|
|
||||||
(defpackage :scopes/config
|
(defpackage :scopes/config
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:export #:base #:root #:*root*
|
(:export #:base #:root #:*root* #:*current*
|
||||||
#:env-data #:env-keys #:env-prefix #:env-path
|
#:env-data #:env-keys #:env-prefix #:env-path
|
||||||
#:actions #:add #:add-action #:children #:env-slots
|
#:actions #:add #:add-action #:children #:env-slots
|
||||||
#:name #:setup #:parent #:shutdown))
|
#:name #:setup #:parent #:shutdown))
|
||||||
|
|
|
@ -8,8 +8,8 @@
|
||||||
(:core :scopes/core)
|
(:core :scopes/core)
|
||||||
(:alx :alexandria))
|
(:alx :alexandria))
|
||||||
(:export #:config
|
(:export #:config
|
||||||
#:storage #:setup
|
#:storage #:params #:setup
|
||||||
#:params #:qualified-table-name
|
#:qualified-table-name
|
||||||
#:do-sql #:query #:drop-table
|
#:do-sql #:query #:drop-table
|
||||||
#:normalize-keyword #:normalize-plist))
|
#:normalize-keyword #:normalize-plist))
|
||||||
|
|
||||||
|
@ -18,13 +18,10 @@
|
||||||
;;;; config
|
;;;; config
|
||||||
|
|
||||||
(defclass config (config:base)
|
(defclass config (config:base)
|
||||||
((config:env-slots :initform '(db-name db-user db-password))
|
((backend :reader backend :initarg :backend :initform :dbi)
|
||||||
(db-config :reader db-config :initarg :db-config) ;to be replaced
|
(db-type :reader db-type :initarg :db-type :initform :sqlite3)
|
||||||
(backend)
|
(connect-args :reader connect-args :initarg :connect-args)
|
||||||
(db-type)
|
(options :reader options :initarg :options :initform nil)))
|
||||||
(connect-args)))
|
|
||||||
|
|
||||||
;;;; db configurations
|
|
||||||
|
|
||||||
(defvar *db-params*
|
(defvar *db-params*
|
||||||
'(:sqlite3 (:id-type integer :json-type json :ts-sql identity)
|
'(:sqlite3 (:id-type integer :json-type json :ts-sql identity)
|
||||||
|
@ -43,9 +40,8 @@
|
||||||
(schema :accessor schema)))
|
(schema :accessor schema)))
|
||||||
|
|
||||||
(defun setup (cfg)
|
(defun setup (cfg)
|
||||||
(let* ((conf (db-config cfg))
|
(let* ((db-type (db-type cfg))
|
||||||
(db-type (getf conf :db-type))
|
(conn-args (connect-args cfg))
|
||||||
(conn-args (getf conf :connect-args))
|
|
||||||
(connect #'(lambda ()
|
(connect #'(lambda ()
|
||||||
(apply #'dbi:connect-cached db-type conn-args)))
|
(apply #'dbi:connect-cached db-type conn-args)))
|
||||||
(st (make-instance 'storage
|
(st (make-instance 'storage
|
||||||
|
@ -54,7 +50,7 @@
|
||||||
(ctx (make-instance 'context
|
(ctx (make-instance 'context
|
||||||
:config cfg :name (config:name cfg) :storage st)))
|
:config cfg :name (config:name cfg) :storage st)))
|
||||||
(setf (conn st) (funcall connect))
|
(setf (conn st) (funcall connect))
|
||||||
(setf (schema st) (getf (getf conf :options) :schema))
|
(setf (schema st) (getf (options cfg) :schema))
|
||||||
ctx))
|
ctx))
|
||||||
|
|
||||||
;;;; database (SQL) interface
|
;;;; database (SQL) interface
|
||||||
|
@ -100,7 +96,5 @@
|
||||||
(push v res)
|
(push v res)
|
||||||
(push (normalize-keyword k) res))))
|
(push (normalize-keyword k) res))))
|
||||||
|
|
||||||
;;;; backend-/driver-specific stuff
|
|
||||||
|
|
||||||
(defun ts-string (ts)
|
(defun ts-string (ts)
|
||||||
(format nil "~a" (local-time:universal-to-timestamp ts)))
|
(format nil "~a" (local-time:universal-to-timestamp ts)))
|
||||||
|
|
|
@ -3,19 +3,12 @@
|
||||||
|
|
||||||
(in-package :scopes/test-storage)
|
(in-package :scopes/test-storage)
|
||||||
|
|
||||||
(defparameter db-config-postgres
|
(defvar postgres-connect-args
|
||||||
'(:backend :dbi
|
'(:database-name "cltest" :host "localhost" :port 5432
|
||||||
:db-type :postgres
|
:username "testuser" :password "secret"))
|
||||||
:connect-args
|
|
||||||
(:database-name "cltest"
|
|
||||||
:host "localhost"
|
|
||||||
:port 5432
|
|
||||||
:username "testuser"
|
|
||||||
:password "secret")
|
|
||||||
:options
|
|
||||||
(:schema "testing")))
|
|
||||||
|
|
||||||
(config:root)
|
(config:root :env-keys '(db-name db-user db-password))
|
||||||
|
|
||||||
(config:add :storage :class 'storage:config :setup #'storage:setup
|
(config:add :storage :class 'storage:config :setup #'storage:setup
|
||||||
:db-config db-config-postgres)
|
:db-type :postgres
|
||||||
|
:connect-args postgres-connect-args)
|
||||||
|
|
|
@ -3,15 +3,11 @@
|
||||||
|
|
||||||
(in-package :scopes/test-storage)
|
(in-package :scopes/test-storage)
|
||||||
|
|
||||||
(defparameter db-config-sqlite
|
(defvar sqlite-connect-args
|
||||||
`(:backend :dbi
|
(list :database-name (namestring (scopes/testing:test-path "test.db" "data"))))
|
||||||
:db-type :sqlite3
|
|
||||||
:connect-args
|
|
||||||
(:database-name
|
|
||||||
,(namestring (scopes/testing:test-path "test.db" "data")))
|
|
||||||
:options nil))
|
|
||||||
|
|
||||||
(config:root)
|
(config:root :env-keys '(db-name))
|
||||||
|
|
||||||
(config:add :storage :class 'storage:config :setup #'storage:setup
|
(config:add :storage :class 'storage:config :setup #'storage:setup
|
||||||
:db-config db-config-sqlite)
|
:db-type :sqlite3
|
||||||
|
:connect-args sqlite-connect-args)
|
||||||
|
|
|
@ -9,8 +9,7 @@
|
||||||
(:storage :scopes/storage)
|
(:storage :scopes/storage)
|
||||||
(:tracking :scopes/storage/tracking)
|
(:tracking :scopes/storage/tracking)
|
||||||
(:t :scopes/testing))
|
(:t :scopes/testing))
|
||||||
(:export #:*db-config-test*
|
(:export #:run #:run-all #:run-postgres #:run-sqlite)
|
||||||
#:run #:run-all #:run-postgres #:run-sqlite)
|
|
||||||
(:import-from :scopes/testing #:deftest #:==))
|
(:import-from :scopes/testing #:deftest #:==))
|
||||||
|
|
||||||
(in-package :scopes/test-storage)
|
(in-package :scopes/test-storage)
|
||||||
|
@ -31,8 +30,7 @@
|
||||||
|
|
||||||
(defun run ()
|
(defun run ()
|
||||||
(core:setup-services)
|
(core:setup-services)
|
||||||
(let* ((ctx (core:find-service :storage))
|
(let ((ctx (core:find-service :storage)))
|
||||||
(cfg (core:config ctx)))
|
|
||||||
(test-track ctx)
|
(test-track ctx)
|
||||||
(t:show-result)))
|
(t:show-result)))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue