fix sqlite

remove reset-statement from db vocab

extra/db/db.factor

@@ -12,9 +12,9 @@ TUPLE: db handle ;
     db construct-boa ;
 
 GENERIC: make-db* ( seq class -- db )
-: make-db ( seq class -- db ) construct-empty make-db* ;
 GENERIC: db-open ( db -- )
 HOOK: db-close db ( handle -- )
+: make-db ( seq class -- db ) construct-empty make-db* ;
 
 : dispose-statements ( seq -- )
     [ dispose drop ] assoc-each ;
@@ -28,6 +28,9 @@ HOOK: db-close db ( handle -- )
     ] with-variable ;
 
 TUPLE: statement handle sql in-params out-params bind-params bound? ;
+TUPLE: simple-statement ;
+TUPLE: prepared-statement ;
+TUPLE: result-set sql params handle n max ;
 : <statement> ( sql in out -- statement )
     {
         set-statement-sql
@@ -35,17 +38,11 @@ TUPLE: statement handle sql in-params out-params bind-params bound? ;
         set-statement-out-params
     } statement construct ;
 
-TUPLE: simple-statement ;
-TUPLE: prepared-statement ;
-
 HOOK: <simple-statement> db ( str in out -- statement )
 HOOK: <prepared-statement> db ( str in out -- statement )
 GENERIC: prepare-statement ( statement -- )
-GENERIC: bind-statement* ( obj statement -- )
-GENERIC: reset-statement ( statement -- )
+GENERIC: bind-statement* ( statement -- )
 GENERIC: bind-tuple ( tuple statement -- )
-
-TUPLE: result-set sql params handle n max ;
 GENERIC: query-results ( query -- result-set )
 GENERIC: #rows ( result-set -- n )
 GENERIC: #columns ( result-set -- n )
@@ -53,6 +50,7 @@ GENERIC# row-column 1 ( result-set n -- obj )
 GENERIC: advance-row ( result-set -- )
 GENERIC: more-rows? ( result-set -- ? )
 
+! must be called from within with-disposal
 : execute-statement ( statement -- )
     dup sequence? [
         [ execute-statement ] each
@@ -61,9 +59,8 @@ GENERIC: more-rows? ( result-set -- ? )
     ] if ;
 
 : bind-statement ( obj statement -- )
-    dup statement-bound? [ dup reset-statement ] when
-    [ bind-statement* ] 2keep
     [ set-statement-bind-params ] keep
+    [ bind-statement* ] keep
     t swap set-statement-bound? ;
 
 : init-result-set ( result-set -- )

extra/db/postgresql/postgresql.factor

@@ -38,10 +38,7 @@ M: postgresql-db db-open ( db -- )
 M: postgresql-db dispose ( db -- )
     db-handle PQfinish ;
 
-M: postgresql-statement bind-statement* ( seq statement -- )
-    set-statement-bind-params ;
-
-M: postgresql-statement reset-statement ( statement -- )
+M: postgresql-statement bind-statement* ( statement -- )
     drop ;
 
 M: postgresql-statement bind-tuple ( tuple statement -- )

extra/db/sqlite/sqlite.factor

@@ -4,7 +4,8 @@ USING: alien arrays assocs classes compiler db
 hashtables io.files kernel math math.parser namespaces
 prettyprint sequences strings tuples alien.c-types
 continuations db.sqlite.lib db.sqlite.ffi db.tuples
-words combinators.lib db.types combinators tools.walker ;
+words combinators.lib db.types combinators tools.walker
+combinators.cleave ;
 IN: db.sqlite
 
 TUPLE: sqlite-db path ;
@@ -29,14 +30,13 @@ M: sqlite-db <simple-statement> ( str -- obj )
     <prepared-statement> ;
 
 M: sqlite-db <prepared-statement> ( str -- obj )
-    db get db-handle 
     {
         set-statement-sql
         set-statement-in-params
         set-statement-out-params
-        set-statement-handle
     } statement construct
-    dup statement-handle over statement-sql sqlite-prepare
+    db get db-handle over statement-sql sqlite-prepare
+    over set-statement-handle
     sqlite-statement construct-delegate ;
 
 M: sqlite-statement dispose ( statement -- )
@@ -45,20 +45,32 @@ M: sqlite-statement dispose ( statement -- )
 M: sqlite-result-set dispose ( result-set -- )
     f swap set-result-set-handle ;
 
