diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor index 8d4bfd19a0..4687a6329f 100644 --- a/extra/db2/db2.factor +++ b/extra/db2/db2.factor @@ -6,41 +6,58 @@ destructors fry kernel math namespaces sequences strings db2.sqlite.types ; IN: db2 - [ execute-statement ] with-disposal ; -PRIVATE> - -: sql-command ( sql -- ) - dup string? - [ execute-sql-string ] - [ [ execute-sql-string ] each ] if ; - -: sql-query ( sql -- sequence ) +M: string sql-query ( sql -- sequence ) f f [ statement>result-sequence ] with-disposal ; -: sql-bind-command ( sequence string -- ) +M: string sql-bind-command* ( sequence string -- ) f f [ prepare-statement [ bind-sequence ] [ statement>result-set drop ] bi ] with-disposal ; -: sql-bind-query ( in-sequence string -- out-sequence ) +M: string sql-bind-query* ( in-sequence string -- out-sequence ) f f [ prepare-statement [ bind-sequence ] [ statement>result-sequence ] bi ] with-disposal ; -: sql-bind-typed-command ( in-sequence string -- ) +M: string sql-bind-typed-command* ( in-sequence string -- ) f f [ prepare-statement [ bind-typed-sequence ] [ statement>result-set drop ] bi ] with-disposal ; -: sql-bind-typed-query ( in-sequence string -- out-sequence ) +M: string sql-bind-typed-query* ( in-sequence string -- out-sequence ) f f [ prepare-statement [ bind-typed-sequence ] [ statement>result-sequence ] bi ] with-disposal ; + +M: sequence sql-command [ sql-command ] each ; +M: sequence sql-query [ sql-query ] map ; +M: sequence sql-bind-command* [ sql-bind-command* ] with each ; +M: sequence sql-bind-query* [ sql-bind-query* ] with map ; +M: sequence sql-bind-typed-command* [ sql-bind-typed-command* ] with each ; +M: sequence sql-bind-typed-query* [ sql-bind-typed-query* ] with map ; + +! M: string sql-command [ sql-command ] each ; +! M: string sql-query [ sql-query ] map ; +! M: string sql-bind-command* sql-bind-command* ; +! M: string sql-bind-query* sql-bind-query* ; +! M: string sql-bind-typed-command sql-bind-typed-command* ; +! M: string sql-bind-typed-query sql-bind-typed-query* ; diff --git a/extra/db2/fql/authors.txt b/extra/db2/fql/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/fql/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/fql/fql-tests.factor b/extra/db2/fql/fql-tests.factor new file mode 100644 index 0000000000..6a6f782b1e --- /dev/null +++ b/extra/db2/fql/fql-tests.factor @@ -0,0 +1,27 @@ +! 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 ; +IN: db2.fql.tests + +: test-fql ( -- ) + create-computer-table + + [ "insert into computer (name, os) values (?, ?);" ] + [ + "computer" { "name" "os" } { "lol" "os2" } expand-fql + sql>> + ] unit-test + + [ "select name, os from computer" ] + [ + select new + { "name" "os" } >>names + "computer" >>from + expand-fql sql>> + ] unit-test + + + ; + +[ test-fql ] test-dbs diff --git a/extra/db2/fql/fql.factor b/extra/db2/fql/fql.factor new file mode 100644 index 0000000000..78abc5ee0b --- /dev/null +++ b/extra/db2/fql/fql.factor @@ -0,0 +1,79 @@ +! Copyright (C) 2009 Doug Coleman. +! 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 ; +IN: db2.fql + +TUPLE: fql-statement sql in out ; + +GENERIC: expand-fql* ( object -- sequence/fql-statement ) +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 ; + +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 ; + +TUPLE: where ; + +: expand-fql ( object1 -- object2 ) normalize-fql expand-fql* ; + +M: insert expand-fql* + [ fql-statement new ] dip + [ + { + [ "insert into " % into>> % ] + [ " (" % names>> ", " join % ")" % ] + [ " values (" % values>> length "?" ", " join % ");" % ] + [ values>> >>in ] + } cleave + ] "" make >>sql ; + +M: select expand-fql* + [ fql-statement new ] dip + [ + { + [ "select " % names>> ", " join % ] + [ " from " % from>> ", " join % ] + [ where>> [ " where " % [ expand-fql % ] when* ] when* ] + [ group-by>> [ " group by " % ", " join % ] when* ] + [ order-by>> [ " order by " % ", " join % ] when* ] + [ offset>> [ " offset " % # ] when* ] + [ limit>> [ " limit " % # ] when* ] + } cleave + ] "" make >>sql ; + + +M: fql-statement sql-command ( sql -- ) + sql>> sql-command ; + +M: fql-statement sql-query ( sql -- sequence ) + sql>> sql-query ; + +M: fql-statement sql-bind-command ( fql-statement -- ) + [ in>> ] [ sql>> ] bi sql-bind-command* ; + +M: fql-statement sql-bind-query ( fql-statement -- out-sequence ) + [ in>> ] [ sql>> ] bi sql-bind-query* ; + +M: fql-statement sql-bind-typed-command ( string -- ) + [ in>> ] [ sql>> ] bi sql-bind-typed-command* ; + +M: fql-statement sql-bind-typed-query ( string -- out-sequence ) + [ in>> ] [ sql>> ] bi sql-bind-typed-query* ; diff --git a/extra/db2/sqlite/lib/lib.factor b/extra/db2/sqlite/lib/lib.factor index f8503ee90f..261a2d42f3 100644 --- a/extra/db2/sqlite/lib/lib.factor +++ b/extra/db2/sqlite/lib/lib.factor @@ -1,16 +1,12 @@ ! Copyright (C) 2008 Chris Double, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types arrays calendar.format -combinators db2.connections db2.sqlite.ffi db2.errors +combinators db2.connections db2.errors db2.result-sets +db2.sqlite.errors db2.sqlite.ffi db2.sqlite.result-sets io.backend io.encodings.string io.encodings.utf8 kernel math -namespaces present sequences serialize urls db2.sqlite.errors ; +namespaces present sequences serialize urls ; IN: db2.sqlite.lib -: ?when ( object quot -- object' ) dupd when ; inline - -: assoc-with ( object sequence quot -- obj curry ) - swapd [ [ -rot ] dip call ] 2curry ; inline - : sqlite-check-result ( n -- ) { { SQLITE_OK [ ] } diff --git a/extra/db2/statements/statements-tests.factor b/extra/db2/statements/statements-tests.factor index ed4b7babb8..56c73211c9 100644 --- a/extra/db2/statements/statements-tests.factor +++ b/extra/db2/statements/statements-tests.factor @@ -7,8 +7,7 @@ IN: db2.statements.tests { 1 0 } [ [ drop ] statement-each ] must-infer-as { 1 1 } [ [ ] statement-map ] must-infer-as - -: test-sql-command ( -- ) +: create-computer-table ( -- ) [ "drop table computer;" sql-command ] ignore-errors [ "drop table computer;" sql-command ] @@ -17,7 +16,11 @@ IN: db2.statements.tests [ ] [ "create table computer(name varchar, os varchar);" sql-command - ] unit-test + ] unit-test ; + + +: test-sql-command ( -- ) + create-computer-table [ ] [ "insert into computer (name, os) values('rocky', 'mac');" @@ -38,17 +41,17 @@ IN: db2.statements.tests [ ] [ { "clubber" "windows" } "insert into computer (name, os) values(?, ?);" - sql-bind-command + sql-bind-command* ] unit-test [ { { "windows" } } ] [ { "clubber" } - "select os from computer where name = ?;" sql-bind-query + "select os from computer where name = ?;" sql-bind-query* ] unit-test [ { { "windows" } } ] [ { { VARCHAR "clubber" } } - "select os from computer where name = ?;" sql-bind-typed-query + "select os from computer where name = ?;" sql-bind-typed-query* ] unit-test [ ] [ @@ -57,7 +60,7 @@ IN: db2.statements.tests { VARCHAR "windows" } } "insert into computer (name, os) values(?, ?);" - sql-bind-typed-command + sql-bind-typed-command* ] unit-test diff --git a/extra/db2/utils/authors.txt b/extra/db2/utils/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/utils/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/utils/utils.factor b/extra/db2/utils/utils.factor new file mode 100644 index 0000000000..2f5c9a277a --- /dev/null +++ b/extra/db2/utils/utils.factor @@ -0,0 +1,9 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel ; +IN: db2.utils + +: ?when ( object quot -- object' ) dupd when ; inline + +: assoc-with ( object sequence quot -- obj curry ) + swapd [ [ -rot ] dip call ] 2curry ; inline