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

storage: working again after eliminiating engine / keep everything in context->storage

Browse source
This commit is contained in:
Helmut Merz 2024-06-28 16:17:02 +02:00
parent a7f449d8e6
commit 91dd8978ed
5 changed files with 35 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
storage/storage.lisp
View file

@ -11,6 +11,7 @@
#:*db-config* #:*db-config*
#:make-engine #:make-storage #:engine #:make-engine #:make-storage #:engine
#:timestamp-to-sql #:timestamp-to-sql
#:storage #:setup
#:params #:db-options #:db-params #:qualified-table-name #:params #:db-options #:db-params #:qualified-table-name
#:do-sql #:query #:drop-table #:do-sql #:query #:drop-table
#:schema #:schema
@ -36,8 +37,8 @@
'(:postgres db-engine-pg)) '(:postgres db-engine-pg))
(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)
:postgres (:id-type bigserial :json-type jsonb :ts-sql #'ts-string))) :postgres (:id-type bigserial :json-type jsonb :ts-sql ts-string)))
(defclass db-engine () (defclass db-engine ()
((connect :initarg :connect) ((connect :initarg :connect)
@ -61,9 +62,24 @@
((engine :reader engine :initarg :engine) ((engine :reader engine :initarg :engine)
(connect :reader connect :initarg :connect) (connect :reader connect :initarg :connect)
(params :reader params :initarg :params) (params :reader params :initarg :params)
(conn :reader conn) (conn :accessor conn)
(schema :accessor schema))) (schema :accessor schema)))
(defun setup (cfg)
(let* ((conf (db-config cfg))
(db-type (getf conf :db-type))
(conn-args (getf conf :connect-args))
(connect #'(lambda ()
(apply #'dbi:connect-cached db-type conn-args)))
(st (make-instance 'storage
:params (getf *db-params* db-type)
:connect connect))
(ctx (make-instance 'context
:config cfg :name (config:name cfg) :storage st)))
(setf (conn st) (funcall connect))
(setf (schema st) (getf (getf conf :options) :schema))
ctx))
(defun make-storage (engine) (defun make-storage (engine)
(let ((st (make-instance 'storage :engine engine)) (let ((st (make-instance 'storage :engine engine))
(conn (funcall (slot-value engine 'connect)))) (conn (funcall (slot-value engine 'connect))))

8
storage/tracking.lisp
View file

@ -25,7 +25,7 @@
(storage:engine (storage (container tr)))) (storage:engine (storage (container tr))))
(defun timestamp-to-sql (tr ts) (defun timestamp-to-sql (tr ts)
(funcall (getf (params (storage (container tr))) :ts-sql) ts)) (funcall (getf (storage:params (storage (container tr))) :ts-sql) ts))
(defclass container () (defclass container ()
((item-factory :initform #'(lambda (cont head) ((item-factory :initform #'(lambda (cont head)
@ -53,8 +53,8 @@
(let ((vl (head-plist track))) (let ((vl (head-plist track)))
(with-slots ((trid trackid) (ts time-stamp) data) track (with-slots ((trid trackid) (ts time-stamp) data) track
(if trid (setf (getf vl :trackid) trid)) (if trid (setf (getf vl :trackid) trid))
(if ts (setf (getf vl :timestamp) (if ts (setf (getf vl :timestamp) (timestamp-to-sql track ts)))
(storage:timestamp-to-sql (engine track) ts))) ;(storage:timestamp-to-sql (engine track) ts)))
(if data (setf (getf vl :data) (jzon:stringify data)))) (if data (setf (getf vl :data) (jzon:stringify data))))
vl)) vl))
@ -95,7 +95,7 @@
(tn (table-name cont)) (tn (table-name cont))
(table (storage:qualified-table-name st tn)) (table (storage:qualified-table-name st tn))
(head-fields (head-fields cont)) (head-fields (head-fields cont))
(params (storage:db-params st)) (params (storage: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) (hf-def (mapcar #'(lambda (x)

2
test/config-postgres.lisp
View file

@ -17,5 +17,5 @@
(config:root) (config:root)
(config:add :storage :class 'storage:config :setup #'core:default-setup (config:add :storage :class 'storage:config :setup #'storage:setup
:db-config db-config-postgres) :db-config db-config-postgres)

2
test/config-sqlite.lisp
View file

@ -13,5 +13,5 @@
(config:root) (config:root)
(config:add :storage :class 'storage:config :setup #'core:default-setup (config:add :storage :class 'storage:config :setup #'storage:setup
:db-config db-config-sqlite) :db-config db-config-sqlite)

17
test/test-storage.lisp
View file

@ -31,15 +31,18 @@
(defun run () (defun run ()
(core:setup-services) (core:setup-services)
(let* ((cfg (core:config (core:find-service :storage))) (let* ((ctx (core:find-service :storage))
(engine (storage:make-engine cfg)) (cfg (core:config ctx)))
(st (storage:make-storage engine))) ;(engine (storage:make-engine cfg))
(setf (storage:schema st) (getf (storage:db-options st) :schema)) ;(st (storage:make-storage engine)))
(test-track st) ;(setf (storage:schema st) (getf (storage:db-options st) :schema))
(test-track ctx)
(t:show-result))) (t:show-result)))
(deftest test-track (st) (deftest test-track (ctx)
(let (cont tr tr2 (data (make-hash-table))) (let ((st (storage:storage ctx))
(data (make-hash-table))
cont tr tr2)
(setf cont (make-instance 'tracking:container :storage st)) (setf cont (make-instance 'tracking:container :storage st))
(defparameter cl-user::*cont cont) (defparameter cl-user::*cont cont)
(storage:drop-table st :tracks) (storage:drop-table st :tracks)