From cc9ea436a575225a9ec3a28dceeba32325ef2366 Mon Sep 17 00:00:00 2001
From: Moritz Heidkamp <moritz-gitorious@twoticketsplease.de>
Date: Tue, 23 Aug 2011 17:00:24 +0200
Subject: [PATCH] improve sub-query parenthesization and add more tests

---
 ssql.scm            | 86 ++++++++++++++++++++++++++-------------------
 tests/ansi-test.scm | 13 ++++---
 2 files changed, 57 insertions(+), 42 deletions(-)

diff --git a/ssql.scm b/ssql.scm
index 447d39e..10b594d 100644
--- a/ssql.scm
+++ b/ssql.scm
@@ -16,6 +16,8 @@
         (and (not (eq? y (car lst)))
              (loop (cdr lst))))))
 
+(define sub-query? (make-parameter #f))
+
 (define-syntax define-operators
   (ir-macro-transformer
    (lambda (x i c)
@@ -26,7 +28,7 @@
                                       (let ((ssql-op (first op))
                                             (type (second op)))
 
-                                        (unless (memq (i type) '(infix infix* suffix prefix function))
+                                        (unless (memq (i type) '(infix infix* suffix prefix suffix* prefix* function))
                                           (error "unknown operator syntax type" type))
 
                                         (let-optionals (cddr op)
@@ -60,7 +62,7 @@
                 (sprintf "(~A)"
                          (string-intersperse
                           (map (lambda (s)
-                                 (self 'ssql->sql s #t))
+                                 (self 'ssql->sql s))
                                list)
                           ", ")))
                
@@ -120,12 +122,13 @@
                 (symbol->string table))
 
                ((insert into rest)
-                (sprintf "INSERT INTO ~A ~A"
-                         into
-                         (string-intersperse 
-                          (map (lambda (s) 
-                                 (self 'ssql->sql s))
-                               rest))))
+                (parameterize ((sub-query? #t))
+                  (sprintf "INSERT INTO ~A ~A"
+                           into
+                           (string-intersperse 
+                            (map (lambda (s) 
+                                   (self 'ssql->sql s))
+                                 rest)))))
 
                ((insert (('into table) ('columns columns ...) rest ...))
                 (self 'insert
@@ -159,39 +162,48 @@
                     (string-append " " operator " ")))
 
                   ((function)
-                   (sprintf "~A(~A)"
-                            operator
-                            (string-intersperse
-                             (map (lambda (operand) 
-                                    (self 'ssql->sql operand))
-                                  operands)
-                             (or separator ", "))))
+                   (parameterize ((sub-query? #t))
+                     (sprintf "~A(~A)"
+                              operator
+                              (string-intersperse
+                               (map (lambda (operand) 
+                                      (self 'ssql->sql operand))
+                                    operands)
+                               (or separator ", ")))))
+                  
                   ((suffix prefix)
-                   (let ((operator (if (eq? type 'prefix)
-                                       (string-append operator " ")
-                                       (string-append " " operator))))
-                     (string-join
-                      (list
-                       (string-intersperse
-                        (map (lambda (operand)
-                               (self 'ssql->sql operand))
-                             operands)
-                        (or separator " ")))
-                      operator
-                      type)))
+                   (let* ((operator (if (eq? type 'prefix)
+                                        (string-append operator " ")
+                                        (string-append " " operator))))
+                     (parameterize ((sub-query? #t))
+                       (string-join
+                        (list
+                         (string-intersperse
+                          (map (lambda (operand)
+                                 (self 'ssql->sql operand))
+                               operands)
+                          (or separator " ")))
+                        operator
+                        type))))
+
+                  ((suffix* prefix*)
+                   (let ((sql (self 'operator->sql 
+                                    (if (eq? 'suffix* type) 'suffix 'prefix)
+                                    operator
+                                    separator
+                                    operands)))
+                     (if (sub-query?)
+                         (sprintf "(~A)" sql)
+                         sql)))
+
                   (else (error "unknown operator syntax type" type))))
 
-               ((ssql->sql ssql parenthesize?)
+               ((ssql->sql ssql)
                 (let ((handler (alist-ref (list ssql) (self 'type->sql-converters) apply)))
                   (if handler
-                      (if (and parenthesize? (pair? ssql))
-                          (sprintf "(~A)" (self handler ssql))
-                          (self handler ssql))
+                      (self handler ssql)
                       (error "unknown datatype" ssql))))
 
-               ((ssql->sql ssql)
-                (self 'ssql->sql ssql #f))
-
                ((insert-clause clause ssql)
                 (let ((order (self 'clauses-order)))
                   (let loop ((ssql ssql))
@@ -204,9 +216,9 @@
                 (append target-clause (cdr clause)))))
 
 (define-operators *ansi-translator*
-  (select prefix)
-  (update prefix)
-  (delete prefix)
+  (select prefix*)
+  (update prefix*)
+  (delete prefix*)
   (from prefix "FROM" ", ")
   (where prefix)
   (order prefix "ORDER BY" ", ")
diff --git a/tests/ansi-test.scm b/tests/ansi-test.scm
index 9da8550..6584d05 100644
--- a/tests/ansi-test.scm
+++ b/tests/ansi-test.scm
@@ -33,8 +33,11 @@
     (ssql->sql #f '(update (table actors) (set (firstname "Rube") (lastname "Goldberg")))))
 
   (test "with condition"
-    "UPDATE actors SET firstname = 'Felix' WHERE (lastname = 'Winkelmann')"
-    (ssql->sql #f '(update (table actors) (set (firstname "Felix")) (where (= lastname "Winkelmann"))))))
+    "UPDATE actors SET firstname = 'Felix', experience = (SELECT COUNT(*) FROM roles WHERE (actor_id = actors.id)) WHERE (lastname = 'Winkelmann')"
+    (ssql->sql #f '(update (table actors) 
+                           (set (firstname "Felix")
+                                (experience (select (count *) (from roles) (where (= actor_id actors.id)))))
+                           (where (= lastname "Winkelmann"))))))
 
 (test-group "inserts"
   (test "with sub-queries"
@@ -63,9 +66,9 @@
 
 (test-group "syntax"
   (test "set literals"
-    "SELECT one, two FROM (1, 2)"
-    (ssql->sql #f '(select (columns one two) (from #(1 2)))))
+    "SELECT one, two FROM (1, 2, (SELECT MAX(amount) FROM widgets))"
+    (ssql->sql #f '(select (columns one two) (from #(1 2 (select (max amount) (from widgets)))))))
 
   (test "function calls"
-    "SELECT foo(99, (bar('baz')))"
+    "SELECT foo(99, bar('baz'))"
     (ssql->sql #f '(select (call foo 99 (call bar "baz"))))))
\ No newline at end of file