From 1f004a11009e95b649ea981c0845c25c87ff91c3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 14 Apr 2009 17:10:16 -0500 Subject: [PATCH] support typed queries --- extra/db2/db2.factor | 23 ++++++++++++++++++- extra/db2/result-sets/result-sets.factor | 7 +++--- .../db2/sqlite/result-sets/result-sets.factor | 8 +++++-- extra/db2/statements/statements-tests.factor | 7 +++--- extra/db2/statements/statements.factor | 14 +++++------ 5 files changed, 43 insertions(+), 16 deletions(-) diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor index e67cb8d200..b14ee969be 100644 --- a/extra/db2/db2.factor +++ b/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 ; diff --git a/extra/db2/result-sets/result-sets.factor b/extra/db2/result-sets/result-sets.factor index 5bf148d4be..499808930a 100644 --- a/extra/db2/result-sets/result-sets.factor +++ b/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 ; diff --git a/extra/db2/sqlite/result-sets/result-sets.factor b/extra/db2/sqlite/result-sets/result-sets.factor index afc0c7bfc2..f3d677ed21 100644 --- a/extra/db2/sqlite/result-sets/result-sets.factor +++ b/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 ; diff --git a/extra/db2/statements/statements-tests.factor b/extra/db2/statements/statements-tests.factor index 6a4b774713..d90e70ea70 100644 --- a/extra/db2/statements/statements-tests.factor +++ b/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 sql-bind-typed-query + { VARCHAR } + sql-bind-typed-query ] unit-test [ ] [ diff --git a/extra/db2/statements/statements.factor b/extra/db2/statements/statements.factor index 929b303d4b..9ddd74ded7 100644 --- a/extra/db2/statements/statements.factor +++ b/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 ;