add update, delete to fql

diff --git a/extra/db2/fql/fql-tests.factor b/extra/db2/fql/fql-tests.factor
index cb1bee24ca25f3ede650956b9034f06e12345f11..ca7b46b283fd83afa54a8f2634daf5390fedbbfb 100644 (file)
--- a/extra/db2/fql/fql-tests.factor
+++ b/extra/db2/fql/fql-tests.factor
@@ -33,6 +33,26 @@ IN: db2.fql.tests
         expand-fql sql>>
     ] unit-test
 
+    [ "delete from computer order by omg limit 3" ]
+    [
+        delete new
+            "computer" >>tables
+            "omg" >>order-by
+            3 >>limit
+        expand-fql sql>>
+    ] unit-test
+
+    [ "update computer set name = oscar order by omg limit 3" ]
+    [
+        update new
+            "computer" >>tables
+            "name" >>keys
+            "oscar" >>values
+            "omg" >>order-by
+            3 >>limit
+        expand-fql sql>>
+    ] unit-test
+
     ;
 
 [ test-fql ] test-dbs

diff --git a/extra/db2/fql/fql.factor b/extra/db2/fql/fql.factor
index 222135606e8fcd1d5ca6eca3f3f471d833f80ed5..b71258c9d24821037d3bd78620521313b0b56486 100644 (file)
--- a/extra/db2/fql/fql.factor
+++ b/extra/db2/fql/fql.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays combinators constructors db2
 db2.private db2.sqlite.lib db2.statements db2.utils destructors
-kernel make math.parser sequences strings ;
+kernel make math.parser sequences strings assocs ;
 IN: db2.fql
 
 TUPLE: fql-statement sql in out ;
@@ -20,6 +20,20 @@ CONSTRUCTOR: insert ( into names values -- obj ) ;
 M: insert normalize-fql ( insert -- insert )
     [ [ ?1array ] ?when ] change-names ;
 
+TUPLE: update tables keys values where order-by limit ;
+CONSTRUCTOR: update ( tables keys values where -- obj ) ;
+M: update normalize-fql ( insert -- insert )
+    [ [ ?1array ] ?when ] change-tables
+    [ [ ?1array ] ?when ] change-keys
+    [ [ ?1array ] ?when ] change-values
+    [ [ ?1array ] ?when ] change-order-by ;
+
+TUPLE: delete tables where order-by limit ;
+CONSTRUCTOR: delete ( tables keys values where -- obj ) ;
+M: delete normalize-fql ( insert -- insert )
+    [ [ ?1array ] ?when ] change-tables
+    [ [ ?1array ] ?when ] change-order-by ;
+
 TUPLE: select names from where group-by order-by offset limit ;
 CONSTRUCTOR: select ( names from -- obj ) ;
 M: select normalize-fql ( select -- select )
@@ -43,6 +57,33 @@ M: insert expand-fql*
         } cleave
     ] "" make >>sql ;
 
+M: update expand-fql*
+    [ fql-statement new ] dip
+    [
+        {
+            [ "update " % tables>> ", " join % ]
+            [
+                " set " % [ keys>> ] [ values>> ] bi 
+                zip [ ", " % ] [ first2 [ % ] dip " = " % % ] interleave
+            ]
+            ! [ "  " % from>> ", " join % ]
+            [ where>> [ " where " % [ expand-fql % ] when* ] when* ]
+            [ order-by>> [ " order by " % ", " join % ] when* ]
+            [ limit>> [ " limit " % # ] when* ]
+        } cleave
+    ] "" make >>sql ;
+
+M: delete expand-fql*
+    [ fql-statement new ] dip
+    [
+        {
+            [ "delete from " % tables>> ", " join % ]
+            [ where>> [ " where " % [ expand-fql % ] when* ] when* ]
+                [ order-by>> [ " order by " % ", " join % ] when* ]
+            [ limit>> [ " limit " % # ] when* ]
+        } cleave
+    ] "" make >>sql ;
+
 M: select expand-fql*
     [ fql-statement new ] dip
     [
@@ -57,7 +98,6 @@ M: select expand-fql*
         } cleave
     ] "" make >>sql ;
 
-
 M: fql-statement sql-command ( sql -- )
     sql>> sql-command ;