branch: elpa/emacsql
commit 8945af0dd8ba6b6dbe901bee356f1bbe207778fd
Author: Christopher Wellons <[email protected]>
Commit: Christopher Wellons <[email protected]>
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 "
