diff --git a/extra/db2/fql/fql-tests.factor b/extra/db2/fql/fql-tests.factor index ca7b46b283..84698c09c2 100644 --- a/extra/db2/fql/fql-tests.factor +++ b/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 -kernel tools.test ; +USING: accessors db2 db2.statements.tests db2.tester +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 diff --git a/extra/db2/fql/fql.factor b/extra/db2/fql/fql.factor index b71258c9d2..e286e56a81 100644 --- 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 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 ] ?when ] change-keys - [ [ ?1array ] ?when ] change-values - [ [ ?1array ] ?when ] change-order-by ; + [ ??1array ] change-tables + [ ??1array ] change-keys + [ ??1array ] change-values + [ ??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 ] ?when ] change-order-by ; + [ ??1array ] change-tables + [ ??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 ] ?when ] change-from - [ [ ?1array ] ?when ] change-group-by - [ [ ?1array ] ?when ] change-order-by ; + [ ??1array ] change-names + [ ??1array ] change-from + [ ??1array ] change-group-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* ] diff --git a/extra/db2/utils/utils.factor b/extra/db2/utils/utils.factor index 2f5c9a277a..c9b009e917 100644 --- a/extra/db2/utils/utils.factor +++ b/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