[nongnu] elpa/emacsql b2f2dd37cf 178/427: Allow connection to specify their own types.

[ELPA Syncer]

branch: elpa/emacsql
commit b2f2dd37cf5b1f58640312bab9c933af26efce9d
Author: Christopher Wellons <wellons@nullprogram.com>
Commit: Christopher Wellons <wellons@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 ", ")))))