branch: elpa/emacsql
commit b2f2dd37cf5b1f58640312bab9c933af26efce9d
Author: Christopher Wellons <well...@nullprogram.com>
Commit: Christopher Wellons <well...@nullprogram.com>
Allow connection to specify their own types.
---
emacsql-psql.el | 10 ++++++++--
emacsql-sqlite.el | 10 ++++++++--
emacsql-tests.el | 43 +++++++++++++++++++++++--------------------
emacsql.el | 41 +++++++++++++++++++++++++++++------------
4 files changed, 68 insertions(+), 36 deletions(-)
diff --git a/emacsql-psql.el b/emacsql-psql.el
index 1f23407018..0f07075ad4 100644
--- a/emacsql-psql.el
+++ b/emacsql-psql.el
@@ -28,7 +28,13 @@
(error :cannot-execute)))))
(defclass emacsql-psql-connection (emacsql-connection emacsql-simple-parser)
- ((dbname :reader emacsql-psql-dbname :initarg :dbname))
+ ((dbname :reader emacsql-psql-dbname :initarg :dbname)
+ (types :allocation :class
+ :reader emacsql-types
+ :initform '((integer "BIGINT")
+ (float "DOUBLE PRECISION")
+ (object "TEXT")
+ (nil "TEXT"))))
(:documentation "A connection to a PostgreSQL database."))
;;;###autoload
@@ -74,7 +80,7 @@
(process-send-string process "\\q\n"))))
(defmethod emacsql ((connection emacsql-psql-connection) sql &rest args)
- (let ((sql-string (apply #'emacsql-compile sql args)))
+ (let ((sql-string (apply #'emacsql-compile connection sql args)))
(emacsql-clear connection)
(emacsql-send-string connection sql-string)
(emacsql-wait connection)
diff --git a/emacsql-sqlite.el b/emacsql-sqlite.el
index 5b5905910b..36eeba6647 100644
--- a/emacsql-sqlite.el
+++ b/emacsql-sqlite.el
@@ -30,7 +30,13 @@
(defclass emacsql-sqlite-connection (emacsql-connection emacsql-simple-parser)
((file :initarg :file
:type (or null string)
- :documentation "Database file name."))
+ :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."))
;;;###autoload
@@ -123,7 +129,7 @@ buffer. This is for debugging purposes."
'emacsql-error))
(defmethod emacsql ((connection emacsql-sqlite-connection) sql &rest args)
- (let ((sql-string (apply #'emacsql-compile sql args)))
+ (let ((sql-string (apply #'emacsql-compile connection sql args)))
(emacsql-clear connection)
(emacsql-send-string connection sql-string)
(emacsql-wait connection)
diff --git a/emacsql-tests.el b/emacsql-tests.el
index 32168b1eaa..0c0ed5191e 100644
--- a/emacsql-tests.el
+++ b/emacsql-tests.el
@@ -31,14 +31,17 @@
"(1, 2, 3), (4, 5, 6)")))
(ert-deftest emacsql-schema ()
- (should (string= (car (emacsql--schema-to-string [a])) "a"))
- (should (string= (car (emacsql--schema-to-string [a b c])) "a, b, c"))
- (should (string= (car (emacsql--schema-to-string [a (b)])) "a, b"))
+ (should (string= (car (emacsql--schema-to-string [a]))
+ "a NONE"))
+ (should (string= (car (emacsql--schema-to-string [a b c]))
+ "a NONE, b NONE, c NONE"))
+ (should (string= (car (emacsql--schema-to-string [a (b)]))
+ "a NONE, b NONE"))
(should (string= (car (emacsql--schema-to-string [a (b float)]))
- "a, b REAL"))
+ "a NONE, b REAL"))
(should (string= (car (emacsql--schema-to-string
- [a (b :primary float :unique)]))
- "a, b REAL PRIMARY KEY UNIQUE"))
+ [a (b float :primary :unique)]))
+ "a NONE, b REAL PRIMARY KEY UNIQUE"))
(should (string= (car (emacsql--schema-to-string [(a integer) (b float)]))
"a INTEGER, b REAL")))
@@ -84,32 +87,32 @@
(ert-deftest emacsql-create-table ()
(emacsql-tests-with-queries
([:create-table foo [a b c]] ()
- "CREATE TABLE foo (a, b, c);")
+ "CREATE TABLE foo (a NONE, b NONE, c NONE);")
([:create-table (:temporary :if-not-exists x) [y]] '()
- "CREATE TEMPORARY TABLE IF NOT EXISTS x (y);")
+ "CREATE TEMPORARY TABLE IF NOT EXISTS x (y NONE);")
([:create-table foo [(a :default 10)]] '()
- "CREATE TABLE foo (a DEFAULT 10);")
+ "CREATE TABLE foo (a NONE DEFAULT 10);")
([:create-table foo [(a :primary :non-nil) b]] '()
- "CREATE TABLE foo (a PRIMARY KEY NOT NULL, b);")
+ "CREATE TABLE foo (a NONE PRIMARY KEY NOT NULL, b NONE);")
([:create-table foo [a (b :check (< b 10))]] '()
- "CREATE TABLE foo (a, b CHECK (b < 10));")
+ "CREATE TABLE foo (a NONE, b NONE CHECK (b < 10));")
([:create-table foo $1] '([a b (c :primary)])
- "CREATE TABLE foo (a, b, c PRIMARY KEY);")
+ "CREATE TABLE foo (a NONE, b NONE, c NONE PRIMARY KEY);")
([:create-table foo [a b (c :default $1)]] '("FOO")
- "CREATE TABLE foo (a, b, c DEFAULT '\"FOO\"');")
+ "CREATE TABLE foo (a NONE, b NONE, c NONE DEFAULT '\"FOO\"');")
;; From select
([:create-table $1 [:select name :from $2]] '(names people)
"CREATE TABLE names AS (SELECT name FROM people);")
;; Table constraints
([:create-table foo ([a b c] :primary [a c])] '()
- "CREATE TABLE foo (a, b, c, PRIMARY KEY (a, c));")
+ "CREATE TABLE foo (a NONE, b NONE, c NONE, PRIMARY KEY (a, c));")
([:create-table foo ([a b c] :unique [a b c])] '()
- "CREATE TABLE foo (a, b, c, UNIQUE (a, b, c));")
+ "CREATE TABLE foo (a NONE, b NONE, c NONE, UNIQUE (a, b, c));")
([:create-table foo ([a b] :check (< a b)) ] '()
- "CREATE TABLE foo (a, b, CHECK (a < b));")
+ "CREATE TABLE foo (a NONE, b NONE, CHECK (a < b));")
([:create-table foo
([a b c] :foreign ([a b] bar [aa bb] :on-delete :cascade))] '()
- (concat "CREATE TABLE foo (a, b, c, FOREIGN KEY (a, b) "
+ (concat "CREATE TABLE foo (a NONE, b NONE, c NONE, FOREIGN KEY (a, b) "
"REFERENCES bar (aa, bb) ON DELETE CASCADE);"))
;; Drop table
([:drop-table $1] '(foo)
@@ -219,11 +222,11 @@
(ert-deftest emacsql-error ()
"Check that we're getting expected conditions."
- (should-error (emacsql-compile [:begin :foo])
+ (should-error (emacsql-compile nil [:begin :foo])
:type 'emacsql-syntax)
- (should-error (emacsql-compile [:create-table $foo$ [a]])
+ (should-error (emacsql-compile nil [:create-table $foo$ [a]])
:type 'emacsql-syntax)
- (should-error (emacsql-compile [:insert :into foo :values 1])
+ (should-error (emacsql-compile nil [:insert :into foo :values 1])
:type 'emacsql-syntax)
(emacsql-with-connection (db (emacsql-sqlite nil))
(emacsql db [:create-table foo [x]])
diff --git a/emacsql.el b/emacsql.el
index a81cd8eea5..85ddf5dc12 100644
--- a/emacsql.el
+++ b/emacsql.el
@@ -63,11 +63,14 @@
(defclass emacsql-connection ()
((process :type process
:initarg :process
- :accessor emacsql-process)
+ :reader emacsql-process)
(log-buffer :type (or null buffer)
:initarg :log-buffer
:accessor emacsql-log-buffer
- :documentation "Output log (debug)."))
+ :documentation "Output log (debug).")
+ (types :initform nil
+ :reader emacsql-types
+ :documentation "Maps Emacsql types to SQL types."))
(:documentation "A connection to a SQL database.")
:abstract t)
@@ -77,6 +80,13 @@
(defgeneric emacsql-close (connection)
"Close CONNECTION and free all resources.")
+(defgeneric emacsql-types (connection)
+ "Return an alist mapping Emacsql types to database types.
+This will mask `emacsql-type-map' during expression compilation.
+This alist should have four key symbols: integer, float, object,
+nil (default type). The values are strings to be inserted into a
+SQL expression.")
+
(defmethod emacsql-buffer ((connection emacsql-connection))
"Get proccess buffer for CONNECTION."
(process-buffer (emacsql-process connection)))
@@ -297,6 +307,13 @@ A statement can be a list, containing a statement with its
arguments."
(defvar emacsql-expander-cache (make-hash-table :test 'equal)
"Cache used to memoize `emacsql-expand'.")
+(defvar emacsql-type-map
+ '((integer "INTEGER")
+ (float "REAL")
+ (object "TEXT")
+ (nil "NONE"))
+ "An alist mapping Emacsql types to SQL types.")
+
(defun emacsql-add-expander (keyword arity function)
"Register FUNCTION for KEYWORD as a SQL expander.
FUNCTION should accept the keyword's arguments and should return
@@ -363,9 +380,11 @@ a list of (<string> [arg-pos] ...)."
(otherwise
(emacsql-error "Invalid var type %S" kind))))))))
-(defun emacsql-compile (sql &rest args)
- "Compile s-expression SQL expression into a string."
- (apply #'emacsql-format (emacsql-expand sql) args))
+(defun emacsql-compile (connection sql &rest args)
+ "Compile s-expression SQL for CONNECTION into a string."
+ (let* ((mask (when connection (emacsql-types connection)))
+ (emacsql-type-map (or mask emacsql-type-map)))
+ (apply #'emacsql-format (emacsql-expand sql) args)))
(defun emacsql-var (var)
"Return the index number of VAR, or nil if VAR is not a variable.
@@ -426,9 +445,11 @@ definitions for return from a `emacsql-defexpander'."
(defun emacsql--column-to-string (column)
"Convert COLUMN schema into a SQL string."
(emacsql-with-vars ""
+ (when (symbolp column)
+ (setf column (list column)))
(let ((name (var (pop column) :identifier))
(output ())
- (type nil))
+ (type (cadr (assoc nil emacsql-type-map))))
(while column
(let ((next (pop column)))
(cl-case next
@@ -440,9 +461,8 @@ definitions for return from a `emacsql-defexpander'."
(push (var (pop column) :value) output))
(:check (push "CHECK" output)
(push (format "(%s)" (expr (pop column))) output))
- (integer (setf type "INTEGER"))
- (float (setf type "REAL"))
- (object (setf type "TEXT"))
+ ((integer float object)
+ (setf type (cadr (assoc next emacsql-type-map))))
(otherwise
(if (keywordp next)
(emacsql-error "Unknown schema contraint %s" next)
@@ -457,9 +477,6 @@ definitions for return from a `emacsql-defexpander'."
"Convert COLUMNS into a SQL-consumable string."
(emacsql-with-vars ""
(cl-loop for column across columns
- when (symbolp column)
- collect (var column :identifier) into parts
- else
collect (combine (emacsql--column-to-string column)) into parts
finally (cl-return (mapconcat #'identity parts ", ")))))
