[nongnu] elpa/emacsql e318a6c8f6 426/427: Add new SQLite back-ends

[ELPA Syncer]

branch: elpa/emacsql
commit e318a6c8f65371e2ab667d811205a0d9a98dacbb
Author: Jonas Bernoulli <jonas@bernoul.li>
Commit: Jonas Bernoulli <jonas@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 <jonas@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 <jonas@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])
                        '(("") (\))))))))