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)
(:export #:*db-config*
#: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)
@ -22,16 +24,16 @@
(defclass db-engine ()
((connect :initarg :connect)
(params :initarg :params)
(config :initarg :config)))
(config :reader config :initarg :config)))
(defun make-engine ()
(let ((backend (getf *db-config* :backend)))
(funcall (getf *backends* backend) *db-config*)))
(defclass storage ()
((engine :initarg :engine)
((engine :reader engine :initarg :engine)
(conn :reader conn)
(schema)))
(schema :accessor schema)))
(defun make-storage (engine)
(let ((st (make-instance 'storage :engine engine))
@ -42,6 +44,16 @@
(defun db-params (st)
(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)
(let ((sql (sxql:yield spec)))
(print sql)

23
storage/tracking.lisp
View file

@ -18,14 +18,16 @@
(container :initarg :container)))
(defclass container ()
((storage :initarg :storage)
((storage :reader storage :initarg :storage)
(table-name :reader table-name :initform :tracks)
(head-fields :reader head-fields :initform '(:taskid :username))
(indexes :reader indexes :initform '((:taskid :username) (username)))))
(head-fields :reader head-fields :initform '(taskid username))
(indexes :reader indexes :initform '((taskid username) (username)))))
(defun create-table (st cont)
(defun create-table (cont)
(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))
(params (storage:db-params st))
(id-type (getf params :id-type))
@ -34,21 +36,22 @@
(list x :type 'text :not-null t :default '|''|))
head-fields)))
(storage:do-sql st
(sxql:make-statement :create-table table-name
(sxql:make-statement :create-table table
(nconc
`((trackid :type ,id-type :primary-key t :not-null t))
hf-def
`((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)
(tn (symbol-name tname)))
(dolist (ix ixs)
(let ((ixname (intern (format nil "IDX_~a_~d" tn i))))
(incf i)
(storage:do-sql st
(sxql:create-index ixname :on (cons tname ix)))))
(sxql:create-index ixname :on (cons table ix)))))
(storage:do-sql st
(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))
(st (storage:make-storage engine))
(t:*tst* (t:test-suite)))
(setf (storage:schema st) (getf (storage:db-options st) :schema))
(test-track st)
(t:show-result)))
(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)))
(storage:drop-table st :tracks)
(tracking:create-table st cont)
(tracking:create-indexes st :tracks '((taskid) (taskid username)))
(storage:drop-table st :testing.tracks)
(tracking:create-table cont)
(== (tracking:data tr) nil)))