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

@@ -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)

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")

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")

tests/run.scm

@@ -4,3 +4,5 @@
 (load-relative "ansi-test")
 ;; (load "mysql-test")
 (load-relative "pgsql-test")
+
+(test-exit)