-: sqlite-bind ( specs handle -- )
-    swap [ sqlite-bind-type ] with each ;
+: sqlite-bind ( triples handle -- )
+    swap [ first3 sqlite-bind-type ] with each ;
 
-M: sqlite-statement bind-statement* ( obj statement -- )
-    statement-handle sqlite-bind ;
-
-M: sqlite-statement reset-statement ( statement -- )
+: reset-statement ( statement -- )
     statement-handle sqlite-reset ;
 
+M: sqlite-statement bind-statement* ( statement -- )
+    dup statement-bound? [ dup reset-statement ] when
+    [ statement-bind-params ] [ statement-handle ] bi sqlite-bind ;
+
+M: sqlite-statement bind-tuple ( tuple statement -- )
+    [
+        statement-in-params
+        [
+            [ sql-spec-column-name ":" swap append ]
+            [ sql-spec-slot-name rot get-slot-named ]
+            [ sql-spec-type ] tri 3array
+        ] with map
+    ] keep
+    [ set-statement-bind-params ] keep bind-statement* ;
+
 : last-insert-id ( -- id )
     db get db-handle sqlite3_last_insert_rowid
     dup zero? [ "last-id failed" throw ] when ;
 
-M: sqlite-statement insert-tuple* ( tuple statement -- )
+M: sqlite-db insert-tuple* ( tuple statement -- )
     execute-statement last-insert-id swap set-primary-key ;
 
 M: sqlite-result-set #columns ( result-set -- n )
@@ -78,7 +90,6 @@ M: sqlite-result-set more-rows? ( result-set -- ? )
     sqlite-result-set-has-more? ;
 
 M: sqlite-statement query-results ( query -- result-set )
-break
     dup statement-handle sqlite-result-set <result-set>
     dup advance-row ;
 
@@ -127,7 +138,7 @@ M: sqlite-db <insert-assigned-statement> ( tuple -- statement )
 
 : where-primary-key% ( specs -- )
     " where " 0%
-    find-primary-key sql-spec-column-name dup 0% " = " 0% bind% ;
+    find-primary-key dup sql-spec-column-name 0% " = " 0% bind% ;
 
 M: sqlite-db <update-tuple-statement> ( class -- statement )
     [
@@ -135,7 +146,7 @@ M: sqlite-db <update-tuple-statement> ( class -- statement )
         0%
         " set " 0%
         dup remove-id
-        [ ", " 0% ] [ sql-spec-column-name dup 0% " = " 0% bind% ] interleave
+        [ ", " 0% ] [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
         where-primary-key%
     ] sqlite-make ;
 
@@ -144,7 +155,7 @@ M: sqlite-db <delete-tuple-statement> ( specs table -- sql )
         "delete from " 0% 0%
         " where " 0%
         find-primary-key
-        sql-spec-column-name dup 0% " = " 0% bind%
+        dup sql-spec-column-name 0% " = " 0% bind%
     ] sqlite-make ;
 
 ! : select-interval ( interval name -- ) ;
@@ -152,8 +163,6 @@ M: sqlite-db <delete-tuple-statement> ( specs table -- sql )
 
 M: sqlite-db bind% ( spec -- )
     dup 1, sql-spec-column-name ":" swap append 0% ;
