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

minor refactoring of basic storage code

Browse source
This commit is contained in:
Helmut Merz 2024-05-07 19:21:30 +02:00
parent c4fdc6eeec
commit 8dfb22033d
3 changed files with 29 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
storage/storage.lisp
View file

@ -4,8 +4,8 @@
(defpackage :scopes/storage (defpackage :scopes/storage
(:use :common-lisp) (:use :common-lisp)
(:export #:*db-config* (:export #:*db-config* #:*db-engine*
#:make-storage #:make-engine #:make-storage #:db-params
#:drop-table)) #:drop-table))
(in-package :scopes/storage) (in-package :scopes/storage)
@ -17,14 +17,19 @@
((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) (db)
(schema))) (schema)))
(defun make-storage () (defun make-storage ()
(let ((engine (make-engine (getf *db-config* :db-type) *db-config*))) (make-instance 'storage :engine *db-engine*))
(make-instance 'storage :engine engine)))
(defun db-params (st)
(slot-value (slot-value st 'engine) 'params))
(defun drop-table (st tn) (defun drop-table (st tn)
st st
@ -33,11 +38,9 @@
;; db-driver-specific stuff ;; db-driver-specific stuff
(defun make-engine (db-type config) (defun make-engine-db (db-type config)
(let ((params (let ((params
(cond (case db-type
((eq db-type :sqlite3) (:sqlite3 '(:id-type integer :json-type json))
'(:id-type integer :json-type json)) (:postgres '(:id-type bigserial :json-type jsonb)))))
((eq db-type :postgres)
'(:id-type bigserial :json-type jsonb)))))
(make-instance 'db-engine :params params :config config))) (make-instance 'db-engine :params params :config config)))

13
storage/tracking.lisp
View file

@ -20,17 +20,18 @@
(defclass container () (defclass container ()
((storage :initarg :storage))) ((storage :initarg :storage)))
(defun create-table (storage table-name head-fields) (defun create-table (st table-name head-fields)
storage
(let* (let*
((params (slot-value (slot-value storage 'storage::engine) 'storage::params)) ((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)) head-fields))
(print (sxql:yield (sql
(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))
hf-def hf-def
`((timestamp :type timestamp) `((timestamp :type timestamp)
(data :type ,json-type)))))))) (data :type ,json-type)))))))
(print sql)))

11
test/test-storage.lisp
View file

@ -8,7 +8,7 @@
(:tracking :scopes/storage/tracking) (:tracking :scopes/storage/tracking)
(:t :scopes/testing)) (:t :scopes/testing))
(:export #:*db-config-postgres* #:*db-config-sqlite* (:export #:*db-config-postgres* #:*db-config-sqlite*
#:run #:run-all #:run-postgres #:run-sqlite #:try) #:run #:run-all #:run-postgres #:run-sqlite)
(:import-from :scopes/testing #:==)) (:import-from :scopes/testing #:==))
(in-package :scopes/test-storage) (in-package :scopes/test-storage)
@ -17,11 +17,6 @@
(defparameter *db-config-postgres* nil) (defparameter *db-config-postgres* nil)
(load "test/etc") (load "test/etc")
(defun try()
(setf storage:*db-config* *db-config-sqlite*)
(print storage:*db-config*)
(print *db-config-postgres*))
(defun run-all () (defun run-all ()
(run-sqlite) (run-sqlite)
(run-postgres)) (run-postgres))
@ -35,7 +30,8 @@
(run))) (run)))
(defun run () (defun run ()
(let ((st (storage:make-storage)) (let* ((storage:*db-engine* (storage:make-engine))
(st (storage:make-storage))
(t:*tst* (t:test-suite))) (t:*tst* (t:test-suite)))
(test-track st) (test-track st)
(t:show-result))) (t:show-result)))
@ -44,5 +40,4 @@
(let ((tr (make-instance 'tracking:track))) (let ((tr (make-instance 'tracking:track)))
(storage:drop-table st :tracks) (storage:drop-table st :tracks)
(tracking:create-table st :tracks '(taskid username)) (tracking:create-table st :tracks '(taskid username))
;(setf (scs:data tr) nil)
(== (tracking:data tr) nil))) (== (tracking:data tr) nil)))