[nongnu] elpa/emacsql 8945af0dd8 129/427: Add :check and allow schemas to have variables.

[ELPA Syncer]

branch: elpa/emacsql
commit 8945af0dd8ba6b6dbe901bee356f1bbe207778fd
Author: Christopher Wellons <wellons@nullprogram.com>
Commit: Christopher Wellons <wellons@nullprogram.com>

    Add :check and allow schemas to have variables.
---
 README.md        |  3 +--
 emacsql-tests.el | 19 +++++++++-----
 emacsql.el       | 77 +++++++++++++++++++++++++++++++-------------------------
 3 files changed, 57 insertions(+), 42 deletions(-)

diff --git a/README.md b/README.md
index af7699f187..c3f7a0267b 100644
--- a/README.md
+++ b/README.md
@@ -59,8 +59,7 @@ Because Emacsql stores entire lisp objects as values, the only
 relevant types are `integer`, `float`, and `object` (default).
 
 Additional columns constraints include `:primary` (aka `PRIMARY KEY`),
-`:unique` (aka `UNIQUE`), `:non-nil` (aka `NOT NULL`), `:default` (aka
-`DEFAULT`).
+`:unique`, `:non-nil` (aka `NOT NULL`), `:default`, and `:check`.
 
 ```el
 ;; Example schema:
diff --git a/emacsql-tests.el b/emacsql-tests.el
index dac5793f89..fd514fe205 100644
--- a/emacsql-tests.el
+++ b/emacsql-tests.el
@@ -30,14 +30,15 @@
                    "(1, 2, 3), (4, 5, 6)")))
 
 (ert-deftest emacsql-schema ()
-  (should (string= (emacsql--schema-to-string [a]) "a"))
-  (should (string= (emacsql--schema-to-string [a b c]) "a, b, c"))
-  (should (string= (emacsql--schema-to-string [a (b)]) "a, b"))
-  (should (string= (emacsql--schema-to-string [a (b float)])
+  (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 (b float)]))
                    "a, b REAL"))
-  (should (string= (emacsql--schema-to-string [a (b :primary float :unique)])
+  (should (string= (car (emacsql--schema-to-string
+                         [a (b :primary float :unique)]))
                    "a, b REAL PRIMARY KEY UNIQUE"))
-  (should (string= (emacsql--schema-to-string [(a integer) (b float)])
+  (should (string= (car (emacsql--schema-to-string [(a integer) (b float)]))
                    "a INTEGER, b REAL")))
 
 (ert-deftest emacsql-var ()
@@ -80,6 +81,12 @@
      "CREATE TABLE foo (a DEFAULT 10);")
     ([:create-table foo [(a :primary :non-nil) b]] '()
      "CREATE TABLE foo (a PRIMARY KEY NOT NULL, b);")
+    ([:create-table foo [a (b :check (< b 10))]] '()
+     "CREATE TABLE foo (a, b CHECK (b < 10));")
+    ([:create-table foo $1] '([a b (c :primary)])
+     "CREATE TABLE foo (a, b, c PRIMARY KEY);")
+    ([:create-table foo [a b (c :default $1)]] '("FOO")
+     "CREATE TABLE foo (a, b, c DEFAULT '\"FOO\"');")
     ([:drop-table $1] '(foo)
      "DROP TABLE foo;")))
 
diff --git a/emacsql.el b/emacsql.el
index 8861f25ec7..0683b37fee 100644
--- a/emacsql.el
+++ b/emacsql.el
@@ -264,39 +264,6 @@ CONN-SPEC is a connection specification like the call to
                 (not (emacsql--complete-p conn)))
       (accept-process-output (emacsql-process conn) timeout))))
 
-(defun emacsql--column-to-string (column)
-  "Convert COLUMN schema into a SQL string."
-  (let ((name (emacsql-escape-identifier (pop column)))
-        (output ())
-        (type nil))
-    (while column
-      (let ((next (pop column)))
-        (cl-case next
-          (:primary (push "PRIMARY KEY" output))
-          (:non-nil (push "NOT NULL" output))
-          (:unique  (push "UNIQUE" output))
-          (:default (push "DEFAULT" output)
-                    (push (emacsql-escape-value (pop column)) output))
-          (integer  (setf type "INTEGER"))
-          (float    (setf type "REAL"))
-          (object   (setf type "TEXT"))
-          (otherwise
-           (if (keywordp next)
-               (error "Unknown schema contraint %s" next)
-             (error "Invalid type %s: %s" next
-                    "must be 'integer', 'float', or 'object'"))))))
-    (mapconcat #'identity
-               (nconc (if type (list name type) (list name)) (nreverse output))
-               " ")))
-
-(defun emacsql--schema-to-string (schema)
-  "Convert SCHEMA into a SQL-consumable string."
-  (cl-loop for column being the elements of schema
-           when (symbolp column)
-           collect (emacsql-escape-identifier column) into parts
-           else collect (emacsql--column-to-string column) into parts
-           finally (cl-return (mapconcat #'identity parts ", "))))
-
 (defun emacsql-escape-value (value)
   "Escape VALUE for sending to SQLite."
   (let ((print-escape-newlines t))
@@ -365,6 +332,7 @@ a list of (<string> [arg-pos] ...)."
                         (:identifier (emacsql-escape-identifier thing))
                         (:value (emacsql-escape-value thing))
                         (:vector (emacsql-escape-vector thing))
+                        (:schema (car (emacsql--schema-to-string thing)))
                         (:auto (if (symbolp thing)
                                    (emacsql-escape-identifier thing)
                                  (emacsql-escape-value thing)))))))))
@@ -430,6 +398,45 @@ definitions for return from a `emacsql-defexpander'."
                 (idents (thing) (combine (emacsql--idents thing))))
        (cons (concat ,prefix (progn ,@body)) emacsql--vars))))
 
+(defun emacsql--column-to-string (column)
+  "Convert COLUMN schema into a SQL string."
+  (emacsql-with-vars ""
+    (let ((name (var (pop column) :identifier))
+          (output ())
+          (type nil))
+      (while column
+        (let ((next (pop column)))
+          (cl-case next
+            (:primary (push "PRIMARY KEY" output))
+            (:non-nil (push "NOT NULL" output))
+            (:unique  (push "UNIQUE" output))
+            (:default (push "DEFAULT" output)
+                      (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"))
+            (otherwise
+             (if (keywordp next)
+                 (error "Unknown schema contraint %s" next)
+               (error "Invalid type %s: %s" next
+                      "must be 'integer', 'float', or 'object'"))))))
+      (setf output (nreverse output))
+      (when type (push type output))
+      (push name output)
+      (mapconcat #'identity output " "))))
+
+(defun emacsql--schema-to-string (schema)
+  "Convert SCHEMA into a SQL-consumable string."
+  (emacsql-with-vars ""
+    (cl-loop for column across schema
+             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 ", ")))))
+
 (defun emacsql--vector (vector)
   "Expand VECTOR, making variables as needed."
   (emacsql-with-vars ""
@@ -570,7 +577,9 @@ definitions for return from a `emacsql-defexpander'."
       (let* ((items (list temporary "TABLE" if-not-exists name))
              (spec (cl-remove-if-not #'identity items)))
         (format "%s (%s)" (mapconcat #'identity spec " ")
-                (emacsql--schema-to-string schema))))))
+                (if (symbolp schema)
+                    (var schema :schema)
+                  (combine (emacsql--schema-to-string schema))))))))
 
 (emacsql-defexpander :drop-table (table)
   (emacsql-with-vars "DROP TABLE "