diff --git a/ssql-postgresql.scm b/ssql-postgresql.scm index 5dcf3c5..920b196 100644 --- a/ssql-postgresql.scm +++ b/ssql-postgresql.scm @@ -3,7 +3,7 @@ (*postgresql-translator*) (import chicken scheme) -(use ssql postgresql foops) +(use ssql postgresql foops data-structures) (define *postgresql-translator* (let ((type->sql-converters @@ -12,7 +12,7 @@ (clauses-order (append (*ansi-translator* 'clauses-order) '(returning)))) - (derive-object (*ansi-translator*) + (derive-object (*ansi-translator* self) ((escape-string string) (escape-string (ssql-connection) string)) @@ -21,13 +21,23 @@ ((clauses-order) clauses-order) - ((type->sql-converters) type->sql-converters)))) + ((type->sql-converters) type->sql-converters) + + ((array (elements ...)) + (sprintf "ARRAY[~A]" + (string-intersperse + (map (lambda (el) + (self 'ssql->sql el)) + elements) + ", ")))))) (define-operators *postgresql-translator* (limit prefix) (offset prefix) (returning prefix "RETURNING" ", ") - (random function)) + (random function) + (@> infix) + (<@ infix)) (register-sql-engine! connection? *postgresql-translator*) diff --git a/tests/run.scm b/tests/run.scm index 85169ec..d2db4d4 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -27,10 +27,24 @@ (test "returning" "INSERT INTO widgets VALUES ('foo', 'bar') RETURNING id, name" - (ssql->sql #t '(insert (into widgets) (values ("foo" "bar")) (returning id name)))) + (ssql->sql #t '(insert (into widgets) (values #("foo" "bar")) (returning id name)))) (test "compose returning" - '(insert (into widgets) (values (1 2 3)) (returning id)) - (ssql-compose #t '(insert (into widgets) (values (1 2 3))) '((returning id))))) + '(insert (into widgets) (values #(1 2 3)) (returning id)) + (ssql-compose #t '(insert (into widgets) (values #(1 2 3))) '((returning id))))) + + +(test-group "arrays" + (test "literals" + "SELECT ARRAY[1, 2, 3]" + (ssql->sql #t '(select (array 1 2 3)))) + + (test "contains operator" + "SELECT (ARRAY['foo', 'bar'] @> ARRAY['bar'])" + (ssql->sql #t '(select (@> (array "foo" "bar") (array "bar"))))) + + (test "is contained operator" + "SELECT (ARRAY['bar'] <@ ARRAY['foo', 'bar'])" + (ssql->sql #t '(select (<@ (array "bar") (array "foo" "bar")))))) (test-exit) \ No newline at end of file