make-db is gone, use <sqlite-db> or <postgresql-db> instead. docs. use dip instead of >r r>

basis/db/db-docs.factor

@@ -9,23 +9,15 @@ HELP: db
 
 HELP: new-db
 { $values { "class" class } { "obj" object } }
-{ $description "Creates a new database object from a given class." } ;
+{ $description "Creates a new database object from a given class with caches for prepared statements. Does not actually connect to the database until " { $link db-open } " or " { $link with-db } " is called." } ;
-
-HELP: make-db*
-{ $values { "object" object } { "db" object } { "db" object } }
-{ $description "Takes a sequence of parameters specific to each database and a class name of the database, and constructs a new database object." } ;
-
-HELP: make-db
-{ $values { "object" object } { "class" class } { "db" db } }
-{ $description "Takes a sequence of parameters specific to each database and a class name of the database, and constructs a new database object." } ;
 
 HELP: db-open
 { $values { "db" db } { "db" db } }
-{ $description "Opens a database using the configuration data stored in a " { $link db } " tuple." } ;
+{ $description "Opens a database using the configuration data stored in a " { $link db } " tuple. The database object now references a database handle that must be cleaned up. Therefore, it is better to use the " { $link with-db } " combinator than calling this word directly." } ;
 
 HELP: db-close
 { $values { "handle" alien } }
-{ $description "Closes a database using the handle provided." } ;
+{ $description "Closes a database using the handle provided. Use of the " { $link with-db } " combinator is preferred over manually opening and closing databases so that resources are not leaked." } ;
 
 HELP: dispose-statements
 { $values { "assoc" assoc } }
@@ -38,30 +30,18 @@ HELP: db-dispose
 HELP: statement
 { $description "A " { $snippet "statement" } " stores the information about a statemen, such as the SQL statement text, the in/out parameters, and type information." } ;
 
-HELP: simple-statement
-{ $description } ;
-
-HELP: prepared-statement
-{ $description } ;
-
 HELP: result-set
 { $description "An object encapsulating a raw SQL result object. There are two ways in which a result set can be accessed, but they are specific to the database backend in use."
     { $subsection "db-random-access-result-set" }
     { $subsection "db-sequential-result-set" }
 } ;
 
-HELP: init-result-set
-{ $values
-     { "result-set" result-set } }
-{ $description "" } ;
-
 HELP: new-result-set
 { $values
      { "query" "a query" } { "handle" alien } { "class" class }
      { "result-set" result-set } }
 { $description "Creates a new " { $link result-set } " object of type " { $snippet "class" } "." } ;
 
-
 HELP: new-statement
 { $values { "sql" string } { "in" sequence } { "out" sequence } { "class" class } { "statement" statement } }
 { $description "Makes a new statement object from the given parameters." } ;
@@ -80,18 +60,6 @@ HELP: prepare-statement
 { $values { "statement" statement } }
 { $description "For databases which implement a method on this generic, it does some internal processing to ready the statement for execution." } ;
 
