support typed queries

extra/db2/db2.factor

@@ -6,6 +6,15 @@ destructors fry kernel math namespaces sequences strings
 db2.sqlite.types ;
 IN: db2
 
+ERROR: no-in-types statement ;
+ERROR: no-out-types statement ;
+
+: guard-in ( statement -- statement )
+    dup in>> [ no-in-types ] unless ;
+
+: guard-out ( statement -- statement )
+    dup out>> [ no-out-types ] unless ;
+
 GENERIC: sql-command ( object -- )
 GENERIC: sql-query ( object -- sequence )
 GENERIC: sql-bind-command ( object -- )
@@ -27,26 +36,31 @@ M: statement sql-query ( statement -- sequence )
 
 M: statement sql-bind-command ( statement -- )
     [
+        guard-in
         prepare-statement
         [ bind-sequence ] [ statement>result-set drop ] bi
     ] with-disposal ;
 
 M: statement sql-bind-query ( statement -- sequence )
     [
+        guard-in
         prepare-statement
         [ bind-sequence ] [ statement>result-sequence ] bi
     ] with-disposal ;
 
 M: statement sql-bind-typed-command ( statement -- )
     [
+        guard-in
         prepare-statement
         [ bind-typed-sequence ] [ statement>result-set drop ] bi
     ] with-disposal ;
 
 M: statement sql-bind-typed-query ( statement -- sequence )
     [
+        guard-in
+        guard-out
         prepare-statement
-        [ bind-typed-sequence ] [ statement>result-sequence ] bi
+        [ bind-typed-sequence ] [ statement>typed-result-sequence ] bi
     ] with-disposal ;
 
 M: sequence sql-command [ sql-command ] each ;
@@ -55,3 +69,10 @@ M: sequence sql-bind-command [ sql-bind-command ] each ;
 M: sequence sql-bind-query [ sql-bind-query ] map ;
 M: sequence sql-bind-typed-command [ sql-bind-typed-command ] each ;
 M: sequence sql-bind-typed-query [ sql-bind-typed-query ] map ;
+
+M: integer sql-command throw ;
+M: integer sql-query throw ;
+M: integer sql-bind-command throw ;
+M: integer sql-bind-query throw ;
+M: integer sql-bind-typed-command throw ;
+M: integer sql-bind-typed-query throw ;

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

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sequences combinators ;
+USING: accessors kernel sequences combinators fry ;
 IN: db2.result-sets
 
 TUPLE: result-set sql in out handle n max ;
@@ -10,7 +10,7 @@ GENERIC: #columns ( result-set -- n )
 GENERIC: advance-row ( result-set -- )
 GENERIC: more-rows? ( result-set -- ? )
 GENERIC# column 1 ( result-set column -- obj )
-GENERIC# column-typed 1 ( result-set column -- sql )
+GENERIC# column-typed 2 ( result-set column type -- sql )
 
 : init-result-set ( result-set -- result-set )
     dup #rows >>max
@@ -29,4 +29,5 @@ GENERIC# column-typed 1 ( result-set column -- sql )
     dup #columns [ column ] with map ;
 
 : sql-row-typed ( result-set -- seq )
-    dup #columns [ B column-typed ] with map ;
+    [ #columns ] [ out>> ] [ ] tri
+    '[ [ _ ] 2dip column-typed ] 2map ;

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

@@ -1,7 +1,8 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors db2.result-sets db2.sqlite.statements
-db2.statements kernel db2.sqlite.lib destructors ;
+db2.statements kernel db2.sqlite.lib destructors
+db2.sqlite.types ;
 IN: db2.sqlite.result-sets
 
 TUPLE: sqlite-result-set < result-set has-more? ;
@@ -10,7 +11,7 @@ M: sqlite-result-set dispose
     f >>handle drop ;
 
 M: sqlite-statement statement>result-set*
-    sqlite-maybe-prepare >sqlite-result-set ;
+    prepare-statement >sqlite-result-set ;
 
 M: sqlite-result-set advance-row ( result-set -- )
     dup handle>> sqlite-next >>has-more? drop ;
@@ -23,3 +24,6 @@ M: sqlite-result-set #columns ( result-set -- n )
 
 M: sqlite-result-set column ( result-set n -- obj )
     [ handle>> ] [ sqlite-column ] bi* ;
+
+M: sqlite-result-set column-typed ( result-set n type -- obj )
+    [ handle>> ] 2dip sqlite-type ;

extra/db2/statements/statements-tests.factor

@@ -4,8 +4,8 @@ USING: tools.test db2.statements kernel db2 db2.tester
 continuations db2.errors accessors db2.types ;
 IN: db2.statements.tests
 
-{ 1 0 } [ [ drop ] statement-each ] must-infer-as
-{ 1 1 } [ [ ] statement-map ] must-infer-as
+{ 1 0 } [ [ drop ] result-set-each ] must-infer-as
+{ 1 1 } [ [ ] result-set-map ] must-infer-as
 
 : create-computer-table ( -- )
     [ "drop table computer;" sql-command ] ignore-errors
@@ -54,7 +54,8 @@ IN: db2.statements.tests
     [ { { "windows" } } ] [
         "select os from computer where name = ?;"
         { { VARCHAR "clubber" } }
-        f <statement> sql-bind-typed-query
+        { VARCHAR }
+        <statement> sql-bind-typed-query
     ] unit-test
 
     [ ] [

extra/db2/statements/statements.factor

@@ -37,17 +37,17 @@ M: object execute-statement* ( statement type -- )
 : prepare-statement ( statement -- statement )
     dup handle>> [ prepare-statement* ] unless ;
 
-: statement-each ( statement quot: ( statement -- ) -- )
+: result-set-each ( statement quot: ( statement -- ) -- )
     over more-rows?
-    [ [ call ] 2keep over advance-row statement-each ]
+    [ [ call ] 2keep over advance-row result-set-each ]
     [ 2drop ] if ; inline recursive
 
-: statement-map ( statement quot -- sequence )
-    accumulator [ statement-each ] dip { } like ; inline
+: result-set-map ( statement quot -- sequence )
+    accumulator [ result-set-each ] dip { } like ; inline
 
 : statement>result-sequence ( statement -- sequence )
-    statement>result-set [ [ sql-row ] statement-map ] with-disposal ;
+    statement>result-set [ [ sql-row ] result-set-map ] with-disposal ;
 
 : statement>typed-result-sequence ( statement -- sequence )
-    [ out>> ] [ statement>result-set ] bi
-    [ [ sql-row-typed ] with statement-map ] with-disposal ;
+    statement>result-set
+    [ [ sql-row-typed ] result-set-map ] with-disposal ;