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

create table: use schema option if set

Browse source
This commit is contained in:
Helmut Merz 2024-05-14 09:49:50 +02:00
parent 9e1a8a92b9
commit 4dab1785a5
3 changed files with 33 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
storage/storage.lisp
View file

@ -6,7 +6,9 @@
(:use :common-lisp) (:use :common-lisp)
(:export #:*db-config* (:export #:*db-config*
#:make-engine #:make-storage #:make-engine #:make-storage
#:db-params #:do-sql #:drop-table)) #:db-options #:db-params #:qualified-table-name
#:do-sql #:drop-table
#:schema))
(in-package :scopes/storage) (in-package :scopes/storage)
@ -22,16 +24,16 @@
(defclass db-engine () (defclass db-engine ()
((connect :initarg :connect) ((connect :initarg :connect)
(params :initarg :params) (params :initarg :params)
(config :initarg :config))) (config :reader config :initarg :config)))
(defun make-engine () (defun make-engine ()
(let ((backend (getf *db-config* :backend))) (let ((backend (getf *db-config* :backend)))
(funcall (getf *backends* backend) *db-config*))) (funcall (getf *backends* backend) *db-config*)))
(defclass storage () (defclass storage ()
((engine :initarg :engine) ((engine :reader engine :initarg :engine)
(conn :reader conn) (conn :reader conn)
(schema))) (schema :accessor schema)))
(defun make-storage (engine) (defun make-storage (engine)
(let ((st (make-instance 'storage :engine engine)) (let ((st (make-instance 'storage :engine engine))
@ -42,6 +44,16 @@
(defun db-params (st) (defun db-params (st)
(slot-value (slot-value st 'engine) 'params)) (slot-value (slot-value st 'engine) 'params))
(defun db-options (st)
(let ((config (config (engine st))))
(getf config :options)))
(defun qualified-table-name (st tn)
(let ((schema (schema st)))
(if schema
(intern (format nil "~a.~a" schema (symbol-name tn)))
tn)))
(defun do-sql (st spec) (defun do-sql (st spec)
(let ((sql (sxql:yield spec))) (let ((sql (sxql:yield spec)))
(print sql) (print sql)

23
storage/tracking.lisp
View file

@ -18,14 +18,16 @@
(container :initarg :container))) (container :initarg :container)))
(defclass container () (defclass container ()
((storage :initarg :storage) ((storage :reader storage :initarg :storage)
(table-name :reader table-name :initform :tracks) (table-name :reader table-name :initform :tracks)
(head-fields :reader head-fields :initform '(:taskid :username)) (head-fields :reader head-fields :initform '(taskid username))
(indexes :reader indexes :initform '((:taskid :username) (username))))) (indexes :reader indexes :initform '((taskid username) (username)))))
(defun create-table (st cont) (defun create-table (cont)
(let* (let*
((table-name (table-name cont)) ((st (storage cont))
(tn (table-name cont))
(table (storage:qualified-table-name st tn))
(head-fields (head-fields cont)) (head-fields (head-fields cont))
(params (storage:db-params st)) (params (storage:db-params st))
(id-type (getf params :id-type)) (id-type (getf params :id-type))
@ -34,21 +36,22 @@
(list x :type 'text :not-null t :default '|''|)) (list x :type 'text :not-null t :default '|''|))
head-fields))) head-fields)))
(storage:do-sql st (storage:do-sql st
(sxql:make-statement :create-table table-name (sxql:make-statement :create-table table
(nconc (nconc
`((trackid :type ,id-type :primary-key t :not-null t)) `((trackid :type ,id-type :primary-key t :not-null t))
hf-def hf-def
`((timestamp :type timestamptz :not-null t :default current_timestamp) `((timestamp :type timestamptz :not-null t :default current_timestamp)
(data :type ,json-type :not-null t :default |'{}'|))))))) (data :type ,json-type :not-null t :default |'{}'|)))))
(create-indexes st table tn (indexes cont))))
(defun create-indexes (st tname ixs) (defun create-indexes (st table tname ixs)
(let ((i 1) (let ((i 1)
(tn (symbol-name tname))) (tn (symbol-name tname)))
(dolist (ix ixs) (dolist (ix ixs)
(let ((ixname (intern (format nil "IDX_~a_~d" tn i)))) (let ((ixname (intern (format nil "IDX_~a_~d" tn i))))
(incf i) (incf i)
(storage:do-sql st (storage:do-sql st
(sxql:create-index ixname :on (cons tname ix))))) (sxql:create-index ixname :on (cons table ix)))))
(storage:do-sql st (storage:do-sql st
(sxql:create-index (intern (format nil "IDX_~a_TS" tn)) (sxql:create-index (intern (format nil "IDX_~a_TS" tn))
:on (cons tname '(timestamp)))))) :on (cons table '(timestamp))))))

8
test/test-storage.lisp
View file

@ -33,13 +33,13 @@
(let* ((engine (storage:make-engine)) (let* ((engine (storage:make-engine))
(st (storage:make-storage engine)) (st (storage:make-storage engine))
(t:*tst* (t:test-suite))) (t:*tst* (t:test-suite)))
(setf (storage:schema st) (getf (storage:db-options st) :schema))
(test-track st) (test-track st)
(t:show-result))) (t:show-result)))
(defun test-track (st) (defun test-track (st)
(let* ((cont (make-instance 'tracking:container)) (let* ((cont (make-instance 'tracking:container :storage st))
(tr (make-instance 'tracking:track :container cont))) (tr (make-instance 'tracking:track :container cont)))
(storage:drop-table st :tracks) (storage:drop-table st :testing.tracks)
(tracking:create-table st cont) (tracking:create-table cont)
(tracking:create-indexes st :tracks '((taskid) (taskid username)))
(== (tracking:data tr) nil))) (== (tracking:data tr) nil)))