-HELP: bind-statement*
-{ $values { "statement" statement } }
-{ $description "" } ;
-
-HELP: low-level-bind
-{ $values { "statement" statement } }
-{ $description "" } ;
-
-HELP: bind-tuple
-{ $values { "tuple" tuple } { "statement" statement } }
-{ $description "" } ;
-
 HELP: query-results
 { $values { "query" object }
     { "result-set" result-set }
@@ -125,41 +93,14 @@ HELP: more-rows?
 { $values { "result-set" result-set } { "?" "a boolean" } }
 { $description "Returns true if the " { $link result-set } " has more rows to traverse." } ;
 
-HELP: execute-statement*
-{ $values { "statement" statement } { "type" object } }
-{ $description } ;
-
-HELP: execute-one-statement
-{ $values
-     { "statement" null } }
-{ $description "" } ;
-
-HELP: execute-statement
-{ $values { "statement" statement } }
-{ $description "" } ;
-
-
-
-
 
 
 HELP: begin-transaction
 { $description "Begins a new transaction. User code should make use of the " { $link with-transaction } " combinator." } ;
 
-HELP: bind-statement
-{ $values
-     { "obj" object } { "statement" null } }
-{ $description "" } ;
-
 HELP: commit-transaction
 { $description "Commits a transaction. User code should make use of the " { $link with-transaction } " combinator." } ;
 
-HELP: default-query
-{ $values
-     { "query" null }
-     { "result-set" null } }
-{ $description "" } ;
-
 HELP: in-transaction
 { $description "A variable that is set true when a transaction is in progress." } ;
 
@@ -170,14 +111,14 @@ HELP: in-transaction?
 
 HELP: query-each
 { $values
-     { "statement" null } { "quot" quotation } }
+     { "statement" statement } { "quot" quotation } }
-{ $description "" } ;
+{ $description "A combinator that calls a quotation on a sequence of SQL statments to their results query results." } ;
 
 HELP: query-map
 { $values
-     { "statement" null } { "quot" quotation }
+     { "statement" statement } { "quot" quotation }
      { "seq" sequence } }
-{ $description "" } ;
+{ $description "A combinator that maps a sequence of SQL statments to their results query results." } ;
 
 HELP: rollback-transaction
 { $description "Rolls back a transaction; no data is committed to the database. User code should make use of the " { $link with-transaction } " combinator." } ;
@@ -211,7 +152,7 @@ HELP: sql-row-typed
 
 HELP: with-db
 { $values
-     { "seq" sequence } { "class" class } { "quot" quotation } }
+     { "db" db } { "quot" quotation } }
 { $description "Calls the quotation with a database bound to the " { $link db } " symbol. The database called is based on the " { $snippet "class" } " with the " } ;
 
 HELP: with-transaction
@@ -272,26 +213,44 @@ $nl
 { $subsection row-column-typed } ;
 
 ARTICLE: "db-protocol" "Low-level database protocol"
-"The high-level protocol (see " { $vocab-link "db.tuples" } ") uses this low-level protocol for executing statements and queries."
+"The high-level protocol (see " { $vocab-link "db.tuples" } ") uses this low-level protocol for executing statements and queries." $nl
-;
+"Opening a database:"
+{ $subsection db-open }
+"Closing a database:"
+{ $subsection db-close }
+
+"Performing a query:"
+{ $subsection query-results }
+
+"Handling query results:"
+{ $subsection "db-result-sets" }
+
+ ;
 
 ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial"
 "Although Factor makes integrating a database with its object system easy (see " { $vocab-link "db.tuples" } "), sometimes you may want to write SQL directly and get the results back as arrays of strings, for instance, when interfacing with a legacy database that doesn't easily map to " { $snippet "tuples" } "."
 ;
 
 ARTICLE: "db-porting-the-library" "Porting the database library"
-"This section is not yet written."
+"There are two layers to implement when porting the database library."
+{ $subsection "db-protocol" }
 ;
 
 ARTICLE: "db-custom-database-combinators" "Custom database combinators"
 "Every database library requires some effort on the programmer's part to initialize and open a database. SQLite uses files on your harddisk, so a simple pathname is all the setup required. With PostgreSQL, you log in to a networked server as a user on a specfic port." $nl
 
