improve the db protocol and update sqlite to use it

extra/db/db.factor

@@ -12,30 +12,20 @@ C: <db> db ( handle -- obj )
 GENERIC: db-open ( db -- )
 GENERIC: db-close ( db -- )
 
-TUPLE: statement sql params handle bound? n max ;
+TUPLE: statement sql params handle bound? ;
 
 TUPLE: simple-statement ;
-TUPLE: bound-statement ;
 TUPLE: prepared-statement ;
-TUPLE: prepared-bound-statement ;
 
 HOOK: <simple-statement> db ( str -- statement )
-HOOK: <bound-statement> db ( str obj -- statement )
 HOOK: <prepared-statement> db ( str -- statement )
-HOOK: <prepared-bound-statement> db ( str obj -- statement )
-
-! TUPLE: result sql params handle n max ;
-
-GENERIC: #rows ( statement -- n )
-GENERIC: #columns ( statement -- n )
-GENERIC# row-column 1 ( statement n -- obj )
-GENERIC: advance-row ( statement -- ? )
 
 GENERIC: prepare-statement ( statement -- )
-GENERIC: reset-statement ( statement -- )
 GENERIC: bind-statement* ( obj statement -- )
 GENERIC: rebind-statement ( obj statement -- )
 
+GENERIC: execute-statement ( statement -- )
+
 : bind-statement ( obj statement -- )
     2dup dup statement-bound? [
         rebind-statement
@@ -45,7 +35,24 @@ GENERIC: rebind-statement ( obj statement -- )
     tuck set-statement-params
     t swap set-statement-bound? ;
 
-: sql-row ( statement -- seq )
+TUPLE: result-set sql params handle n max ;
+
+GENERIC: query-results ( query -- result-set )
+
+GENERIC: #rows ( result-set -- n )
+GENERIC: #columns ( result-set -- n )
+GENERIC# row-column 1 ( result-set n -- obj )
+GENERIC: advance-row ( result-set -- ? )
+
+: <result-set> ( query handle tuple -- result-set )
+    >r >r { statement-sql statement-params } get-slots r>
+    {
+        set-result-set-sql
+        set-result-set-params
+        set-result-set-handle
+    } result-set construct r> construct-delegate ;
+
+: sql-row ( result-set -- seq )
     dup #columns [ row-column ] with map ;
 
 : query-each ( statement quot -- )
@@ -64,23 +71,20 @@ GENERIC: rebind-statement ( obj statement -- )
         [ db swap with-variable ] curry with-disposal
     ] with-scope ;
 
-: do-statement ( statement -- )
+: do-query ( query -- result-set )
-    [ advance-row drop ] with-disposal ;
+    query-results [ [ sql-row ] query-map ] with-disposal ;
 
-: do-query ( query -- rows )
+: do-bound-query ( obj query -- rows )
-    [ [ sql-row ] query-map ] with-disposal ;
+    [ bind-statement ] keep do-query ;
 
-: do-simple-query ( sql -- rows )
+: do-bound-command ( obj query -- rows )
-    <simple-statement> do-query ;
+    [ bind-statement ] keep execute-statement ;
 
-: do-bound-query ( sql obj -- rows )
+: sql-query ( sql -- rows )
-    <bound-statement> do-query ;
+    <simple-statement> [ do-query ] with-disposal ;
 
-: do-simple-command ( sql -- )
+: sql-command ( sql -- )
-    <simple-statement> do-statement ;
+    <simple-statement> [ execute-statement ] with-disposal ;
-
-: do-bound-command ( sql obj -- )
-    <bound-statement> do-statement ;
 
 SYMBOL: in-transaction
 HOOK: begin-transaction db ( -- )

extra/db/postgresql/postgresql.factor

@@ -38,32 +38,41 @@ M: postgresql-db dispose ( db -- )
 : with-postgresql ( host ust pass db quot -- )
     >r <postgresql-db> r> with-disposal ;
 
-M: postgresql-statement #rows ( statement -- n )
+
+M: postgresql-result-set #rows ( statement -- n )
     statement-handle PQntuples ;
 
-M: postgresql-statement #columns ( statement -- n )
+M: postgresql-result-set #columns ( statement -- n )
     statement-handle PQnfields ;
 
-M: postgresql-statement row-column ( statement n -- obj )
+M: postgresql-result-set row-column ( statement n -- obj )
     >r dup statement-handle swap statement-n r> PQgetvalue ;
 
