database access almost working - sqlite hangs...
This commit is contained in:
parent
8dfb22033d
commit
3f2fea6617
5 changed files with 38 additions and 16 deletions
1
.gitignore
vendored
Normal file
1
.gitignore
vendored
Normal file
|
@ -0,0 +1 @@
|
||||||
|
test.db
|
|
@ -6,7 +6,7 @@
|
||||||
:version "0.0.1"
|
:version "0.0.1"
|
||||||
:homepage "https://www.cyberconcepts.org"
|
:homepage "https://www.cyberconcepts.org"
|
||||||
:description ""
|
:description ""
|
||||||
:depends-on (:str :sxql)
|
:depends-on (:dbi :str :sxql)
|
||||||
:components ((:file "forge/forge")
|
:components ((:file "forge/forge")
|
||||||
(:file "storage/storage")
|
(:file "storage/storage")
|
||||||
(:file "storage/tracking" :depends-on ("storage/storage"))
|
(:file "storage/tracking" :depends-on ("storage/storage"))
|
||||||
|
|
|
@ -6,6 +6,7 @@
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:export #:*db-config* #:*db-engine*
|
(:export #:*db-config* #:*db-engine*
|
||||||
#:make-engine #:make-storage #:db-params
|
#:make-engine #:make-storage #:db-params
|
||||||
|
#:db
|
||||||
#:drop-table))
|
#:drop-table))
|
||||||
|
|
||||||
(in-package :scopes/storage)
|
(in-package :scopes/storage)
|
||||||
|
@ -14,7 +15,8 @@
|
||||||
(defparameter *db-engine* nil)
|
(defparameter *db-engine* nil)
|
||||||
|
|
||||||
(defclass db-engine ()
|
(defclass db-engine ()
|
||||||
((params :initarg :params)
|
((connect :initarg :connect)
|
||||||
|
(params :initarg :params)
|
||||||
(config :initarg :config)))
|
(config :initarg :config)))
|
||||||
|
|
||||||
(defun make-engine ()
|
(defun make-engine ()
|
||||||
|
@ -22,25 +24,42 @@
|
||||||
|
|
||||||
(defclass storage ()
|
(defclass storage ()
|
||||||
((engine :initarg :engine)
|
((engine :initarg :engine)
|
||||||
(db)
|
(db :reader db)
|
||||||
(schema)))
|
(schema)))
|
||||||
|
|
||||||
(defun make-storage ()
|
(defun make-storage ()
|
||||||
(make-instance 'storage :engine *db-engine*))
|
(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)
|
(defun db-params (st)
|
||||||
(slot-value (slot-value st 'engine) 'params))
|
(slot-value (slot-value st 'engine) 'params))
|
||||||
|
|
||||||
(defun drop-table (st tn)
|
(defun drop-table (st tn)
|
||||||
st
|
(let ((sql (sxql:yield (sxql:drop-table tn :if-exists t))))
|
||||||
(print (sxql:yield
|
(print sql)
|
||||||
(sxql:drop-table tn :if-exists t))))
|
(dbi:do-sql (db st) sql)))
|
||||||
|
|
||||||
;; db-driver-specific stuff
|
;; db-driver-specific stuff
|
||||||
|
|
||||||
|
(defun connect-sqlite (params config)
|
||||||
|
(declare (ignorable params))
|
||||||
|
(print config)
|
||||||
|
(apply #'dbi:connect-cached (cons :sqlite3 config)))
|
||||||
|
|
||||||
|
(defun connect-postgres (params config)
|
||||||
|
(declare (ignorable params))
|
||||||
|
(apply #'dbi:connect (cons :postgres config)))
|
||||||
|
|
||||||
|
(defvar *db-params*
|
||||||
|
'(:sqlite3 (:connect connect-sqlite
|
||||||
|
:id-type integer :json-type json)
|
||||||
|
:postgres (:connect connect-postgres
|
||||||
|
:id-type bigserial :json-type jsonb)))
|
||||||
|
|
||||||
(defun make-engine-db (db-type config)
|
(defun make-engine-db (db-type config)
|
||||||
(let ((params
|
(let ((params (getf *db-params* db-type)))
|
||||||
(case db-type
|
(make-instance 'db-engine :params params :config config
|
||||||
(:sqlite3 '(:id-type integer :json-type json))
|
:connect #'(lambda ()
|
||||||
(:postgres '(:id-type bigserial :json-type jsonb)))))
|
(funcall (getf params :connect) params config)))))
|
||||||
(make-instance 'db-engine :params params :config config)))
|
|
||||||
|
|
|
@ -34,4 +34,5 @@
|
||||||
hf-def
|
hf-def
|
||||||
`((timestamp :type timestamp)
|
`((timestamp :type timestamp)
|
||||||
(data :type ,json-type)))))))
|
(data :type ,json-type)))))))
|
||||||
(print sql)))
|
(print sql)
|
||||||
|
(dbi:do-sql (storage:db st) sql)))
|
||||||
|
|
|
@ -3,13 +3,14 @@
|
||||||
|
|
||||||
(defparameter db-config-sqlite
|
(defparameter db-config-sqlite
|
||||||
'(:db-type :sqlite3
|
'(:db-type :sqlite3
|
||||||
:database-name "test/test.db"))
|
:database-name "test/test.db"
|
||||||
|
:busy-timeout 1))
|
||||||
|
|
||||||
(defparameter db-config-postgres
|
(defparameter db-config-postgres
|
||||||
'(:db-type :postgres
|
'(:db-type :postgres
|
||||||
:database-name "cl-test"
|
:database-name "cltest"
|
||||||
:host "localhost"
|
:host "localhost"
|
||||||
:port "5432"
|
:port 5432
|
||||||
:username "testuser"
|
:username "testuser"
|
||||||
:password "secret"
|
:password "secret"
|
||||||
:schema "testing"))
|
:schema "testing"))
|
||||||
|
|
Loading…
Add table
Reference in a new issue