steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

working out the dispatch for bound queries, first stab at fql

db4
Doug Coleman 2009-04-13 19:51:19 -05:00
parent 66a4ec5896
commit d20fb81a9c
8 changed files with 161 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
extra/db2/db2.factor
View File

@ -6,41 +6,58 @@ destructors fry kernel math namespaces sequences strings
db2.sqlite.types ;
IN: db2
<PRIVATE
GENERIC: sql-command ( object -- )
GENERIC: sql-query ( object -- sequence )
GENERIC: sql-bind-command* ( sequence object -- )
GENERIC: sql-bind-query* ( sequence object -- sequence )
GENERIC: sql-bind-typed-command* ( sequence object -- )
GENERIC: sql-bind-typed-query* ( sequence object -- sequence )
: execute-sql-string ( string -- )
GENERIC: sql-bind-command ( object -- )
GENERIC: sql-bind-query ( object -- sequence )
GENERIC: sql-bind-typed-command ( object -- )
GENERIC: sql-bind-typed-query ( object -- sequence )
M: string sql-command ( sql -- )
f f <statement> [ 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> [ statement>result-sequence ] with-disposal ;
: sql-bind-command ( sequence string -- )
M: string sql-bind-command* ( sequence string -- )
f f <statement> [
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 <statement> [
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 <statement> [
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 <statement> [
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* ;

1
extra/db2/fql/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

27
extra/db2/fql/fql-tests.factor Normal file
View File

@ -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" } <insert> 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

79
extra/db2/fql/fql.factor Normal file
View File

@ -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 "?" <array> ", " 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* ;

10
extra/db2/sqlite/lib/lib.factor
View File

@ -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 [ ] }

17
extra/db2/statements/statements-tests.factor
View File

@ -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

1
extra/db2/utils/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

9
extra/db2/utils/utils.factor Normal file
View File

@ -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