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

19
storage/tracking.lisp
View file

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