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

work in progress: get rid of engine, keep storage in storage:context

Browse source
This commit is contained in:
Helmut Merz 2024-06-28 15:12:33 +02:00
parent 0aa8ecb732
commit a7f449d8e6
2 changed files with 23 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
storage/storage.lisp
View file

@ -5,12 +5,13 @@
(defpackage :scopes/storage (defpackage :scopes/storage
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:config :scopes/config) (:local-nicknames (:config :scopes/config)
(:core :scopes/core)
(:alx :alexandria)) (:alx :alexandria))
(:export #:config (:export #:config
#:*db-config* #:*db-config*
#:make-engine #:make-storage #:engine #:make-engine #:make-storage #:engine
#:timestamp-to-sql #:timestamp-to-sql
#:db-options #:db-params #:qualified-table-name #:params #:db-options #:db-params #:qualified-table-name
#:do-sql #:query #:drop-table #:do-sql #:query #:drop-table
#:schema #:schema
#:normalize-keyword #:normalize-plist)) #:normalize-keyword #:normalize-plist))
@ -21,7 +22,10 @@
(defclass config (config:base) (defclass config (config:base)
((config:env-slots :initform '(db-name db-user db-password)) ((config:env-slots :initform '(db-name db-user db-password))
(db-config :reader db-config :initarg :db-config))) (db-config :reader db-config :initarg :db-config) ;to be replaced
(backend)
(db-type)
(connect-args)))
;;;; db configurations ;;;; db configurations
@ -32,8 +36,8 @@
'(:postgres db-engine-pg)) '(:postgres db-engine-pg))
(defvar *db-params* (defvar *db-params*
'(:sqlite3 (:id-type integer :json-type json) '(:sqlite3 (:id-type integer :json-type json :ts-sql #'identity)
:postgres (:id-type bigserial :json-type jsonb))) :postgres (:id-type bigserial :json-type jsonb :ts-sql #'ts-string)))
(defclass db-engine () (defclass db-engine ()
((connect :initarg :connect) ((connect :initarg :connect)
@ -48,8 +52,15 @@
(defgeneric timestamp-to-sql (engine ts) (defgeneric timestamp-to-sql (engine ts)
(:method ((engine db-engine) ts) ts)) (:method ((engine db-engine) ts) ts))
;;;; context and storage classes
(defclass context (core:context)
((storage :reader storage :initarg :storage)))
(defclass storage () (defclass storage ()
((engine :reader engine :initarg :engine) ((engine :reader engine :initarg :engine)
(connect :reader connect :initarg :connect)
(params :reader params :initarg :params)
(conn :reader conn) (conn :reader conn)
(schema :accessor schema))) (schema :accessor schema)))
@ -66,6 +77,8 @@
(let ((config (config (engine st)))) (let ((config (config (engine st))))
(getf config :options))) (getf config :options)))
;;;; database (SQL) interface
(defun qualified-table-name (st tn) (defun qualified-table-name (st tn)
(let ((schema (schema st))) (let ((schema (schema st)))
(if schema (if schema
@ -122,5 +135,7 @@
(defclass db-engine-pg (db-engine) ()) (defclass db-engine-pg (db-engine) ())
(defmethod timestamp-to-sql ((engine db-engine-pg) ts) (defmethod timestamp-to-sql ((engine db-engine-pg) ts)
(format nil "~a" (local-time:universal-to-timestamp ts))) (ts-string ts))
(defun ts-string (ts)
(format nil "~a" (local-time:universal-to-timestamp ts)))

3
storage/tracking.lisp
View file

@ -24,6 +24,9 @@
(defun engine (tr) (defun engine (tr)
(storage:engine (storage (container tr)))) (storage:engine (storage (container tr))))
(defun timestamp-to-sql (tr ts)
(funcall (getf (params (storage (container tr))) :ts-sql) ts))
(defclass container () (defclass container ()
((item-factory :initform #'(lambda (cont head) ((item-factory :initform #'(lambda (cont head)
(make-instance 'track :container cont :head head))) (make-instance 'track :container cont :head head)))