add raw, typed bind statements

extra/db2/db2.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors continuations db2.result-sets db2.sqlite.lib
 db2.sqlite.result-sets db2.sqlite.statements db2.statements
-destructors fry kernel math namespaces sequences strings ;
+destructors fry kernel math namespaces sequences strings
+db2.sqlite.types ;
 IN: db2
 
 <PRIVATE
@@ -25,7 +26,7 @@ PRIVATE>
         sqlite-maybe-prepare [
             handle>> swap sqlite-bind-sequence
         ] [
-            sqlite-result-set new-result-set advance-row
+            >sqlite-result-set drop
         ] bi
     ] with-disposal ;
 
@@ -37,3 +38,21 @@ PRIVATE>
             statement>result-sequence
         ] bi
     ] with-disposal ;
+
+: sql-bind-typed-command ( in-sequence string -- )
+    f f <statement> [
+        sqlite-maybe-prepare [
+            handle>> swap sqlite-bind-typed-sequence
+        ] [
+            >sqlite-result-set drop
+        ] bi
+    ] with-disposal ;
+
+: sql-bind-typed-query ( in-sequence string -- out-sequence )
+    f f <statement> [
+        sqlite-maybe-prepare [
+            handle>> swap sqlite-bind-typed-sequence
+        ] [
+            statement>result-sequence
+        ] bi
+    ] with-disposal ;

extra/db2/sqlite/lib/lib.factor

@@ -50,6 +50,9 @@ IN: db2.sqlite.lib
 : sqlite-bind-uint64 ( handle i n -- )
     sqlite3-bind-uint64 sqlite-check-result ;
 
+: sqlite-bind-boolean ( handle name obj -- )
+    >boolean 1 0 ? sqlite-bind-int ;
+
 : sqlite-bind-double ( handle i x -- )
     sqlite3_bind_double sqlite-check-result ;
 
@@ -113,3 +116,6 @@ IN: db2.sqlite.lib
 
 : sqlite-bind-sequence ( handle sequence -- )
     [ 1+ swap sqlite-bind-text ] assoc-with each-index ;
+
+: >sqlite-result-set ( statement -- result-set )
+    sqlite-result-set new-result-set dup advance-row ;

extra/db2/sqlite/result-sets/result-sets.factor

@@ -10,9 +10,7 @@ M: sqlite-result-set dispose
     f >>handle drop ;
 
 M: sqlite-statement statement>result-set*
-    sqlite-maybe-prepare
-    sqlite-result-set new-result-set
-    dup advance-row ;
+    sqlite-maybe-prepare >sqlite-result-set ;
 
 M: sqlite-result-set advance-row ( result-set -- )
     dup handle>> sqlite-next >>has-more? drop ;

extra/db2/sqlite/types/types.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays calendar.format combinators db2.types
-db2.sqlite.ffi db2.sqlite.lib
+db2.sqlite.ffi db2.sqlite.lib math fry
 kernel present sequences serialize urls ;
 IN: db2.sqlite.types
 
@@ -29,6 +29,30 @@ IN: db2.sqlite.types
         [ no-sql-type ]
     } case ;
 
+: bind-next-sqlite-type ( handle key value type -- )
+    dup array? [ first ] when
+    {
+        { INTEGER [ sqlite-bind-int ] }
+        { BIG-INTEGER [ sqlite-bind-int64 ] }
+        { SIGNED-BIG-INTEGER [ sqlite-bind-int64 ] }
+        { UNSIGNED-BIG-INTEGER [ sqlite-bind-uint64 ] }
+        { BOOLEAN [ sqlite-bind-boolean ] }
+        { TEXT [ sqlite-bind-text ] }
+        { VARCHAR [ sqlite-bind-text ] }
+        { DOUBLE [ sqlite-bind-double ] }
+        { DATE [ timestamp>ymd sqlite-bind-text ] }
+        { TIME [ timestamp>hms sqlite-bind-text ] }
+        { DATETIME [ timestamp>ymdhms sqlite-bind-text ] }
+        { TIMESTAMP [ timestamp>ymdhms sqlite-bind-text ] }
+        { BLOB [ sqlite-bind-blob ] }
+        { FACTOR-BLOB [ object>bytes sqlite-bind-blob ] }
+        { URL [ present sqlite-bind-text ] }
+        { +db-assigned-id+ [ sqlite-bind-int ] }
+        { +random-id+ [ sqlite-bind-int64 ] }
+        { NULL [ drop sqlite-bind-null ] }
+        [ no-sql-type ]
+    } case ;
+
 : bind-sqlite-type ( handle key value type -- )
     #! null and empty values need to be set by sqlite-bind-null-by-name
     over [
@@ -60,3 +84,5 @@ IN: db2.sqlite.types
         [ no-sql-type ]
     } case ;
 
+: sqlite-bind-typed-sequence ( handle sequence -- )
+    [ 1+ swap first2 swap bind-next-sqlite-type ] assoc-with each-index ;

extra/db2/statements/statements-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test db2.statements kernel db2 db2.tester
-continuations db2.errors accessors ;
+continuations db2.errors accessors db2.types ;
 IN: db2.statements.tests
 
 { 1 0 } [ [ drop ] statement-each ] must-infer-as
@@ -46,6 +46,21 @@ IN: db2.statements.tests
         "select os from computer where name = ?;" sql-bind-query
     ] unit-test
 
+    [ { { "windows" } } ] [
+        { { VARCHAR "clubber" } }
+        "select os from computer where name = ?;" sql-bind-typed-query
+    ] unit-test
+
+    [ ] [
+        {
+            { VARCHAR "clubber" }
+            { VARCHAR "windows" }
+        }
+        "insert into computer (name, os) values(?, ?);"
+        sql-bind-typed-command
+    ] unit-test
+
+
     ;
 
 [ test-sql-command ] test-dbs