cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

storage refactoring: prepare for using methods for storage creation and db access

Browse source
This commit is contained in:
Helmut Merz 2024-05-12 12:37:24 +02:00
parent 3b36d4e54a
commit 559c3f3281
4 changed files with 24 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
storage/storage.lisp
View file

@ -14,14 +14,18 @@
(defparameter *db-config* nil) (defparameter *db-config* nil)
(defparameter *db-engine* nil) (defparameter *db-engine* nil)
(defparameter *backends*
'(:dbi #'dbi-make-storage))
(defvar *db-params*
'(:sqlite3 (:id-type integer :json-type json)
:postgres (:id-type bigserial :json-type jsonb)))
(defclass db-engine () (defclass db-engine ()
((connect :initarg :connect) ((connect :initarg :connect)
(params :initarg :params) (params :initarg :params)
(config :initarg :config))) (config :initarg :config)))
(defun make-engine ()
(make-engine-db (getf *db-config* :db-type) *db-config*))
(defclass storage () (defclass storage ()
((engine :initarg :engine) ((engine :initarg :engine)
(db :reader db) (db :reader db)
@ -41,24 +45,12 @@
(print sql) (print sql)
(dbi:do-sql (db st) sql))) (dbi:do-sql (db st) sql)))
;; db-driver-specific stuff (defun make-engine ()
(let* ((config *db-config*)
(defun connect-sqlite (params config) (db-type (getf config :db-type))
(declare (ignorable params)) (params (getf *db-params* db-type))
(apply #'dbi:connect-cached :sqlite3 (getf config :connect-args))) (conn-args (getf config :connect-args)))
(make-instance 'db-engine
(defun connect-postgres (params config) :params params :config config
(declare (ignorable params))
(apply #'dbi:connect-cached :postgres (getf config :connect-args)))
(defvar *db-params*
'(:sqlite3 (:connect connect-sqlite
:id-type integer :json-type json)
:postgres (:connect connect-postgres
:id-type bigserial :json-type jsonb)))
(defun make-engine-db (db-type config)
(let ((params (getf *db-params* db-type)))
(make-instance 'db-engine :params params :config config
:connect #'(lambda () :connect #'(lambda ()
(funcall (getf params :connect) params config))))) (apply #'dbi:connect-cached db-type conn-args)))))

8
storage/tracking.lisp
View file

@ -25,14 +25,16 @@
((params (storage:db-params st)) ((params (storage:db-params st))
(id-type (getf params :id-type)) (id-type (getf params :id-type))
(json-type (getf params :json-type)) (json-type (getf params :json-type))
(hf-def (mapcar #'(lambda (x) (list x :type 'text)) head-fields)) (hf-def (mapcar #'(lambda (x)
(list x :type 'text :not-null t :default '|''|))
head-fields))
(sql (sql
(sxql:yield (sxql:yield
(sxql:make-statement :create-table table-name (sxql:make-statement :create-table table-name
(nconc (nconc
`((trackid :type ,id-type :primary-key t)) `((trackid :type ,id-type :primary-key t :not-null t))
hf-def hf-def
`((timestamp :type timestamp) `((timestamp :type timestamptz :not-null t :default current_timestamp)
(data :type ,json-type))))))) (data :type ,json-type)))))))
(print sql) (print sql)
(dbi:do-sql (storage:db st) sql))) (dbi:do-sql (storage:db st) sql)))

3
test/config-postgres.lisp
View file

@ -2,7 +2,8 @@
;;; use: `(load "test/...")` from package scopes/test-storage ;;; use: `(load "test/...")` from package scopes/test-storage
(defparameter db-config-postgres (defparameter db-config-postgres
'(:db-type :postgres '(:backend :dbi
:db-type :postgres
:connect-args :connect-args
(:database-name "cltest" (:database-name "cltest"
:host "localhost" :host "localhost"

3
test/config-sqlite.lisp
View file

@ -2,7 +2,8 @@
;;; use: `(load "test/...")` from package scopes/test-storage ;;; use: `(load "test/...")` from package scopes/test-storage
(defparameter db-config-sqlite (defparameter db-config-sqlite
'(:db-type :sqlite3 '(:backend :dbi
:db-type :sqlite3
:connect-args :connect-args
(:database-name "test/test.db") (:database-name "test/test.db")
:options nil)) :options nil))