-"Make a " { $snippet "with-" } " word to open, close, and use your database."
+"Make a " { $snippet "with-" } " combinator to open and close a database so that resources are not leaked."
 { $code <"
 USING: db.sqlite db io.files ;
-: with-my-database ( quot -- )
+: with-sqlite-db ( quot -- )
-    { "my-database.db" temp-file } sqlite-db rot with-db ;
+    "my-database.db" temp-file sqlite-db rot with-db ;"> } 
-"> }
+
+{ $code <"
+USING: db.postgresql db ;
+: with-postgresql-db ( quot -- )
+    { "localhost" "db-username" "db-password" "db-name" }
+    postgresql-db rot with-db ;">
+}
 
 ;
 

basis/db/db.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes continuations destructors kernel math
 namespaces sequences classes.tuple words strings
-tools.walker accessors combinators ;
+tools.walker accessors combinators fry ;
 IN: db
 
 TUPLE: db
@@ -17,10 +17,6 @@ TUPLE: db
         H{ } clone >>update-statements
         H{ } clone >>delete-statements ; inline
 
-GENERIC: make-db* ( object db -- db )
-
-: make-db ( object class -- db ) new-db make-db* ;
-
 GENERIC: db-open ( db -- db )
 HOOK: db-close db ( handle -- )
 
@@ -111,10 +107,9 @@ M: object execute-statement* ( statement type -- )
 : query-map ( statement quot -- seq )
     accumulator [ query-each ] dip { } like ; inline
 
-: with-db ( seq class quot -- )
+: with-db ( db quot -- )
-    [ make-db db-open db ] dip
+    [ db-open db ] dip
-    [ db get swap [ drop ] prepose with-disposal ] curry with-variable ;
+    '[ db get [ drop @ ] with-disposal ] with-variable ; inline
-    inline
 
 : default-query ( query -- result-set )
     query-results [ [ sql-row ] query-map ] with-disposal ;

basis/db/pools/pools.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel arrays namespaces sequences continuations
-io.pools db ;
+io.pools db fry ;
 IN: db.pools
 
-TUPLE: db-pool < pool db params ;
+TUPLE: db-pool < pool db ;
 
 : <db-pool> ( params db -- pool )
     db-pool <pool>
@@ -15,7 +15,7 @@ TUPLE: db-pool < pool db params ;
     >r <db-pool> r> with-pool ; inline
 
 M: db-pool make-connection ( pool -- )
-    [ params>> ] [ db>> ] bi make-db db-open ;
+    db>> db-open ;
 
 : with-pooled-db ( pool quot -- )
-    [ db swap with-variable ] curry with-pooled-connection ; inline
+    '[ db _ with-variable ] with-pooled-connection ; inline

basis/db/postgresql/postgresql.factor

@@ -10,28 +10,24 @@ USE: tools.walker
 IN: db.postgresql
 
 TUPLE: postgresql-db < db
-    host port pgopts pgtty db user pass ;
+    host port pgopts pgtty database username password ;
+
+: <postgresql-db> ( -- postgresql-db )
+    postgresql-db new-db ;
 
 TUPLE: postgresql-statement < statement ;
 
 TUPLE: postgresql-result-set < result-set ;
 
-M: postgresql-db make-db* ( seq db -- db )
-    >r first4 r>
-        swap >>db
-        swap >>pass
-        swap >>user
-        swap >>host ;
-
 M: postgresql-db db-open ( db -- db )
     dup {
         [ host>> ]
         [ port>> ]
         [ pgopts>> ]
         [ pgtty>> ]
-        [ db>> ]
+        [ database>> ]
-        [ user>> ]
+        [ username>> ]
-        [ pass>> ]
+        [ password>> ]
     } cleave connect-postgres >>handle ;
 
 M: postgresql-db dispose ( db -- )
@@ -102,7 +98,7 @@ M: postgresql-result-set dispose ( result-set -- )
 
 M: postgresql-statement prepare-statement ( statement -- )
     dup
-    >r db get handle>> f r>
+    [ db get handle>> f ] dip
     [ sql>> ] [ in-params>> ] bi
     length f PQprepare postgresql-error
     >>handle drop ;
@@ -121,7 +117,8 @@ M: postgresql-db bind% ( spec -- )
     bind-name% 1, ;
 
 M: postgresql-db bind# ( spec object -- )
-    >r bind-name% f swap type>> r> <literal-bind> 1, ;
+    [ bind-name% f swap type>> ] dip
+    <literal-bind> 1, ;
 
 : create-table-sql ( class -- statement )
     [
@@ -143,7 +140,7 @@ M: postgresql-db bind# ( spec object -- )
 
 : create-function-sql ( class -- statement )
     [
-        >r remove-id r>
+        [ remove-id ] dip
         "create function add_" 0% dup 0%
         "(" 0%
         over [ "," 0% ]

basis/db/sqlite/sqlite.factor

@@ -11,7 +11,8 @@ IN: db.sqlite
 
 TUPLE: sqlite-db < db path ;
 
-M: sqlite-db make-db* ( path db -- db )
+: <sqlite-db> ( path -- sqlite-db )
+    sqlite-db new-db
         swap >>path ;
 
 M: sqlite-db db-open ( db -- db )
@@ -78,7 +79,8 @@ M: generator-bind sqlite-bind-conversion ( tuple generate-bind -- array )
     tuck
     [ generator-singleton>> eval-generator tuck ] [ slot-name>> ] bi
     rot set-slot-named
-    >r [ key>> ] [ type>> ] bi r> swap <sqlite-low-level-binding> ;
+    [ [ key>> ] [ type>> ] bi ] dip
+    swap <sqlite-low-level-binding> ;
 
 M: sqlite-statement bind-tuple ( tuple statement -- )
     [
@@ -100,7 +102,7 @@ M: sqlite-result-set row-column ( result-set n -- obj )
 
 M: sqlite-result-set row-column-typed ( result-set n -- obj )
     dup pick out-params>> nth type>>
-    >r >r handle>> r> r> sqlite-column-typed ;
+    [ handle>> ] 2dip sqlite-column-typed ;
 
 M: sqlite-result-set advance-row ( result-set -- )
     dup handle>> sqlite-next >>has-more? drop ;
@@ -160,10 +162,10 @@ M: sqlite-db <insert-user-assigned-statement> ( tuple -- statement )
     <insert-db-assigned-statement> ;
 
 M: sqlite-db bind# ( spec obj -- )
-    >r
+    [
         [ column-name>> ":" swap next-sql-counter 3append dup 0% ]
         [ type>> ] bi
-    r> <literal-bind> 1, ;
+    ] dip <literal-bind> 1, ;
 
 M: sqlite-db bind% ( spec -- )
     dup 1, column-name>> ":" prepend 0% ;

basis/db/tuples/tuples-tests.factor

@@ -7,16 +7,34 @@ db.postgresql accessors random math.bitwise
 math.ranges strings urls fry db.tuples.private ;
 IN: db.tuples.tests
 
+: sqlite-db ( -- sqlite-db )
+    "tuples-test.db" temp-file <sqlite-db> ;
+
 : test-sqlite ( quot -- )
-    [ ] swap '[
+    '[
-        "tuples-test.db" temp-file sqlite-db _ with-db
+        [ ] [
-    ] unit-test ;
+            "tuples-test.db" temp-file <sqlite-db> _ with-db
+        ] unit-test
+    ] call ; inline
+
+: postgresql-db ( -- postgresql-db )
+    <postgresql-db>
+        "localhost" >>host
+        "postgres" >>username
+        "thepasswordistrust" >>password
+        "factor-test" >>database ;
 
 : test-postgresql ( quot -- )
-    [ ] swap '[
+    '[
-        { "localhost" "postgres" "foob" "factor-test" }
+        [ ] [ postgresql-db _ with-db ] unit-test
-        postgresql-db _ with-db
+    ] call ; inline
-    ] unit-test ;
+
+! These words leak resources, but are useful for interactivel testing 
+: sqlite-test-db ( -- )
+    sqlite-db db-open db set ;
+
+: postgresql-test-db ( -- )
+    postgresql-db db-open db set ;
 
 TUPLE: person the-id the-name the-number the-real
 ts date time blob factor-blob url ;
@@ -639,10 +657,3 @@ compound-foo "COMPOUND_FOO"
 
 [ test-compound-primary-key ] test-sqlite
 [ test-compound-primary-key ] test-postgresql
-
-: sqlite-test-db ( -- )
-    "tuples-test.db" temp-file sqlite-db make-db db-open db set ;
-
-: postgresql-test-db ( -- )
-    { "localhost" "postgres" "foob" "factor-test" } postgresql-db
-    make-db db-open db set ;