;;; cl-scopes/storage/storage.lisp ;;;; Common layer for SQL storage functionality. (defpackage :scopes/storage (:use :common-lisp) (:export #:*db-config* #:*db-engine* #:make-engine #:make-storage #:db-params #:db #:drop-table)) (in-package :scopes/storage) (defparameter *db-config* nil) (defparameter *db-engine* nil) (defvar *backends* '(:dbi dbi-make-engine)) (defvar *db-params* '(:sqlite3 (:id-type integer :json-type json) :postgres (:id-type bigserial :json-type jsonb))) (defclass db-engine () ((connect :initarg :connect) (params :initarg :params) (config :initarg :config))) (defun make-engine () (let* ((config *db-config*) (backend (getf config :backend)) (factory (getf *backends* backend))) (print backend) (print factory) (print (type-of factory)) (funcall factory config))) (defclass storage () ((engine :initarg :engine) (db :reader db) (schema))) (defun make-storage () (let ((st (make-instance 'storage :engine *db-engine*)) (db (funcall (slot-value *db-engine* 'connect)))) (setf (slot-value st 'db) db) st)) (defun db-params (st) (slot-value (slot-value st 'engine) 'params)) (defun drop-table (st tn) (let ((sql (sxql:yield (sxql:drop-table tn :if-exists t)))) (print sql) (dbi:do-sql (db st) sql))) ;;; backend-/driver-specific stuff (defun dbi-make-engine (config) (let* ((db-type (getf config :db-type)) (params (getf *db-params* db-type)) (conn-args (getf config :connect-args))) (make-instance 'db-engine :params params :config config :connect #'(lambda () (apply #'dbi:connect-cached db-type conn-args)))))