-: init-statement ( statement -- )
+
-    dup statement-max [
+: init-result-set ( result-set -- )
-        dup do-postgresql-statement over set-statement-handle
+    dup result-set-max [
-        dup #rows over set-statement-max
+        dup do-postgresql-statement over set-result-set-handle
-        -1 over set-statement-n
+        dup #rows over set-result-set-max
+        -1 over set-result-set-n
     ] unless drop ;
 
-: increment-n ( statement -- n )
+: increment-n ( result-set -- n )
-    dup statement-n 1+ dup rot set-statement-n ;
+    dup result-set-n 1+ dup rot set-result-set-n ;
+
+M: postgresql-result-set advance-row ( result-set -- ? )
+    dup init-result-set
+    dup increment-n swap result-set-max >= ;
 
-M: postgresql-statement advance-row ( statement -- ? )
-    dup init-statement
-    dup increment-n swap statement-max >= ;
 
 M: postgresql-statement dispose ( query -- )
     dup statement-handle PQclear
-    0 0 rot { set-statement-n set-statement-max } set-slots ;
+    f swap set-statement-handle ;
+
+M: postgresql-result-set dispose ( result-set -- )
+    dup result-set-handle PQclear
+    0 0 f roll {
+        set-statement-n set-statement-max set-statement-handle
+    } set-slots ;
 
 M: postgresql-statement prepare-statement ( statement -- )
     [
@@ -76,12 +85,6 @@ M: postgresql-db <simple-statement> ( sql -- statement )
     { set-statement-sql } statement construct
     <postgresql-statement> ;
 
-M: postgresql-db <bound-statement> ( sql array -- statement )
-    { set-statement-sql set-statement-params } statement construct
-    <postgresql-statement> ;
-
 M: postgresql-db <prepared-statement> ( sql -- statement )
-    ;
+    { set-statement-sql } statement construct
-
+    <postgresql-statement> ;
-M: postgresql-db <prepared-bound-statement> ( sql seq -- statement )
-    ;

extra/db/sqlite/sqlite-tests.factor

@@ -26,20 +26,27 @@ IN: temporary
         { "John" "America" }
         { "Jane" "New Zealand" }
     }
-] [ test.db [ "select * from person" do-simple-query ] with-sqlite ] unit-test
+] [
+    "extra/db/sqlite/test.db" resource-path [
+        "select * from person" sql-query
+    ] with-sqlite
+] unit-test
 
 [
     { { "John" "America" } }
 ] [
-    test.db [
+    "extra/db/sqlite/test.db" resource-path [
         "select * from person where name = :name and country = :country"
-        { { ":name" "Jane" } { ":country" "New Zealand" } }
+        <simple-statement> [
-        <bound-statement> dup [ sql-row ] query-map
+            { { ":name" "Jane" } { ":country" "New Zealand" } }
+            over do-bound-query
 
-        { { "Jane" "New Zealand" } } = [ "test fails" throw ] unless
+            { { "Jane" "New Zealand" } } =
-        { { ":name" "John" } { ":country" "America" } } over bind-statement
+            [ "test fails" throw ] unless
 
-        dup [ sql-row ] query-map swap dispose
+            { { ":name" "John" } { ":country" "America" } }
+            swap do-bound-query
+        ] with-disposal
     ] with-sqlite
 ] unit-test
 
@@ -48,13 +55,13 @@ IN: temporary
         { "1" "John" "America" }
         { "2" "Jane" "New Zealand" }
     }
-] [ test.db [ "select rowid, * from person" do-simple-query ] with-sqlite ] unit-test
+] [ test.db [ "select rowid, * from person" sql-query ] with-sqlite ] unit-test
 
 [
 ] [
     "extra/db/sqlite/test.db" resource-path [
         "insert into person(name, country) values('Jimmy', 'Canada')"
-        do-simple-command
+        sql-command
     ] with-sqlite
 ] unit-test
 
@@ -64,13 +71,13 @@ IN: temporary
         { "2" "Jane" "New Zealand" }
         { "3" "Jimmy" "Canada" }
     }
