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

more refactoring, improve SQL generation

Browse source
This commit is contained in:
Helmut Merz 2024-05-13 09:43:35 +02:00
parent c832ba70f3
commit 935465245f
2 changed files with 18 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
storage/storage.lisp
View file

@ -5,8 +5,8 @@
(defpackage :scopes/storage (defpackage :scopes/storage
(:use :common-lisp) (:use :common-lisp)
(:export #:*db-config* (:export #:*db-config*
#:make-engine #:make-storage #:db-params #:make-engine #:make-storage
#:do-sql #:drop-table)) #:db-params #:do-sql #:drop-table))
(in-package :scopes/storage) (in-package :scopes/storage)
@ -30,25 +30,25 @@
(defclass storage () (defclass storage ()
((engine :initarg :engine) ((engine :initarg :engine)
(db :reader db) (conn :reader conn)
(schema))) (schema)))
(defun make-storage (engine) (defun make-storage (engine)
(let ((st (make-instance 'storage :engine engine)) (let ((st (make-instance 'storage :engine engine))
(db (funcall (slot-value engine 'connect)))) (conn (funcall (slot-value engine 'connect))))
(setf (slot-value st 'db) db) (setf (slot-value st 'conn) conn)
st)) st))
(defun db-params (st) (defun db-params (st)
(slot-value (slot-value st 'engine) 'params)) (slot-value (slot-value st 'engine) 'params))
(defun do-sql (st sql) (defun do-sql (st spec)
(dbi:do-sql (db st) sql)) (let ((sql (sxql:yield spec)))
(print sql)
(dbi:do-sql (conn st) sql)))
(defun drop-table (st tn) (defun drop-table (st tn)
(let ((sql (sxql:yield (sxql:drop-table tn :if-exists t)))) (do-sql st (sxql:drop-table tn :if-exists t)))
(print sql)
(do-sql st sql)))
;;; backend-/driver-specific stuff ;;; backend-/driver-specific stuff

7
storage/tracking.lisp
View file

@ -27,14 +27,11 @@
(json-type (getf params :json-type)) (json-type (getf params :json-type))
(hf-def (mapcar #'(lambda (x) (hf-def (mapcar #'(lambda (x)
(list x :type 'text :not-null t :default '|''|)) (list x :type 'text :not-null t :default '|''|))
head-fields)) head-fields)))
(sql (storage:do-sql st
(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 :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))))))) (data :type ,json-type)))))))
(print sql)
(storage:do-sql st sql)))