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

diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor
index 8d4bfd19a04a626a01c2f099139007b6b7995267..4687a6329f95d95b2c33af7a937d36493c8d5f9e 100644 (file)
--- 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
 
-<PRIVATE
-
-: execute-sql-string ( string -- )
+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 )
+
+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* ;

diff --git a/extra/db2/fql/authors.txt b/extra/db2/fql/authors.txt
new file mode 100644 (file)
index 0000000..b4bd0e7
--- /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 (file)
index 0000000..6a6f782
--- /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" } <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

diff --git a/extra/db2/fql/fql.factor b/extra/db2/fql/fql.factor
new file mode 100644 (file)
index 0000000..78abc5e
--- /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 "?" <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* ;

diff --git a/extra/db2/sqlite/lib/lib.factor b/extra/db2/sqlite/lib/lib.factor
index f8503ee90ff7ae4eb661302e0733ed07749ad5d7..261a2d42f38cc4dae4abb34d0fbd58b3a96ea0be 100644 (file)
--- 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 ed4b7babb82d90e2a82e9299b0bf967bd115c314..56c73211c94cf83b61ea04755300446048687399 100644 (file)
--- 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 (file)
index 0000000..b4bd0e7
--- /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 (file)
index 0000000..2f5c9a2
--- /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