support AND and OR for where slot

extra/db2/fql/fql-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors db2 db2.fql db2.statements.tests db2.tester
+USING: accessors db2 db2.statements.tests db2.tester
-kernel tools.test ;
+kernel tools.test db2.fql ;
 IN: db2.fql.tests
 
 : test-fql ( -- )
@@ -33,6 +33,20 @@ IN: db2.fql.tests
         expand-fql sql>>
     ] unit-test
 
+    [
+        "select name, os from computer where (hmm > 1 or foo is NULL) group by os order by lol offset 100 limit 3"
+    ] [
+        select new
+            { "name" "os" } >>names
+            "computer" >>from
+            T{ or f { "hmm > 1" "foo is NULL" } } >>where
+            "os" >>group-by
+            "lol" >>order-by
+            100 >>offset
+            3 >>limit
+        expand-fql sql>>
+    ] unit-test
+
     [ "delete from computer order by omg limit 3" ]
     [
         delete new

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 assocs ;
+kernel make math.parser sequences strings assocs db2.utils ;
 IN: db2.fql
 
 TUPLE: fql-statement sql in out ;
@@ -12,40 +12,59 @@ GENERIC: normalize-fql ( object -- sequence/fql-statement )
 
 ! M: object normalize-fql ;
 
-: ?1array ( obj -- array )
-    dup string? [ 1array ] when ; inline
-
 TUPLE: insert into names values ;
 CONSTRUCTOR: insert ( into names values -- obj ) ;
 M: insert normalize-fql ( insert -- insert )
-    [ [ ?1array ] ?when ] change-names ;
+    [ ??1array ] 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 ] change-tables
-    [ [ ?1array ] ?when ] change-keys
+    [ ??1array ] change-keys
-    [ [ ?1array ] ?when ] change-values
+    [ ??1array ] change-values
-    [ [ ?1array ] ?when ] change-order-by ;
+    [ ??1array ] 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 ] change-tables
-    [ [ ?1array ] ?when ] change-order-by ;
+    [ ??1array ] 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 )
-    [ [ ?1array ] ?when ] change-names
+    [ ??1array ] change-names
-    [ [ ?1array ] ?when ] change-from
+    [ ??1array ] change-from
-    [ [ ?1array ] ?when ] change-group-by
+    [ ??1array ] change-group-by
-    [ [ ?1array ] ?when ] change-order-by ;
+    [ ??1array ] change-order-by ;
 
-TUPLE: where ;
+! TUPLE: where sequence ;
+! M: where normalize-fql ( where -- where )
+    ! [ ??1array ] change-sequence ;
+
+TUPLE: and sequence ;
+
+TUPLE: or sequence ;
 
 : expand-fql ( object1 -- object2 ) normalize-fql expand-fql* ;
 
+M: or expand-fql* ( obj -- string )
+    [
+        sequence>> "(" %
+        [ " or " % ] [ expand-fql* % ] interleave
+        ")" %
+    ] "" make ;
+
+M: and expand-fql* ( obj -- string )
+    [
+        sequence>> "(" %
+        [ " and " % ] [ expand-fql* % ] interleave
+        ")" %
+    ] "" make ;
+
+M: string expand-fql* ( string -- string ) ;
+
 M: insert expand-fql*
     [ fql-statement new ] dip
     [
@@ -67,7 +86,7 @@ M: update expand-fql*
                 zip [ ", " % ] [ first2 [ % ] dip " = " % % ] interleave
             ]
             ! [ "  " % from>> ", " join % ]
-            [ where>> [ " where " % [ expand-fql % ] when* ] when* ]
+            [ where>> [ " where " % expand-fql* % ] when* ]
             [ order-by>> [ " order by " % ", " join % ] when* ]
             [ limit>> [ " limit " % # ] when* ]
         } cleave
@@ -78,7 +97,7 @@ M: delete expand-fql*
     [
         {
             [ "delete from " % tables>> ", " join % ]
-            [ where>> [ " where " % [ expand-fql % ] when* ] when* ]
+            [ where>> [ " where " % expand-fql* % ] when* ]
                 [ order-by>> [ " order by " % ", " join % ] when* ]
             [ limit>> [ " limit " % # ] when* ]
         } cleave
@@ -90,7 +109,7 @@ M: select expand-fql*
         {
             [ "select " % names>> ", " join % ]
             [ " from " % from>> ", " join % ]
-            [ where>> [ " where " % [ expand-fql % ] when* ] when* ]
+            [ where>> [ " where " % expand-fql* % ] when* ]
             [ group-by>> [ " group by " % ", " join % ] when* ]
             [ order-by>> [ " order by " % ", " join % ] when* ]
             [ offset>> [ " offset " % # ] when* ]

extra/db2/utils/utils.factor

@@ -4,6 +4,8 @@ USING: kernel ;
 IN: db2.utils
 
 : ?when ( object quot -- object' ) dupd when ; inline
+: ?1array ( obj -- array ) dup string? [ 1array ] when ; inline
+: ??1array ( obj -- array/f ) [ ?1array ] ?when ; inline
 
 : assoc-with ( object sequence quot -- obj curry )
     swapd [ [ -rot ] dip  call ] 2curry ; inline