Merge branch 'master' of git://factorcode.org/git/factor

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 statements 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 statements 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,52 @@ $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 }
+"Creating tatements:"
+{ $subsection <simple-statement> }
+{ $subsection <prepared-statement> }
+"Using statements with the database:"
+{ $subsection prepare-statement }
+{ $subsection bind-statement* }
+{ $subsection low-level-bind }
+"Performing a query:"
+{ $subsection query-results }
+"Handling query results:"
+{ $subsection "db-result-sets" }
 ;
+! { $subsection bind-tuple }
 
 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 -- )
+    <postgresql-db>
+        "localhost" >>host
+        "erg" >>username
+        "secrets?" >>password
+        "factor-test" >>database
+    swap 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,21 +1,20 @@
 ! 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> ( db -- pool )
     db-pool <pool>
-        swap >>db
+        swap >>db ;
-        swap >>params ;
 
-: with-db-pool ( db params quot -- )
+: with-db-pool ( db quot -- )
-    >r <db-pool> r> with-pool ; inline
+    [ <db-pool> ] dip 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/queries/queries.factor

@@ -145,10 +145,13 @@ M: db <delete-tuples-statement> ( tuple table -- sql )
         where-clause
     ] query-make ;
 
+ERROR: all-slots-ignored class ;
+
 M: db <select-by-slots-statement> ( tuple class -- statement )
     [
         "select " 0%
         [ dupd filter-ignores ] dip
+        over empty? [ all-slots-ignored ] when
         over
         [ ", " 0% ]
         [ dup column-name>> 0% 2, ] interleave

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-docs.factor

@@ -190,7 +190,7 @@ T{ book
 { $list
     "Make a new tuple to represent your data"
     { "Map the Factor types to the database types with " { $link define-persistent } }
-    { "Make a " { $link "db-custom-database-combinators" } " to open your database and run a " { $snippet "quotation" } }
+    { "Make a custom database combinator (see" { $link "db-custom-database-combinators" } ") to open your database and run a " { $link quotation } }
     { "Create a table with " { $link create-table } ", " { $link ensure-table } ", or " { $link recreate-table } }
     { "Start making and storing objects with " { $link insert-tuple } ", " { $link update-tuple } ", " { $link delete-tuples } ", and " { $link select-tuples } }
 } ;

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 ;
@@ -356,9 +374,7 @@ TUPLE: exam id name score ;
     [ f ]
     [ T{ exam { name IGNORE } { score IGNORE } } select-tuples first score>> ] unit-test
 
-    ! FIXME
+    [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] [ class>> "EXAM" = ] must-fail-with
-    ! [ f ]
-    ! [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] unit-test
 
     [
         {
@@ -641,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 ;

basis/db/types/types-docs.factor

@@ -53,7 +53,7 @@ HELP: BIG-INTEGER
 { $description "A 64-bit integer. Whether this number is signed or unsigned depends on the database backend." } ;
 
 HELP: BLOB
-{ $description "A serialized Factor object.  The database library automatically serializes the object for a SQL insert or update and deserializes it on a tuple query." } ;
+{ $description "A byte array." } ;
 
 HELP: BOOLEAN
 { $description "Either true or false." } ;
@@ -65,7 +65,7 @@ HELP: DATETIME
 { $description "A date and a time." } ;
 
 HELP: DOUBLE
-{ $description "Corresponds to Factor's 64bit floating-point numbers." } ;
+{ $description "Corresponds to Factor's 64-bit floating-point numbers." } ;
 
 HELP: FACTOR-BLOB
 { $description "A serialized Factor object." } ;
@@ -77,16 +77,16 @@ HELP: NULL
 { $description "The SQL null type." } ;
 
 HELP: REAL
-{ $description "" } ;
+{ $description "A real number of unlimited precision. May not be supported on all databases." } ;
 
 HELP: SIGNED-BIG-INTEGER
 { $description "For portability, if a number is known to be 64bit and signed, then this datatype may be used. Some databases, like SQLite, cannot store arbitrary bignums as BIGINT types. If storing arbitrary bignums, use " { $link FACTOR-BLOB } "." } ;
 
 HELP: TEXT
-{ $description "" } ;
+{ $description "Stores a string that is longer than a " { $link VARCHAR } ". SQLite uses this type for strings; it does not handle " { $link VARCHAR } " strings." } ;
 
 HELP: TIME
-{ $description "" } ;
+{ $description "A timestamp without a date component." } ;
 
 HELP: TIMESTAMP
 { $description "A Factor timestamp." } ;
@@ -100,7 +100,8 @@ HELP: URL
 { $description "A Factor " { $link "urls" } " object." } ;
 
 HELP: VARCHAR
-{ $description "The SQL varchar type.  This type can take an integer as an argument." } ;
+{ $description "The SQL varchar type. This type can take an integer as an argument." }
+{ $examples { $unchecked-example "{ VARCHAR 256 }" "" } } ;
 
 HELP: user-assigned-id-spec?
 { $values
@@ -279,8 +280,9 @@ ARTICLE: "db.types" "Database types"
 { $subsection DATETIME }
 { $subsection TIME }
 { $subsection TIMESTAMP }
-"Arbitrary Factor objects:"
+"Factor byte-arrays:"
 { $subsection BLOB }
+"Arbitrary Factor objects:"
 { $subsection FACTOR-BLOB }
 "Factor URLs:"
 { $subsection URL } ;

basis/furnace/alloy/alloy.factor

@@ -17,19 +17,17 @@ IN: furnace.alloy
     state-classes ensure-tables
     user ensure-table ;
 
-: <alloy> ( responder db params -- responder' )
+: <alloy> ( responder db -- responder' )
-    [ [ init-furnace-tables ] with-db ]
+    [ [ init-furnace-tables ] with-db ] keep
-    [
     [
         <asides>
         <conversations>
         <sessions>
-        ] 2dip
+    ] dip
     <db-persistence>
-        <check-form-submissions>
+    <check-form-submissions> ;
-    ] 2bi ;
 
-: start-expiring ( db params -- )
+: start-expiring ( db -- )
     '[
-        _ _ [ state-classes [ expire-state ] each ] with-db
+        _ [ state-classes [ expire-state ] each ] with-db
     ] 5 minutes every drop ;

basis/furnace/auth/providers/db/db-tests.factor

@@ -11,7 +11,7 @@ io.files accessors kernel ;
 
 [ "auth-test.db" temp-file delete-file ] ignore-errors
 
-"auth-test.db" temp-file sqlite-db [
+"auth-test.db" temp-file <sqlite-db> [
 
     user ensure-table
 

basis/furnace/db/db.factor

@@ -6,7 +6,7 @@ IN: furnace.db
 
 TUPLE: db-persistence < filter-responder pool ;
 
-: <db-persistence> ( responder params db -- responder' )
+: <db-persistence> ( responder db -- responder' )
     <db-pool> db-persistence boa ;
 
 M: db-persistence call-responder*

basis/furnace/sessions/sessions-tests.factor

@@ -48,9 +48,9 @@ M: foo call-responder*
     <action>
         [ [ ] "text/plain" <content> exit-with ] >>display ;
 
-[ "auth-test.db" temp-file sqlite-db delete-file ] ignore-errors
+[ "auth-test.db" temp-file delete-file ] ignore-errors
 
-"auth-test.db" temp-file sqlite-db [
+"auth-test.db" temp-file <sqlite-db> [
 
     <request> init-request
     session ensure-table

basis/http/http-tests.factor

@@ -182,7 +182,7 @@ http.server.dispatchers db.tuples ;
         [ stop-this-server "Goodbye" "text/html" <content> ] >>display
     "quit" add-responder ;
 
-: test-db "test.db" temp-file sqlite-db ;
+: test-db "test.db" temp-file <sqlite-db> ;
 
 [ test-db drop delete-file ] ignore-errors
 

extra/webapps/planet/planet.factor

@@ -195,5 +195,5 @@ posting "POSTINGS"
     <boilerplate>
         { planet "planet-common" } >>template ;
 
-: start-update-task ( db params -- )
+: start-update-task ( db -- )
-    '[ _ _ [ update-cached-postings ] with-db ] 10 minutes every drop ;
+    '[ _ [ update-cached-postings ] with-db ] 10 minutes every drop ;

extra/websites/concatenative/concatenative.factor

@@ -26,7 +26,7 @@ webapps.user-admin
 webapps.help ;
 IN: websites.concatenative
 
-: test-db ( -- params db ) "resource:test.db" sqlite-db ;
+: test-db ( -- params db ) "resource:test.db" <sqlite-db> ;
 
 : init-factor-db ( -- )
     test-db [