-    ! dup 1, sql-spec-column-name
-    ! dup 0% " = " 0% ":" swap append 0% ;
 
 M: sqlite-db <select-by-slots-statement> ( tuple class -- statement )
     [
@@ -201,7 +210,3 @@ M: sqlite-db type-table ( -- assoc )
 
 M: sqlite-db create-type-table
     type-table ;
-
-! HOOK: get-column-value ( n result-set type -- )
-! M: sqlite get-column-value { { "TEXT" get-text-column } { 
-! "INTEGER" get-integer-column } ... } case ;

extra/db/tuples/tuples-tests.factor

@@ -22,8 +22,9 @@ SYMBOL: the-person2
 : test-tuples ( -- )
     [ person drop-table ] [ drop ] recover
     [ ] [ person create-table ] unit-test
+    [ person create-table ] must-fail
     
-    [  ] [ the-person1 get insert-tuple ] unit-test
+    [ ] [ the-person1 get insert-tuple ] unit-test
 
     [ 1 ] [ the-person1 get person-the-id ] unit-test
 
@@ -66,8 +67,8 @@ person "PERSON"
 "billy" 10 3.14 <person> the-person1 set
 "johnny" 10 3.14 <person> the-person2 set
 
-! test-sqlite
-test-postgresql
+test-sqlite
+! test-postgresql
 
 person "PERSON"
 {
@@ -80,8 +81,8 @@ person "PERSON"
 1 "billy" 10 3.14 <assigned-person> the-person1 set
 2 "johnny" 10 3.14 <assigned-person> the-person2 set
 
-! test-sqlite
-test-postgresql
+test-sqlite
+! test-postgresql
 
 TUPLE: paste n summary author channel mode contents timestamp annotations ;
 TUPLE: annotation n paste-id summary author mode contents ;
@@ -108,11 +109,11 @@ annotation "ANNOTATION"
     { "contents" "CONTENTS" TEXT }
 } define-persistent
 
-{ "localhost" "postgres" "" "factor-test" } postgresql-db [
-    [ paste drop-table ] [ drop ] recover
-    [ annotation drop-table ] [ drop ] recover
-    [ paste drop-table ] [ drop ] recover
-    [ annotation drop-table ] [ drop ] recover
-    [ ] [ paste create-table ] unit-test
-    [ ] [ annotation create-table ] unit-test
-] with-db
+! { "localhost" "postgres" "" "factor-test" } postgresql-db [
+    ! [ paste drop-table ] [ drop ] recover
+    ! [ annotation drop-table ] [ drop ] recover
+    ! [ paste drop-table ] [ drop ] recover
+    ! [ annotation drop-table ] [ drop ] recover
+    ! [ ] [ paste create-table ] unit-test
+    ! [ ] [ annotation create-table ] unit-test
+! ] with-db

extra/db/tuples/tuples.factor

@@ -63,16 +63,20 @@ HOOK: insert-tuple* db ( tuple statement -- )
 : sql-props ( class -- columns table )
     dup db-columns swap db-table ;
 
-: create-table ( class -- ) create-sql-statement execute-statement ;
-: drop-table ( class -- ) drop-sql-statement execute-statement ;
+: create-table ( class -- )
+    create-sql-statement [ execute-statement ] with-disposal ;
+: drop-table ( class -- )
+    drop-sql-statement [ execute-statement ] with-disposal ;
 
 : insert-native ( tuple -- )
-    dup class <insert-native-statement>
-    [ bind-tuple ] 2keep insert-tuple* ;
+    dup class <insert-native-statement> [
+        [ bind-tuple ] 2keep dup . insert-tuple*
+    ] with-disposal ;
 
 : insert-assigned ( tuple -- )
-    dup class <insert-assigned-statement>
-    [ bind-tuple ] keep execute-statement ;
+    dup class <insert-assigned-statement> [
+        [ bind-tuple ] keep execute-statement
+    ] with-disposal ;
 
 : insert-tuple ( tuple -- )
     dup class db-columns find-primary-key assigned-id? [
@@ -82,19 +86,21 @@ HOOK: insert-tuple* db ( tuple statement -- )
     ] if ;
 
 : update-tuple ( tuple -- )
-    dup class <update-tuple-statement>
-    [ bind-tuple ] keep execute-statement ;
+    dup class <update-tuple-statement> [
+        [ bind-tuple ] keep execute-statement
+    ] with-disposal ;
 
-: update-tuples ( seq -- )
-    <update-tuples-statement> execute-statement ;
+! : update-tuples ( seq -- )
+    ! <update-tuples-statement> execute-statement ;
 
 : delete-tuple ( tuple -- )
-    dup class <delete-tuple-statement>
-    [ bind-tuple ] keep execute-statement ;
+    dup class <delete-tuple-statement> [
+        [ bind-tuple ] keep execute-statement
+    ] with-disposal ;
 
-: setup-select ( tuple -- statement )
-    dup dup class <select-by-slots-statement>
-    [ bind-tuple ] keep ;
+: select-tuples ( tuple -- tuple )
+    dup dup class <select-by-slots-statement> [
+        [ bind-tuple ] keep query-tuples
+    ] with-disposal ;
 
-: select-tuples ( tuple -- tuple ) setup-select query-tuples ;
 : select-tuple ( tuple -- tuple/f ) select-tuples ?first ;