branch: elpa/emacsql
commit e318a6c8f65371e2ab667d811205a0d9a98dacbb
Author: Jonas Bernoulli <jo...@bernoul.li>
Commit: Jonas Bernoulli <jo...@bernoul.li>
Add new SQLite back-ends
---
Makefile | 6 ++-
README.md | 5 ---
emacsql-sqlite-builtin.el | 92 +++++++++++++++++++++++++++++++++++++++
emacsql-sqlite-module.el | 95 +++++++++++++++++++++++++++++++++++++++++
emacsql-sqlite.el | 46 ++++----------------
emacsql.el | 56 +++++++++++++++++++++++-
tests/emacsql-external-tests.el | 20 ++++++---
7 files changed, 268 insertions(+), 52 deletions(-)
diff --git a/Makefile b/Makefile
index 9f72055289..48908b9197 100644
--- a/Makefile
+++ b/Makefile
@@ -2,9 +2,10 @@
# Clone the dependencies of this package in sibling directories:
# $ git clone https://github.com/emarsden/pg-el ../pg
+# $ git clone https://github.com/pekingduck/emacs-sqlite3-api.git
../sqlite3
#
# Or set LOAD_PATH to point at these packages elsewhere:
-# $ make LOAD_PATH='-L path/to/pg'
+# $ make LOAD_PATH='-L path/to/pg -L path/to/sqlite3'
PKG = emacsql
@@ -14,6 +15,8 @@ ELS += $(PKG)-mysql.el
ELS += $(PKG)-pg.el
ELS += $(PKG)-psql.el
ELS += $(PKG)-sqlite.el
+ELS += $(PKG)-sqlite-builtin.el
+ELS += $(PKG)-sqlite-module.el
ELCS = $(ELS:.el=.elc)
TEST_ELS = tests/emacsql-compiler-tests.el
@@ -22,6 +25,7 @@ TEST_ELS += tests/emacsql-tests.el
TEST_ELCS = $(TEST_ELS:.el=.elc)
DEPS = pg
+DEPS += sqlite3
EMACS ?= emacs
EMACS_ARGS ?=
diff --git a/README.md b/README.md
index 3aa203e40f..f9ecb973ea 100644
--- a/README.md
+++ b/README.md
@@ -3,11 +3,6 @@
EmacSQL is a high-level Emacs Lisp front-end for SQLite (primarily),
PostgreSQL, MySQL, and potentially other SQL databases.
-It works by maintaining a inferior process running (a "connection")
-for interacting with the back-end database. Connections are
-automatically cleaned up if they are garbage collected. All requests
-are synchronous.
-
Any [readable lisp value][readable] can be stored as a value in
EmacSQL, including numbers, strings, symbols, lists, vectors, and
closures. EmacSQL has no concept of "TEXT" values; it's all just lisp
diff --git a/emacsql-sqlite-builtin.el b/emacsql-sqlite-builtin.el
new file mode 100644
index 0000000000..e85ae7e8eb
--- /dev/null
+++ b/emacsql-sqlite-builtin.el
@@ -0,0 +1,92 @@
+;;; emacsql-sqlite-builtin.el --- EmacSQL back-end for SQLite using builtin
support -*- lexical-binding:t -*-
+
+;; This is free and unencumbered software released into the public domain.
+
+;; Author: Jonas Bernoulli <jo...@bernoul.li>
+;; Homepage: https://github.com/magit/emacsql
+
+;; Package-Version: 3.1.1-git
+;; Package-Requires: ((emacs "29") (emacsql "3.1.1"))
+;; SPDX-License-Identifier: Unlicense
+
+;;; Commentary:
+
+;; This package provides an EmacSQL back-end for SQLite, which uses
+;; the built-in SQLite support in Emacs 29 an later.
+
+;;; Code:
+
+(require 'sqlite)
+(require 'emacsql)
+
+(emacsql-register-reserved emacsql-sqlite-reserved)
+
+(defclass emacsql-sqlite-builtin-connection (emacsql-connection)
+ ((file :initarg :file
+ :type (or null string)
+ :documentation "Database file name.")
+ (types :allocation :class
+ :reader emacsql-types
+ :initform '((integer "INTEGER")
+ (float "REAL")
+ (object "TEXT")
+ (nil nil))))
+ (:documentation "A connection to a SQLite database using builtin support."))
+
+(cl-defmethod initialize-instance :after
+ ((connection emacsql-sqlite-builtin-connection) &rest _)
+ (setf (emacsql-process connection)
+ (sqlite-open (slot-value connection 'file)))
+ (when emacsql-global-timeout
+ (emacsql connection [:pragma (= busy-timeout $s1)]
+ (/ (* emacsql-global-timeout 1000) 2)))
+ (emacsql connection [:pragma (= foreign-keys on)])
+ (emacsql-register connection))
+
+(cl-defun emacsql-sqlite-builtin (file &key debug)
+ "Open a connected to database stored in FILE.
+If FILE is nil use an in-memory database.
+
+:debug LOG -- When non-nil, log all SQLite commands to a log
+buffer. This is for debugging purposes."
+ (let ((connection (make-instance #'emacsql-sqlite-builtin-connection
+ :file file)))
+ (when debug
+ (emacsql-enable-debugging connection))
+ connection))
+
+(cl-defmethod emacsql-live-p ((connection emacsql-sqlite-builtin-connection))
+ (and (emacsql-process connection) t))
+
+(cl-defmethod emacsql-close ((connection emacsql-sqlite-builtin-connection))
+ (sqlite-close (emacsql-process connection))
+ (setf (emacsql-process connection) nil))
+
+(cl-defmethod emacsql-send-message
+ ((connection emacsql-sqlite-builtin-connection) message)
+ (condition-case err
+ (mapcar (lambda (row)
+ (mapcar (lambda (col)
+ (cond ((null col) nil)
+ ((equal col "") "")
+ ((numberp col) col)
+ (t (read col))))
+ row))
+ (sqlite-select (emacsql-process connection) message nil nil))
+ ((sqlite-error sqlite-locked-error)
+ (if (stringp (cdr err))
+ (signal 'emacsql-error (list (cdr err)))
+ (pcase-let* ((`(,_ ,errstr ,errmsg ,errcode ,ext-errcode) err)
+ (`(,_ ,_ ,signal ,_)
+ (assq errcode emacsql-sqlite-error-codes)))
+ (signal (or signal 'emacsql-error)
+ (list errmsg errcode ext-errcode errstr)))))
+ (error
+ (signal 'emacsql-error (cdr err)))))
+
+(cl-defmethod emacsql ((connection emacsql-sqlite-builtin-connection) sql
&rest args)
+ (emacsql-send-message connection (apply #'emacsql-compile connection sql
args)))
+
+(provide 'emacsql-sqlite-builtin)
+
+;;; emacsql-sqlite-builtin.el ends here
diff --git a/emacsql-sqlite-module.el b/emacsql-sqlite-module.el
new file mode 100644
index 0000000000..9def74b636
--- /dev/null
+++ b/emacsql-sqlite-module.el
@@ -0,0 +1,95 @@
+;;; emacsql-sqlite-module.el --- EmacSQL back-end for SQLite using a module
-*- lexical-binding:t -*-
+
+;; This is free and unencumbered software released into the public domain.
+
+;; Author: Jonas Bernoulli <jo...@bernoul.li>
+;; Homepage: https://github.com/magit/emacsql
+
+;; Package-Version: 3.1.1-git
+;; Package-Requires: ((emacs "25") (emacsql "3.1.1") (sqlite3 "0.16"))
+;; SPDX-License-Identifier: Unlicense
+
+;;; Commentary:
+
+;; This package provides an EmacSQL back-end for SQLite, which uses
+;; the Emacs module provided by the `sqlite3' package.
+
+;;; Code:
+
+(require 'sqlite3)
+(require 'emacsql)
+
+(emacsql-register-reserved emacsql-sqlite-reserved)
+
+(defclass emacsql-sqlite-module-connection (emacsql-connection)
+ ((file :initarg :file
+ :type (or null string)
+ :documentation "Database file name.")
+ (types :allocation :class
+ :reader emacsql-types
+ :initform '((integer "INTEGER")
+ (float "REAL")
+ (object "TEXT")
+ (nil nil))))
+ (:documentation "A connection to a SQLite database using a module."))
+
+(cl-defmethod initialize-instance :after
+ ((connection emacsql-sqlite-module-connection) &rest _)
+ (setf (emacsql-process connection)
+ (sqlite3-open (or (slot-value connection 'file) ":memory:")
+ sqlite-open-readwrite
+ sqlite-open-create))
+ (when emacsql-global-timeout
+ (emacsql connection [:pragma (= busy-timeout $s1)]
+ (/ (* emacsql-global-timeout 1000) 2)))
+ (emacsql connection [:pragma (= foreign-keys on)])
+ (emacsql-register connection))
+
+(cl-defun emacsql-sqlite-module (file &key debug)
+ "Open a connected to database stored in FILE.
+If FILE is nil use an in-memory database.
+
+:debug LOG -- When non-nil, log all SQLite commands to a log
+buffer. This is for debugging purposes."
+ (let ((connection (make-instance #'emacsql-sqlite-module-connection
+ :file file)))
+ (when debug
+ (emacsql-enable-debugging connection))
+ connection))
+
+(cl-defmethod emacsql-live-p ((connection emacsql-sqlite-module-connection))
+ (and (emacsql-process connection) t))
+
+(cl-defmethod emacsql-close ((connection emacsql-sqlite-module-connection))
+ (sqlite3-close (emacsql-process connection))
+ (setf (emacsql-process connection) nil))
+
+(cl-defmethod emacsql-send-message
+ ((connection emacsql-sqlite-module-connection) message)
+ (condition-case err
+ (let (rows)
+ (sqlite3-exec (emacsql-process connection)
+ message
+ (lambda (_ row __)
+ (push (mapcar (lambda (col)
+ (cond ((null col) nil)
+ ((equal col "") "")
+ (t (read col))))
+ row)
+ rows)))
+ (nreverse rows))
+ ((db-error sql-error)
+ (pcase-let* ((`(,_ ,errmsg ,errcode) err)
+ (`(,_ ,_ ,signal ,errstr)
+ (assq errcode emacsql-sqlite-error-codes)))
+ (signal (or signal 'emacsql-error)
+ (list errmsg errcode nil errstr))))
+ (error
+ (signal 'emacsql-error (cdr err)))))
+
+(cl-defmethod emacsql ((connection emacsql-sqlite-module-connection) sql &rest
args)
+ (emacsql-send-message connection (apply #'emacsql-compile connection sql
args)))
+
+(provide 'emacsql-sqlite-module)
+
+;;; emacsql-sqlite-module.el ends here
diff --git a/emacsql-sqlite.el b/emacsql-sqlite.el
index 8b54c75c02..0894c6f8d1 100644
--- a/emacsql-sqlite.el
+++ b/emacsql-sqlite.el
@@ -24,6 +24,8 @@
(require 'eieio)
(require 'emacsql)
+(emacsql-register-reserved emacsql-sqlite-reserved)
+
;;; SQLite connection
(defvar emacsql-sqlite-data-root
@@ -48,25 +50,6 @@
user-emacs-directory)))
"Path to the EmacSQL backend (this is not the sqlite3 shell).")
-(defconst emacsql-sqlite-reserved
- (emacsql-register-reserved
- '( ABORT ACTION ADD AFTER ALL ALTER ANALYZE AND AS ASC ATTACH
- AUTOINCREMENT BEFORE BEGIN BETWEEN BY CASCADE CASE CAST CHECK
- COLLATE COLUMN COMMIT CONFLICT CONSTRAINT CREATE CROSS
- CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP DATABASE DEFAULT
- DEFERRABLE DEFERRED DELETE DESC DETACH DISTINCT DROP EACH ELSE END
- ESCAPE EXCEPT EXCLUSIVE EXISTS EXPLAIN FAIL FOR FOREIGN FROM FULL
- GLOB GROUP HAVING IF IGNORE IMMEDIATE IN INDEX INDEXED INITIALLY
- INNER INSERT INSTEAD INTERSECT INTO IS ISNULL JOIN KEY LEFT LIKE
- LIMIT MATCH NATURAL NO NOT NOTNULL NULL OF OFFSET ON OR ORDER
- OUTER PLAN PRAGMA PRIMARY QUERY RAISE RECURSIVE REFERENCES REGEXP
- REINDEX RELEASE RENAME REPLACE RESTRICT RIGHT ROLLBACK ROW
- SAVEPOINT SELECT SET TABLE TEMP TEMPORARY THEN TO TRANSACTION
- TRIGGER UNION UNIQUE UPDATE USING VACUUM VALUES VIEW VIRTUAL WHEN
- WHERE WITH WITHOUT))
- "List of all of SQLite's reserved words.
-Also see http://www.sqlite.org/lang_keywords.html.";)
-
(defvar emacsql-sqlite-c-compilers '("cc" "gcc" "clang")
"List of names to try when searching for a C compiler.
@@ -128,25 +111,12 @@ buffer. This is for debugging purposes."
(process-send-string process message)
(process-send-string process "\n")))
-(defconst emacsql-sqlite-condition-alist
- '(((1 4 9 12 17 18 20 21 22 25) emacsql-error)
- ((2) emacsql-internal)
- ((3 8 10 13 14 15 23) emacsql-access)
- ((5 6) emacsql-locked)
- ((7) emacsql-memory)
- ((11 16 24 26) emacsql-corruption)
- ((19) emacsql-constraint)
- ((27 28) emacsql-warning))
- "Alist mapping SQLite error codes to EmacSQL conditions.
-Each key is a list of error codes (integers).
-Also see https://www.sqlite.org/rescode.html.";)
-
-(cl-defmethod emacsql-handle ((_ emacsql-sqlite-connection) code message)
- "Get condition for MESSAGE provided from SQLite."
- (signal
- (or (cl-second (cl-assoc code emacsql-sqlite-condition-alist :test #'memql))
- 'emacsql-error)
- (list message code)))
+(cl-defmethod emacsql-handle ((_ emacsql-sqlite-connection) errcode errmsg)
+ "Get condition for ERRCODE and ERRMSG provided from SQLite."
+ (pcase-let ((`(,_ ,_ ,signal ,errstr)
+ (assq errcode emacsql-sqlite-error-codes)))
+ (signal (or signal 'emacsql-error)
+ (list errmsg errcode nil errstr))))
;;; SQLite compilation
diff --git a/emacsql.el b/emacsql.el
index 9790609524..1728f9f931 100644
--- a/emacsql.el
+++ b/emacsql.el
@@ -85,8 +85,7 @@ If nil, wait forever.")
;;; Database connection
(defclass emacsql-connection ()
- ((process :type process
- :initarg :process
+ ((process :initarg :process
:accessor emacsql-process)
(log-buffer :type (or null buffer)
:initarg :log-buffer
@@ -396,6 +395,59 @@ A prefix argument causes the SQL to be printed into the
current buffer."
(emacsql-show-sql sql)))
(user-error "Invalid SQL: %S" sexp))))
+;;; Common SQLite values
+
+(defconst emacsql-sqlite-reserved
+ '( ABORT ACTION ADD AFTER ALL ALTER ANALYZE AND AS ASC ATTACH
+ AUTOINCREMENT BEFORE BEGIN BETWEEN BY CASCADE CASE CAST CHECK
+ COLLATE COLUMN COMMIT CONFLICT CONSTRAINT CREATE CROSS
+ CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP DATABASE DEFAULT
+ DEFERRABLE DEFERRED DELETE DESC DETACH DISTINCT DROP EACH ELSE END
+ ESCAPE EXCEPT EXCLUSIVE EXISTS EXPLAIN FAIL FOR FOREIGN FROM FULL
+ GLOB GROUP HAVING IF IGNORE IMMEDIATE IN INDEX INDEXED INITIALLY
+ INNER INSERT INSTEAD INTERSECT INTO IS ISNULL JOIN KEY LEFT LIKE
+ LIMIT MATCH NATURAL NO NOT NOTNULL NULL OF OFFSET ON OR ORDER
+ OUTER PLAN PRAGMA PRIMARY QUERY RAISE RECURSIVE REFERENCES REGEXP
+ REINDEX RELEASE RENAME REPLACE RESTRICT RIGHT ROLLBACK ROW
+ SAVEPOINT SELECT SET TABLE TEMP TEMPORARY THEN TO TRANSACTION
+ TRIGGER UNION UNIQUE UPDATE USING VACUUM VALUES VIEW VIRTUAL WHEN
+ WHERE WITH WITHOUT)
+ "List of all of SQLite's reserved words.
+Also see http://www.sqlite.org/lang_keywords.html.";)
+
+(defconst emacsql-sqlite-error-codes
+ '((1 SQLITE_ERROR emacsql-error "SQL logic error")
+ (2 SQLITE_INTERNAL emacsql-internal nil)
+ (3 SQLITE_PERM emacsql-access "access permission denied")
+ (4 SQLITE_ABORT emacsql-error "query aborted")
+ (5 SQLITE_BUSY emacsql-locked "database is locked")
+ (6 SQLITE_LOCKED emacsql-locked "database table is locked")
+ (7 SQLITE_NOMEM emacsql-memory "out of memory")
+ (8 SQLITE_READONLY emacsql-access "attempt to write a readonly
database")
+ (9 SQLITE_INTERRUPT emacsql-error "interrupted")
+ (10 SQLITE_IOERR emacsql-access "disk I/O error")
+ (11 SQLITE_CORRUPT emacsql-corruption "database disk image is
malformed")
+ (12 SQLITE_NOTFOUND emacsql-error "unknown operation")
+ (13 SQLITE_FULL emacsql-access "database or disk is full")
+ (14 SQLITE_CANTOPEN emacsql-access "unable to open database file")
+ (15 SQLITE_PROTOCOL emacsql-access "locking protocol")
+ (16 SQLITE_EMPTY emacsql-corruption nil)
+ (17 SQLITE_SCHEMA emacsql-error "database schema has changed")
+ (18 SQLITE_TOOBIG emacsql-error "string or blob too big")
+ (19 SQLITE_CONSTRAINT emacsql-constraint "constraint failed")
+ (20 SQLITE_MISMATCH emacsql-error "datatype mismatch")
+ (21 SQLITE_MISUSE emacsql-error "bad parameter or other API
misuse")
+ (22 SQLITE_NOLFS emacsql-error "large file support is disabled")
+ (23 SQLITE_AUTH emacsql-access "authorization denied")
+ (24 SQLITE_FORMAT emacsql-corruption nil)
+ (25 SQLITE_RANGE emacsql-error "column index out of range")
+ (26 SQLITE_NOTADB emacsql-corruption "file is not a database")
+ (27 SQLITE_NOTICE emacsql-warning "notification message")
+ (28 SQLITE_WARNING emacsql-warning "warning message"))
+ "Alist mapping SQLite error codes to EmacSQL conditions.
+Elements have the form (ERRCODE SYMBOLIC-NAME EMACSQL-ERROR
+ERRSTR). Also see https://www.sqlite.org/rescode.html.";)
+
;;; Fix Emacs' broken vector indentation
(defun emacsql--inside-vector-p ()
diff --git a/tests/emacsql-external-tests.el b/tests/emacsql-external-tests.el
index 72a04a2254..25a1a9318c 100644
--- a/tests/emacsql-external-tests.el
+++ b/tests/emacsql-external-tests.el
@@ -7,9 +7,12 @@
(require 'cl-lib)
(require 'ert)
(require 'emacsql)
+
(require 'emacsql-sqlite)
-(require 'emacsql-psql)
+(when (require 'sqlite nil t) (require 'emacsql-sqlite-builtin))
+(when (require 'sqlite3 nil t) (require 'emacsql-sqlite-module))
(require 'emacsql-mysql)
+(require 'emacsql-psql)
(when (require 'pg nil t) (require 'emacsql-pg))
(defvar emacsql-tests-timeout 4
@@ -23,12 +26,16 @@
(cl-labels ((reg (name &rest args)
(push (cons name (apply #'apply-partially args)) factories)))
(reg "sqlite" #'emacsql-sqlite nil)
+ (when (featurep 'emacsql-sqlite-builtin)
+ (reg "sqlite-builtin" 'emacsql-sqlite-builtin nil))
+ (when (featurep 'emacsql-sqlite-module)
+ (reg "sqlite-module" 'emacsql-sqlite-module nil))
+ (when mysql-dbname
+ (reg "mysql" #'emacsql-mysql mysql-dbname))
(when pgdatabase
(reg "psql" #'emacsql-psql pgdatabase))
- (when (and pgdatabase pguser (fboundp 'emacsql-pg))
- (reg "pg" #'emacsql-pg pgdatabase pguser))
- (when mysql-dbname
- (reg "mysql" #'emacsql-mysql mysql-dbname)))
+ (when (and pgdatabase pguser)
+ (reg "pg" 'emacsql-pg pgdatabase pguser)))
(nreverse factories))
"List of connection factories to use in unit tests.")
@@ -99,7 +106,8 @@
(emacsql-with-connection (db (funcall (cdr factory)))
(emacsql db [:create-temporary-table test-table ([x])])
(emacsql db [:insert-into test-table :values ([" "] [\])])
- (should (process-live-p (emacsql-process db)))
+ (when (cl-typep db 'process)
+ (should (process-live-p (emacsql-process db))))
(should (equal (emacsql db [:select * :from test-table])
'((" ") (\))))))))
