add a new db-connection tuple for live database connections instead of reusing the db setup tuple

update sqlite and postgresql backends for the change

basis/db/db.factor

@@ -5,24 +5,30 @@ namespaces sequences classes.tuple words strings
 tools.walker accessors combinators fry ;
 IN: db
 
-TUPLE: db
+SYMBOL: db
+
+<PRIVATE
+
+TUPLE: db-connection
     handle
     insert-statements
     update-statements
     delete-statements ;
 
-: new-db ( class -- obj )
+: new-db-connection ( class -- obj )
     new
         H{ } clone >>insert-statements
         H{ } clone >>update-statements
         H{ } clone >>delete-statements ; inline
 
+PRIVATE>
+
 GENERIC: db-open ( db -- db )
 HOOK: db-close db ( handle -- )
 
 : dispose-statements ( assoc -- ) values dispose-each ;
 
-M: db dispose ( db -- ) 
+M: db-connection dispose ( db -- ) 
     dup db [
         [ dispose-statements H{ } clone ] change-insert-statements
         [ dispose-statements H{ } clone ] change-update-statements
@@ -130,9 +136,9 @@ HOOK: begin-transaction db ( -- )
 HOOK: commit-transaction db ( -- )
 HOOK: rollback-transaction db ( -- )
 
-M: db begin-transaction ( -- ) "BEGIN" sql-command ;
+M: db-connection begin-transaction ( -- ) "BEGIN" sql-command ;
-M: db commit-transaction ( -- ) "COMMIT" sql-command ;
+M: db-connection commit-transaction ( -- ) "COMMIT" sql-command ;
-M: db rollback-transaction ( -- ) "ROLLBACK" sql-command ;
+M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ;
 
 : in-transaction? ( -- ? ) in-transaction get ;
 

basis/db/postgresql/postgresql.factor

@@ -4,23 +4,31 @@ USING: arrays assocs alien alien.syntax continuations io
 kernel math math.parser namespaces make prettyprint quotations
 sequences debugger db db.postgresql.lib db.postgresql.ffi
 db.tuples db.types tools.annotations math.ranges
-combinators classes locals words tools.walker
+combinators classes locals words tools.walker db.private
 nmake accessors random db.queries destructors db.tuples.private ;
 USE: tools.walker
 IN: db.postgresql
 
-TUPLE: postgresql-db < db
+TUPLE: postgresql-db host port pgopts pgtty database username password ;
-    host port pgopts pgtty database username password ;
 
 : <postgresql-db> ( -- postgresql-db )
-    postgresql-db new-db ;
+    postgresql-db new ;
+
+<PRIVATE
+
+TUPLE: postgresql-db-connection < db-connection ;
+: <postgresql-db-connection> ( handle -- db-connection )
+    postgresql-db-connection new-db-connection
+        swap >>handle ;
+
+PRIVATE>
 
 TUPLE: postgresql-statement < statement ;
 
 TUPLE: postgresql-result-set < result-set ;
 
-M: postgresql-db db-open ( db -- db )
+M: postgresql-db db-open ( db -- db-connection )
-    dup {
+    {
         [ host>> ]
         [ port>> ]
         [ pgopts>> ]
@@ -28,9 +36,9 @@ M: postgresql-db db-open ( db -- db )
         [ database>> ]
         [ username>> ]
         [ password>> ]
-    } cleave connect-postgres >>handle ;
+    } cleave connect-postgres <postgresql-db-connection> ;
 
-M: postgresql-db db-close ( handle -- )
+M: postgresql-db-connection db-close ( handle -- )
     PQfinish ;
 
 M: postgresql-statement bind-statement* ( statement -- ) drop ;
@@ -103,20 +111,20 @@ M: postgresql-statement prepare-statement ( statement -- )
     length f PQprepare postgresql-error
     >>handle drop ;
 
-M: postgresql-db <simple-statement> ( sql in out -- statement )
+M: postgresql-db-connection <simple-statement> ( sql in out -- statement )
     postgresql-statement new-statement ;
 
-M: postgresql-db <prepared-statement> ( sql in out -- statement )
+M: postgresql-db-connection <prepared-statement> ( sql in out -- statement )
     <simple-statement> dup prepare-statement ;
 
 : bind-name% ( -- )
     CHAR: $ 0,
     sql-counter [ inc ] [ get 0# ] bi ;
 
-M: postgresql-db bind% ( spec -- )
+M: postgresql-db-connection bind% ( spec -- )
     bind-name% 1, ;
 
-M: postgresql-db bind# ( spec object -- )
+M: postgresql-db-connection bind# ( spec object -- )
     [ bind-name% f swap type>> ] dip
     <literal-bind> 1, ;
 
@@ -162,7 +170,7 @@ M: postgresql-db bind# ( spec object -- )
         "_seq'');' language sql;" 0%
     ] query-make ;
 
-M: postgresql-db create-sql-statement ( class -- seq )
+M: postgresql-db-connection create-sql-statement ( class -- seq )
     [
         [ create-table-sql , ] keep
         dup db-assigned? [ create-function-sql , ] [ drop ] if
@@ -182,13 +190,13 @@ M: postgresql-db create-sql-statement ( class -- seq )
         "drop table " 0% 0% drop
     ] query-make ;
 
-M: postgresql-db drop-sql-statement ( class -- seq )
+M: postgresql-db-connection drop-sql-statement ( class -- seq )
     [
         [ drop-table-sql , ] keep
         dup db-assigned? [ drop-function-sql , ] [ drop ] if
     ] { } make ;
 
-M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
+M: postgresql-db-connection <insert-db-assigned-statement> ( class -- statement )
     [
         "select add_" 0% 0%
         "(" 0%
@@ -198,7 +206,7 @@ M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
         ");" 0%
     ] query-make ;
 
-M: postgresql-db <insert-user-assigned-statement> ( class -- statement )
+M: postgresql-db-connection <insert-user-assigned-statement> ( class -- statement )
     [
         "insert into " 0% 0%
         "(" 0%
@@ -221,10 +229,10 @@ M: postgresql-db <insert-user-assigned-statement> ( class -- statement )
         ");" 0%
     ] query-make ;
 
-M: postgresql-db insert-tuple-set-key ( tuple statement -- )
+M: postgresql-db-connection insert-tuple-set-key ( tuple statement -- )
     query-modify-tuple ;
 
-M: postgresql-db persistent-table ( -- hashtable )
+M: postgresql-db-connection persistent-table ( -- hashtable )
     H{
         { +db-assigned-id+ { "integer" "serial" f } }
         { +user-assigned-id+ { f f f } }
@@ -264,7 +272,7 @@ M: postgresql-db persistent-table ( -- hashtable )
     } ;
 
 ERROR: no-compound-found string object ;
-M: postgresql-db compound ( string object -- string' )
+M: postgresql-db-connection compound ( string object -- string' )
     over {
         { "default" [ first number>string " " glue ] }
         { "varchar" [ first number>string "(" ")" surround append ] }

basis/db/queries/queries.factor

@@ -3,7 +3,8 @@
 USING: accessors kernel math namespaces make sequences random
 strings math.parser math.intervals combinators math.bitwise
 nmake db db.tuples db.types classes words shuffle arrays
-destructors continuations db.tuples.private prettyprint ;
+destructors continuations db.tuples.private prettyprint
+db.private ;
 IN: db.queries
 
 GENERIC: where ( specs obj -- )
@@ -62,7 +63,7 @@ M: retryable execute-statement* ( statement type -- )
         dup column-name>> 0% " = " 0% bind%
     ] interleave ;
 
-M: db <update-tuple-statement> ( class -- statement )
+M: db-connection <update-tuple-statement> ( class -- statement )
     [
         "update " 0% 0%
         " set " 0%
@@ -142,7 +143,7 @@ M: string where ( spec obj -- ) object-where ;
 : where-clause ( tuple specs -- )
     dupd filter-slots [ drop ] [ many-where ] if-empty ;
 
-M: db <delete-tuples-statement> ( tuple table -- sql )
+M: db-connection <delete-tuples-statement> ( tuple table -- sql )
     [
         "delete from " 0% 0%
         where-clause
@@ -150,7 +151,7 @@ M: db <delete-tuples-statement> ( tuple table -- sql )
 
 ERROR: all-slots-ignored class ;
 
-M: db <select-by-slots-statement> ( tuple class -- statement )
+M: db-connection <select-by-slots-statement> ( tuple class -- statement )
     [
         "select " 0%
         [ dupd filter-ignores ] dip
@@ -185,13 +186,13 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
         [ offset>> [ do-offset ] [ drop ] if* ]
     } 2cleave ;
 
-M: db query>statement ( query -- tuple )
+M: db-connection query>statement ( query -- tuple )
     [ tuple>> dup class ] keep
     [ <select-by-slots-statement> ] dip make-query* ;
 
 ! select ID, NAME, SCORE from EXAM limit 1 offset 3
 
-M: db <count-statement> ( query -- statement )
+M: db-connection <count-statement> ( query -- statement )
     [ tuple>> dup class ] keep
     [ [ "select count(*) from " 0% 0% where-clause ] query-make ]
     dip make-query* ;

basis/db/sqlite/lib/lib.factor

@@ -5,7 +5,7 @@ namespaces sequences db.sqlite.ffi db combinators
 continuations db.types calendar.format serialize
 io.streams.byte-array byte-arrays io.encodings.binary
 io.backend db.errors present urls io.encodings.utf8
-io.encodings.string accessors shuffle ;
+io.encodings.string accessors shuffle io prettyprint ;
 IN: db.sqlite.lib
 
 ERROR: sqlite-error < db-error n string ;
@@ -124,7 +124,8 @@ ERROR: sqlite-sql-error < sql-error n string ;
     ] if* (sqlite-bind-type) ;
 
 : sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ;
-: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ;
+: sqlite-reset ( handle -- )
+"resetting: " write dup . sqlite3_reset sqlite-check-result ;
 : sqlite-clear-bindings ( handle -- )
     sqlite3_clear_bindings sqlite-check-result ;
 : sqlite-#columns ( query -- int ) sqlite3_column_count ;

basis/db/sqlite/sqlite-tests.factor

@@ -3,8 +3,8 @@ kernel namespaces prettyprint tools.test db.sqlite db sequences
 continuations db.types db.tuples unicode.case ;
 IN: db.sqlite.tests
 
-: db-path "test.db" temp-file ;
+: db-path ( -- path ) "test.db" temp-file ;
-: test.db db-path <sqlite-db> ;
+: test.db ( -- sqlite-db ) db-path <sqlite-db> ;
 
 [ ] [ [ db-path delete-file ] ignore-errors ] unit-test
 

basis/db/sqlite/sqlite.factor

@@ -6,28 +6,38 @@ sequences strings classes.tuple alien.c-types continuations
 db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators
 math.intervals io nmake accessors vectors math.ranges random
 math.bitwise db.queries destructors db.tuples.private interpolate
-io.streams.string multiline make ;
+io.streams.string multiline make db.private ;
 IN: db.sqlite
 
-TUPLE: sqlite-db < db path ;
+TUPLE: sqlite-db path ;
 
 : <sqlite-db> ( path -- sqlite-db )
-    sqlite-db new-db
+    sqlite-db new
         swap >>path ;
 
-M: sqlite-db db-open ( db -- db )
+<PRIVATE
-    dup path>> sqlite-open >>handle ;
 
-M: sqlite-db db-close ( handle -- ) sqlite-close ;
+TUPLE: sqlite-db-connection < db-connection ;
+
+: <sqlite-db-connection> ( handle -- db-connection )
+    sqlite-db-connection new-db-connection
+        swap >>handle ;
+
+PRIVATE>
+
+M: sqlite-db db-open ( db -- db-connection )
+    path>> sqlite-open <sqlite-db-connection> ;
+
+M: sqlite-db-connection db-close ( handle -- ) sqlite-close ;
 
 TUPLE: sqlite-statement < statement ;
 
 TUPLE: sqlite-result-set < result-set has-more? ;
 
-M: sqlite-db <simple-statement> ( str in out -- obj )
+M: sqlite-db-connection <simple-statement> ( str in out -- obj )
     <prepared-statement> ;
 
-M: sqlite-db <prepared-statement> ( str in out -- obj )
+M: sqlite-db-connection <prepared-statement> ( str in out -- obj )
     sqlite-statement new-statement ;
 
 : sqlite-maybe-prepare ( statement -- statement )
@@ -92,7 +102,7 @@ ERROR: sqlite-last-id-fail ;
     db get handle>> sqlite3_last_insert_rowid
     dup zero? [ sqlite-last-id-fail ] when ;
 
-M: sqlite-db insert-tuple-set-key ( tuple statement -- )
+M: sqlite-db-connection insert-tuple-set-key ( tuple statement -- )
     execute-statement last-insert-id swap set-primary-key ;
 
 M: sqlite-result-set #columns ( result-set -- n )
@@ -116,7 +126,7 @@ M: sqlite-statement query-results ( query -- result-set )
     dup handle>> sqlite-result-set new-result-set
     dup advance-row ;
 
-M: sqlite-db create-sql-statement ( class -- statement )
+M: sqlite-db-connection create-sql-statement ( class -- statement )
     [
         dupd
         "create table " 0% 0%
@@ -135,10 +145,10 @@ M: sqlite-db create-sql-statement ( class -- statement )
         "));" 0%
     ] query-make ;
 
-M: sqlite-db drop-sql-statement ( class -- statement )
+M: sqlite-db-connection drop-sql-statement ( class -- statement )
     [ "drop table " 0% 0% ";" 0% drop ] query-make ;
 
-M: sqlite-db <insert-db-assigned-statement> ( tuple -- statement )
+M: sqlite-db-connection <insert-db-assigned-statement> ( tuple -- statement )
     [
         "insert into " 0% 0%
         "(" 0%
@@ -159,19 +169,19 @@ M: sqlite-db <insert-db-assigned-statement> ( tuple -- statement )
         ");" 0%
     ] query-make ;
 
-M: sqlite-db <insert-user-assigned-statement> ( tuple -- statement )
+M: sqlite-db-connection <insert-user-assigned-statement> ( tuple -- statement )
     <insert-db-assigned-statement> ;
 
-M: sqlite-db bind# ( spec obj -- )
+M: sqlite-db-connection bind# ( spec obj -- )
     [
         [ column-name>> ":" next-sql-counter surround dup 0% ]
         [ type>> ] bi
     ] dip <literal-bind> 1, ;
 
-M: sqlite-db bind% ( spec -- )
+M: sqlite-db-connection bind% ( spec -- )
     dup 1, column-name>> ":" prepend 0% ;
 
-M: sqlite-db persistent-table ( -- assoc )
+M: sqlite-db-connection persistent-table ( -- assoc )
     H{
         { +db-assigned-id+ { "integer" "integer" f } }
         { +user-assigned-id+ { f f f } }
@@ -306,7 +316,7 @@ M: sqlite-db persistent-table ( -- assoc )
         delete-trigger-restrict sqlite-trigger,
     ] if ;
 
-M: sqlite-db compound ( string seq -- new-string )
+M: sqlite-db-connection compound ( string seq -- new-string )
     over {
         { "default" [ first number>string " " glue ] }
         { "references" [