-] [ test.db [ "select rowid, * from person" do-simple-query ] with-sqlite ] unit-test
+] [ test.db [ "select rowid, * from person" sql-query ] with-sqlite ] unit-test
 
 [
     "extra/db/sqlite/test.db" resource-path [
         [
-            "insert into person(name, country) values('Jose', 'Mexico')" do-simple-command
+            "insert into person(name, country) values('Jose', 'Mexico')" sql-command
-            "insert into person(name, country) values('Jose', 'Mexico')" do-simple-command
+            "insert into person(name, country) values('Jose', 'Mexico')" sql-command
             "oops" throw
         ] with-transaction
     ] with-sqlite
@@ -78,7 +85,7 @@ IN: temporary
 
 [ 3 ] [
     "extra/db/sqlite/test.db" resource-path [
-        "select * from person" do-simple-query length
+        "select * from person" sql-query length
     ] with-sqlite
 ] unit-test
 
@@ -86,14 +93,16 @@ IN: temporary
 ] [
     "extra/db/sqlite/test.db" resource-path [
         [
-            "insert into person(name, country) values('Jose', 'Mexico')" do-simple-command
+            "insert into person(name, country) values('Jose', 'Mexico')"
-            "insert into person(name, country) values('Jose', 'Mexico')" do-simple-command
+            sql-command
+            "insert into person(name, country) values('Jose', 'Mexico')"
+            sql-command
         ] with-transaction
     ] with-sqlite
 ] unit-test
 
 [ 5 ] [
     "extra/db/sqlite/test.db" resource-path [
-        "select * from person" do-simple-query length
+        "select * from person" sql-query length
     ] with-sqlite
 ] unit-test

extra/db/sqlite/sqlite.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2005, 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays assocs classes compiler db db.sql hashtables
+USING: alien arrays assocs classes compiler db db.sql
-io.files kernel math math.parser namespaces prettyprint sequences
+hashtables io.files kernel math math.parser namespaces
-strings sqlite.lib tuples alien.c-types continuations
+prettyprint sequences strings tuples alien.c-types
-db.sqlite.lib db.sqlite.ffi ;
+continuations db.sqlite.lib db.sqlite.ffi ;
 IN: db.sqlite
 
 TUPLE: sqlite-db path ;
@@ -24,47 +24,52 @@ M: sqlite-db dispose ( obj -- )
 TUPLE: sqlite-statement ;
 C: <sqlite-statement> sqlite-statement
 
+TUPLE: sqlite-result-set ;
+: <sqlite-result-set> ( query -- sqlite-result-set )
+    dup statement-handle sqlite-result-set <result-set> ;
+
 M: sqlite-db <simple-statement> ( str -- obj )
     <prepared-statement> ;
 
-M: sqlite-db <bound-statement> ( str -- obj )
-    <prepared-bound-statement> ;
-
 M: sqlite-db <prepared-statement> ( str -- obj )
     db get db-handle over sqlite-prepare
     { set-statement-sql set-statement-handle } statement construct
     <sqlite-statement> [ set-delegate ] keep ;
 
-M: sqlite-db <prepared-bound-statement> ( str assoc -- obj )
-    swap <prepared-statement> tuck bind-statement ;
-
 M: sqlite-statement dispose ( statement -- )
     statement-handle sqlite-finalize ;
 
+M: sqlite-result-set dispose ( result-set -- )
+    f swap set-result-set-handle ;
+
 M: sqlite-statement bind-statement* ( assoc statement -- )
     statement-handle swap sqlite-bind-assoc ;
 
 M: sqlite-statement rebind-statement ( assoc statement -- )
-    dup reset-statement
+    dup statement-handle sqlite-reset
     statement-handle swap sqlite-bind-assoc ;
 
-M: sqlite-statement #columns ( statement -- n )
+M: sqlite-statement execute-statement ( statement -- )
-    statement-handle sqlite-#columns ;
+    statement-handle sqlite-next drop ;
 
-M: sqlite-statement row-column ( statement n -- obj )
+M: sqlite-result-set #columns ( result-set -- n )
-    >r statement-handle r> sqlite-column ;
+    result-set-handle sqlite-#columns ;
 
-M: sqlite-statement advance-row ( statement -- ? )
+M: sqlite-result-set row-column ( result-set n -- obj )
-    statement-handle sqlite-next ;
+    >r result-set-handle r> sqlite-column ;
+
+M: sqlite-result-set advance-row ( result-set -- handle ? )
+    result-set-handle sqlite-next ;
+
+M: sqlite-statement query-results ( query -- result-set )
+    dup statement-handle sqlite-result-set <result-set> ;
 
-M: sqlite-statement reset-statement ( statement -- )
-    statement-handle sqlite-reset ;
 
 M: sqlite-db begin-transaction ( -- )
-    "BEGIN" do-simple-command ;
+    "BEGIN" sql-command ;
 
 M: sqlite-db commit-transaction ( -- )
-    "COMMIT" do-simple-command ;
+    "COMMIT" sql-command ;
 
 M: sqlite-db rollback-transaction ( -- )
-    "ROLLBACK" do-simple-command ;
+    "ROLLBACK" sql-command ;