From 9ae0559ec28875cd0a8f12b63bc3b193f05e9a81 Mon Sep 17 00:00:00 2001
From: syn <syn@fca3e652-9b03-0410-8d7b-ac86a6ce46c4>
Date: Sun, 27 Feb 2011 20:31:54 +0000
Subject: [PATCH] ssql: don't wrap prefix and suffix operators in parentheses;
 fix FROM clause with multiple tables to separate table names with commas; add
 `order' operator.

git-svn-id: https://code.call-cc.org/svn/chicken-eggs/release/4/ssql/trunk@22909 fca3e652-9b03-0410-8d7b-ac86a6ce46c4
---
 ssql.scm             | 30 ++++++++++++++++--------------
 tests/ansi-test.scm  | 16 +++++++++++-----
 tests/pgsql-test.scm |  2 +-
 tests/run.scm        |  4 +++-
 4 files changed, 31 insertions(+), 21 deletions(-)

diff --git a/ssql.scm b/ssql.scm
index 0a7e8b4..685ebb7 100644
--- a/ssql.scm
+++ b/ssql.scm
@@ -19,9 +19,10 @@
                                       (let ((ssql-op (first op))
                                             (type (second op)))
                                         (let-optionals (cddr op)
-                                            ((sql-op (string-upcase (->string (strip-syntax ssql-op)))))
+                                            ((sql-op (string-upcase (->string (strip-syntax ssql-op))))
+                                             (separator #f))
                                           `((,(strip-syntax ssql-op) operands)
-                                            (self 'operator->sql ',type ,sql-op operands)))))
+                                            (self 'operator->sql ',type ,sql-op ,separator operands)))))
                                     (cddr x))))))))
 
 (define *ansi-translator*
@@ -69,7 +70,7 @@
                                                   (string-upcase (symbol->string type))
                                                   (string-join (map (lambda (x) (self 'ssql->sql x)) rest))))))
 
-               ((operator->sql type operator operands)
+               ((operator->sql type operator separator operands)
                 (case type
                   ((infix)
                    (sprintf "(~A)" (string-intersperse
@@ -84,20 +85,20 @@
                              (map (lambda (operand) 
                                     (self 'ssql->sql operand))
                                   operands)
-                             ", ")))
+                             (or separator ", "))))
                   ((suffix prefix)
                    (let ((operator (if (eq? type 'prefix)
                                        (string-append operator " ")
                                        (string-append " " operator))))
-                     (sprintf "(~A)"
-                              (string-join
-                               (list
-                                (string-intersperse
-                                 (map (lambda (operand)
-                                        (self 'ssql->sql operand))
-                                      operands)))
-                               operator
-                               type))))
+                     (string-join
+                      (list
+                       (string-intersperse
+                        (map (lambda (operand)
+                               (self 'ssql->sql operand))
+                             operands)
+                        (or separator " ")))
+                      operator
+                      type)))
                   (else (error "unknown operator syntax type" type))))
 
                ((ssql->sql ssql)
@@ -108,8 +109,9 @@
 
 (define-operators *ansi-translator*
   (select prefix)
-  (from prefix)
+  (from prefix "FROM" ", ")
   (where prefix)
+  (order prefix "ORDER BY" ", ")
   (having prefix)
   (union infix)
   (as infix)
diff --git a/tests/ansi-test.scm b/tests/ansi-test.scm
index 3787877..4c6dad3 100644
--- a/tests/ansi-test.scm
+++ b/tests/ansi-test.scm
@@ -3,22 +3,28 @@
 
 (test-begin "selects")
 (test "Simple query"
-  "(SELECT actors.firstname, actors.lastname (FROM actors))"
+  "SELECT actors.firstname, actors.lastname FROM actors"
   (ssql->sql #f `(select (columns actors.firstname actors.lastname)
                    (from actors))))
 (test "Many columns"
-  "(SELECT actors.id, actors.firstname, actors.lastname, roles.character, roles.movie_id (FROM actors roles))"
+  "SELECT actors.id, actors.firstname, actors.lastname, roles.character, roles.movie_id FROM actors, roles"
   (ssql->sql #f `(select (columns (col actors id firstname lastname) (col roles character movie_id))
                    (from actors roles))))
 (test "Joined query"
   (string-append
-   "(SELECT actors.firstname, actors.lastname, roles.character, movies.title "
-   "(FROM ((actors LEFT JOIN roles (ON (roles.actor_id = actors.id))) "
-   "LEFT JOIN movies (ON (movies.id = roles.movie_id)))))")
+   "SELECT actors.firstname, actors.lastname, roles.character, movies.title "
+
+   "FROM ((actors LEFT JOIN roles ON (roles.actor_id = actors.id)) "
+   "LEFT JOIN movies ON (movies.id = roles.movie_id))")
   (ssql->sql #f `(select (columns actors.firstname actors.lastname roles.character movies.title)
                    (from (join left
                                (join left actors roles
                                      (on (= roles.actor_id actors.id)))
                                movies
                                (on (= movies.id roles.movie_id)))))))
+
+(test "Order"
+  "SELECT lastname, firstname FROM people ORDER BY lastname DESC, firstname"
+  (ssql->sql #f '(select (columns lastname firstname) (from people) (order (desc lastname) firstname))))
+
 (test-end "selects")
\ No newline at end of file
diff --git a/tests/pgsql-test.scm b/tests/pgsql-test.scm
index ed64498..75e0824 100644
--- a/tests/pgsql-test.scm
+++ b/tests/pgsql-test.scm
@@ -12,7 +12,7 @@
 
 (test-begin "selects")
 (test "Simple query"
-  "(SELECT actors.firstname, actors.lastname (FROM actors))"
+  "SELECT actors.firstname, actors.lastname FROM actors"
   (ssql->sql #t `(select (columns actors.firstname actors.lastname)
                    (from actors))))
 (test-end "selects")
\ No newline at end of file
diff --git a/tests/run.scm b/tests/run.scm
index 699c8af..348f3e8 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -3,4 +3,6 @@
 (load-relative "transformations-test")
 (load-relative "ansi-test")
 ;; (load "mysql-test")
-(load-relative "pgsql-test")
\ No newline at end of file
+(load-relative "pgsql-test")
+
+(test-exit)
\ No newline at end of file