use specialized engine subclass for postres for controlling timestamp conversion
This commit is contained in:
parent
bc6c1d8e31
commit
1f8fe04b45
3 changed files with 23 additions and 5 deletions
|
@ -5,7 +5,8 @@
|
||||||
(defpackage :scopes/storage
|
(defpackage :scopes/storage
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:export #:*db-config*
|
(:export #:*db-config*
|
||||||
#:make-engine #:make-storage
|
#:make-engine #:make-storage #:engine
|
||||||
|
#:timestamp-to-sql
|
||||||
#:db-options #:db-params #:qualified-table-name
|
#:db-options #:db-params #:qualified-table-name
|
||||||
#:do-sql #:query #:drop-table
|
#:do-sql #:query #:drop-table
|
||||||
#:schema))
|
#:schema))
|
||||||
|
@ -17,6 +18,9 @@
|
||||||
(defvar *backends*
|
(defvar *backends*
|
||||||
'(:dbi dbi-make-engine))
|
'(:dbi dbi-make-engine))
|
||||||
|
|
||||||
|
(defvar *db-engines*
|
||||||
|
'(:postgres db-engine-pg))
|
||||||
|
|
||||||
(defvar *db-params*
|
(defvar *db-params*
|
||||||
'(:sqlite3 (:id-type integer :json-type json)
|
'(:sqlite3 (:id-type integer :json-type json)
|
||||||
:postgres (:id-type bigserial :json-type jsonb)))
|
:postgres (:id-type bigserial :json-type jsonb)))
|
||||||
|
@ -30,6 +34,10 @@
|
||||||
(let ((backend (getf *db-config* :backend)))
|
(let ((backend (getf *db-config* :backend)))
|
||||||
(funcall (getf *backends* backend) *db-config*)))
|
(funcall (getf *backends* backend) *db-config*)))
|
||||||
|
|
||||||
|
(defgeneric timestamp-to-sql (engine ts))
|
||||||
|
|
||||||
|
(defmethod timestamp-to-sql ((engine db-engine) ts) ts)
|
||||||
|
|
||||||
(defclass storage ()
|
(defclass storage ()
|
||||||
((engine :reader engine :initarg :engine)
|
((engine :reader engine :initarg :engine)
|
||||||
(conn :reader conn)
|
(conn :reader conn)
|
||||||
|
@ -74,15 +82,22 @@
|
||||||
(dbi:row-count conn))))
|
(dbi:row-count conn))))
|
||||||
|
|
||||||
(defun drop-table (st tn)
|
(defun drop-table (st tn)
|
||||||
(do-sql st (sxql:drop-table tn :if-exists t)))
|
(let ((table (qualified-table-name st tn)))
|
||||||
|
(do-sql st (sxql:drop-table table :if-exists t))))
|
||||||
|
|
||||||
;;; backend-/driver-specific stuff
|
;;; backend-/driver-specific stuff
|
||||||
|
|
||||||
(defun dbi-make-engine (config)
|
(defun dbi-make-engine (config)
|
||||||
(let* ((db-type (getf config :db-type))
|
(let* ((db-type (getf config :db-type))
|
||||||
(params (getf *db-params* db-type))
|
(params (getf *db-params* db-type))
|
||||||
|
(engine (getf *db-engines* db-type 'db-engine))
|
||||||
(conn-args (getf config :connect-args)))
|
(conn-args (getf config :connect-args)))
|
||||||
(make-instance 'db-engine
|
(make-instance engine
|
||||||
:params params :config config
|
:params params :config config
|
||||||
:connect #'(lambda ()
|
:connect #'(lambda ()
|
||||||
(apply #'dbi:connect-cached db-type conn-args)))))
|
(apply #'dbi:connect-cached db-type conn-args)))))
|
||||||
|
|
||||||
|
(defclass db-engine-pg (db-engine) ())
|
||||||
|
|
||||||
|
(defmethod timestamp-to-sql ((engine db-engine-pg) ts)
|
||||||
|
(format nil "~a" (local-time:universal-to-timestamp ts)))
|
||||||
|
|
|
@ -20,6 +20,9 @@
|
||||||
(data :accessor data :initform nil)
|
(data :accessor data :initform nil)
|
||||||
(container :reader container :initarg :container)))
|
(container :reader container :initarg :container)))
|
||||||
|
|
||||||
|
(defun engine (tr)
|
||||||
|
(storage:engine (storage (container tr))))
|
||||||
|
|
||||||
(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)))
|
||||||
|
@ -43,7 +46,7 @@
|
||||||
(with-slots ((trid trackid) (ts time-stamp) data) track
|
(with-slots ((trid trackid) (ts time-stamp) data) track
|
||||||
(if trid (setf (getf vl :trackid) trid))
|
(if trid (setf (getf vl :trackid) trid))
|
||||||
(if ts (setf (getf vl :timestamp)
|
(if ts (setf (getf vl :timestamp)
|
||||||
(format nil "~a" (local-time:universal-to-timestamp ts))))
|
(storage:timestamp-to-sql (engine track) ts)))
|
||||||
(if data (setf (getf vl :data) data)))
|
(if data (setf (getf vl :data) data)))
|
||||||
vl))
|
vl))
|
||||||
|
|
||||||
|
|
|
@ -40,7 +40,7 @@
|
||||||
(defun test-track (st)
|
(defun test-track (st)
|
||||||
(let (cont tr)
|
(let (cont tr)
|
||||||
(setf cont (make-instance 'tracking:container :storage st))
|
(setf cont (make-instance 'tracking:container :storage st))
|
||||||
(storage:drop-table st :testing.tracks)
|
(storage:drop-table st :tracks)
|
||||||
(tracking:create-table cont)
|
(tracking:create-table cont)
|
||||||
(setf tr (tracking:make-item cont "t01" "john"))
|
(setf tr (tracking:make-item cont "t01" "john"))
|
||||||
(setf (tracking:time-stamp tr) (get-universal-time))
|
(setf (tracking:time-stamp tr) (get-universal-time))
|
||||||
|
|
Loading…
Add table
Reference in a new issue