From f0b456f2881b8143221cd3f9a62b15f007680712 Mon Sep 17 00:00:00 2001
From: Moritz Heidkamp <moritz-gitorious@twoticketsplease.de>
Date: Wed, 17 Aug 2011 20:16:34 +0200
Subject: [PATCH] basic insert support

---
 ssql.scm            | 33 ++++++++++++++++++++++++---------
 tests/ansi-test.scm |  8 ++++++++
 2 files changed, 32 insertions(+), 9 deletions(-)

diff --git a/ssql.scm b/ssql.scm
index a9af980..3d3b5c4 100644
--- a/ssql.scm
+++ b/ssql.scm
@@ -55,13 +55,17 @@
 
                ((pair->sql pair)
                 (self (car pair) (cdr pair)))
+               
+               ((values vals)
+                (sprintf "(~A)"
+                         (string-intersperse
+                          (map (lambda (s)
+                                 (self 'ssql->sql s #t))
+                               vals)
+                          ", ")))
 
                ((vector->sql vec)
-                (format "(~A)"
-                        (string-intersperse
-                         (map (lambda (s) (self 'ssql->sql s))
-                              (vector->list vec))
-                         ", ")))
+                (self 'values (vector->list vec)))
 
                ((string->sql string)
                 (string-append "'" (self 'escape-string string) "'"))
@@ -103,6 +107,14 @@
                                                         values)
                                                    ", ")))
 
+               ((insert (('into table) ('columns columns ...) values ...))
+                (sprintf "INSERT INTO ~A (~A) VALUES ~A" 
+                         table
+                         (string-intersperse (map symbol->string columns) ", ")
+                         (string-intersperse (map (lambda (val) 
+                                                    (self (car val) (cdr val)))
+                                                  values) ", ")))
+
                ((operator->sql type operator separator operands)
                 (case type
                   ((infix)
@@ -138,12 +150,17 @@
                       type)))
                   (else (error "unknown operator syntax type" type))))
 
-               ((ssql->sql ssql)
+               ((ssql->sql ssql parenthesize?)
                 (let ((handler (alist-ref (list ssql) (self 'type->sql-converters) apply)))
                   (if handler
-                      (self handler ssql)
+                      (if (and parenthesize? (pair? ssql))
+                          (sprintf "(~A)" (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))
@@ -181,8 +198,6 @@
   (distinct prefix)
   (all prefix)
 
-  (values function)
-
   (upper function)
   (lower function)
   (string-append infix "||")
diff --git a/tests/ansi-test.scm b/tests/ansi-test.scm
index a6ef650..4a755f4 100644
--- a/tests/ansi-test.scm
+++ b/tests/ansi-test.scm
@@ -36,6 +36,14 @@
     "UPDATE actors SET firstname = 'Felix' WHERE (lastname = 'Winkelmann')"
     (ssql->sql #f '(update actors (set (firstname "Felix")) (where (= lastname "Winkelmann"))))))
 
+(test-group "inserts"
+  (test "with sub-queries"
+    "INSERT INTO roles (character, movie_id, actor_id) VALUES ('Dr. Hasenbein', (SELECT id FROM movies WHERE (title = 'Praxis Dr. Hasenbein')), (SELECT id FROM actors WHERE ((firstname = 'Helge') AND (lastname = 'Schneider'))))"
+    (ssql->sql #f '(insert (into roles) (columns character movie_id actor_id)
+                           (values "Dr. Hasenbein"
+                                   (select (columns id) (from movies) (where (= title "Praxis Dr. Hasenbein")))
+                                   (select (columns id) (from actors) (where (and (= firstname "Helge")
+                                                                                  (= lastname "Schneider")))))))))
 
 (test-group "syntax"
   (test "set literals"