Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
c0fb69f63b
|
|
@ -0,0 +1,153 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: classes kernel help.markup help.syntax sequences
|
||||
alien assocs strings math multiline ;
|
||||
IN: db
|
||||
|
||||
HELP: db
|
||||
{ $description "The " { $snippet "db" } " class is the superclass of all other database classes. It stores a " { $snippet "handle" } " to the database as well as insert, update, and delete queries." } ;
|
||||
|
||||
HELP: new-db
|
||||
{ $values { "class" class } { "obj" object } }
|
||||
{ $description "Creates a new database object from a given class." } ;
|
||||
|
||||
HELP: make-db*
|
||||
{ $values { "seq" sequence } { "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 { "seq" sequence } { "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." } ;
|
||||
|
||||
HELP: db-close
|
||||
{ $values { "handle" alien } }
|
||||
{ $description "Closes a database using the handle provided." } ;
|
||||
|
||||
HELP: dispose-statements
|
||||
{ $values { "assoc" assoc } }
|
||||
{ $description "Disposes an associative list of statements." } ;
|
||||
|
||||
HELP: db-dispose
|
||||
{ $values { "db" db } }
|
||||
{ $description "Disposes of all the statements stored in the " { $link db } " object." } ;
|
||||
|
||||
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 } ;
|
||||
|
||||
HELP: construct-statement
|
||||
{ $values { "sql" string } { "in" sequence } { "out" sequence } { "class" class } { "statement" statement } }
|
||||
{ $description "Makes a new statement object from the given parameters." } ;
|
||||
|
||||
HELP: <simple-statement>
|
||||
{ $values { "string" string } { "in" sequence } { "out" sequence } }
|
||||
{ $description "Makes a new simple statement object from the given parameters." } ;
|
||||
|
||||
HELP: <prepared-statement>
|
||||
{ $values { "string" string } { "in" sequence } { "out" sequence } }
|
||||
{ $description "Makes a new prepared statement object from the given parameters." } ;
|
||||
|
||||
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 } { "statement" statement } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: #rows
|
||||
{ $values { "result-set" result-set } { "n" integer } }
|
||||
{ $description "Returns the number of rows in a result set." } ;
|
||||
|
||||
HELP: #columns
|
||||
{ $values { "result-set" result-set } { "n" integer } }
|
||||
{ $description "Returns the number of columns in a result set." } ;
|
||||
|
||||
HELP: row-column
|
||||
{ $values { "result-set" result-set } { "column" integer } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: row-column-typed
|
||||
{ $values { "result-set" result-set } { "column" integer } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: advance-row
|
||||
{ $values { "result-set" result-set } }
|
||||
;
|
||||
|
||||
HELP: more-rows?
|
||||
{ $values { "result-set" result-set } { "column" integer } }
|
||||
;
|
||||
|
||||
HELP: execute-statement*
|
||||
{ $values { "statement" statement } { "type" object } }
|
||||
{ $description } ;
|
||||
|
||||
HELP: execute-statement
|
||||
{ $values { "statement" statement } }
|
||||
{ $description } ;
|
||||
|
||||
ARTICLE: "db" "Low-level database library"
|
||||
{ $subsection "db-custom-database-combinators" }
|
||||
{ $subsection "db-protocol" }
|
||||
{ $subsection "db-lowlevel-tutorial" }
|
||||
"Higher-level database:"
|
||||
{ $vocab-subsection "Database types" "db.types" }
|
||||
{ $vocab-subsection "High-level tuple/database integration" "db.tuples" }
|
||||
"Supported database backends:"
|
||||
{ $vocab-subsection "SQLite" "db.sqlite" }
|
||||
{ $vocab-subsection "PostgreSQL" "db.postgresql" }
|
||||
"To add support for another database to Factor:"
|
||||
{ $subsection "db-porting-the-library" }
|
||||
;
|
||||
|
||||
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."
|
||||
;
|
||||
|
||||
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."
|
||||
;
|
||||
|
||||
|
||||
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."
|
||||
{ $code <"
|
||||
: with-my-database ( quot -- )
|
||||
{ "my-database.db" temp-file }
|
||||
"> }
|
||||
|
||||
|
||||
;
|
||||
|
||||
ABOUT: "db"
|
||||
|
|
@ -105,10 +105,10 @@ M: object execute-statement* ( statement type -- )
|
|||
] if ; inline recursive
|
||||
|
||||
: query-map ( statement quot -- seq )
|
||||
accumulator >r query-each r> { } like ; inline
|
||||
accumulator [ query-each ] dip { } like ; inline
|
||||
|
||||
: with-db ( seq class quot -- )
|
||||
>r make-db db-open db r>
|
||||
[ make-db db-open db ] dip
|
||||
[ db get swap [ drop ] prepose with-disposal ] curry with-variable ;
|
||||
inline
|
||||
|
||||
|
|
|
|||
|
|
@ -2,15 +2,49 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel math namespaces sequences random strings
|
||||
math.parser math.intervals combinators math.bitwise nmake db
|
||||
db.tuples db.types db.sql classes words shuffle arrays ;
|
||||
db.tuples db.types db.sql classes words shuffle arrays destructors
|
||||
continuations ;
|
||||
IN: db.queries
|
||||
|
||||
GENERIC: where ( specs obj -- )
|
||||
|
||||
SINGLETON: retryable
|
||||
: make-retryable ( obj -- obj' )
|
||||
dup sequence? [
|
||||
[ make-retryable ] map
|
||||
] [
|
||||
retryable >>type
|
||||
10 >>retries
|
||||
] if ;
|
||||
|
||||
: maybe-make-retryable ( statement -- statement )
|
||||
dup in-params>> [ generator-bind? ] contains?
|
||||
[ make-retryable ] when ;
|
||||
|
||||
: regenerate-params ( statement -- statement )
|
||||
dup
|
||||
[ bind-params>> ] [ in-params>> ] bi
|
||||
[
|
||||
dup generator-bind? [
|
||||
generator-singleton>> eval-generator >>value
|
||||
] [
|
||||
drop
|
||||
] if
|
||||
] 2map >>bind-params ;
|
||||
|
||||
M: retryable execute-statement* ( statement type -- )
|
||||
drop [ retries>> ] [
|
||||
[
|
||||
nip
|
||||
[ query-results dispose t ]
|
||||
[ ]
|
||||
[ regenerate-params bind-statement* f ] cleanup
|
||||
] curry
|
||||
] bi attempt-all drop ;
|
||||
|
||||
: sql-props ( class -- columns table )
|
||||
[ db-columns ] [ db-table ] bi ;
|
||||
|
||||
: query-make ( class quot -- )
|
||||
>r sql-props r>
|
||||
[ 0 sql-counter rot with-variable ] curry { "" { } { } } nmake
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: kernel parser quotations classes.tuple words math.order
|
||||
nmake namespaces sequences arrays combinators
|
||||
prettyprint strings math.parser math symbols ;
|
||||
prettyprint strings math.parser math symbols db ;
|
||||
IN: db.sql
|
||||
|
||||
SYMBOLS: insert update delete select distinct columns from as
|
||||
|
|
@ -23,44 +23,142 @@ DEFER: sql%
|
|||
: sql-function, ( seq function -- )
|
||||
sql% "(" sql% unclip sql% ")" sql% [ sql% ] each ;
|
||||
|
||||
: sql-where ( seq -- )
|
||||
B
|
||||
: sql-where, ( seq -- )
|
||||
[
|
||||
[ second 0, ]
|
||||
[ first 0, ]
|
||||
[ third 1, \ ? 0, ] tri
|
||||
] each ;
|
||||
|
||||
USE: multiline
|
||||
/*
|
||||
HOOK: sql-create db ( object -- )
|
||||
M: db sql-create ( object -- )
|
||||
drop
|
||||
"create table" sql% ;
|
||||
|
||||
HOOK: sql-drop db ( object -- )
|
||||
M: db sql-drop ( object -- )
|
||||
drop
|
||||
"drop table" sql% ;
|
||||
|
||||
HOOK: sql-insert db ( object -- )
|
||||
M: db sql-insert ( object -- )
|
||||
drop
|
||||
"insert into" sql% ;
|
||||
|
||||
HOOK: sql-update db ( object -- )
|
||||
M: db sql-update ( object -- )
|
||||
drop
|
||||
"update" sql% ;
|
||||
|
||||
HOOK: sql-delete db ( object -- )
|
||||
M: db sql-delete ( object -- )
|
||||
drop
|
||||
"delete" sql% ;
|
||||
|
||||
HOOK: sql-select db ( object -- )
|
||||
M: db sql-select ( object -- )
|
||||
"select" sql% "," (sql-interleave) ;
|
||||
|
||||
HOOK: sql-columns db ( object -- )
|
||||
M: db sql-columns ( object -- )
|
||||
"," (sql-interleave) ;
|
||||
|
||||
HOOK: sql-from db ( object -- )
|
||||
M: db sql-from ( object -- )
|
||||
"from" "," sql-interleave ;
|
||||
|
||||
HOOK: sql-where db ( object -- )
|
||||
M: db sql-where ( object -- )
|
||||
"where" 0, sql-where, ;
|
||||
|
||||
HOOK: sql-group-by db ( object -- )
|
||||
M: db sql-group-by ( object -- )
|
||||
"group by" "," sql-interleave ;
|
||||
|
||||
HOOK: sql-having db ( object -- )
|
||||
M: db sql-having ( object -- )
|
||||
"having" "," sql-interleave ;
|
||||
|
||||
HOOK: sql-order-by db ( object -- )
|
||||
M: db sql-order-by ( object -- )
|
||||
"order by" "," sql-interleave ;
|
||||
|
||||
HOOK: sql-offset db ( object -- )
|
||||
M: db sql-offset ( object -- )
|
||||
"offset" sql% sql% ;
|
||||
|
||||
HOOK: sql-limit db ( object -- )
|
||||
M: db sql-limit ( object -- )
|
||||
"limit" sql% sql% ;
|
||||
|
||||
! GENERIC: sql-subselect db ( object -- )
|
||||
! M: db sql-subselectselect ( object -- )
|
||||
! "(select" sql% sql% ")" sql% ;
|
||||
|
||||
GENERIC: sql-table db ( object -- )
|
||||
M: db sql-table ( object -- )
|
||||
sql% ;
|
||||
|
||||
GENERIC: sql-set db ( object -- )
|
||||
M: db sql-set ( object -- )
|
||||
"set" "," sql-interleave ;
|
||||
|
||||
GENERIC: sql-values db ( object -- )
|
||||
M: db sql-values ( object -- )
|
||||
"values(" sql% "," (sql-interleave) ")" sql% ;
|
||||
|
||||
GENERIC: sql-count db ( object -- )
|
||||
M: db sql-count ( object -- )
|
||||
"count" sql-function, ;
|
||||
|
||||
GENERIC: sql-sum db ( object -- )
|
||||
M: db sql-sum ( object -- )
|
||||
"sum" sql-function, ;
|
||||
|
||||
GENERIC: sql-avg db ( object -- )
|
||||
M: db sql-avg ( object -- )
|
||||
"avg" sql-function, ;
|
||||
|
||||
GENERIC: sql-min db ( object -- )
|
||||
M: db sql-min ( object -- )
|
||||
"min" sql-function, ;
|
||||
|
||||
GENERIC: sql-max db ( object -- )
|
||||
M: db sql-max ( object -- )
|
||||
"max" sql-function, ;
|
||||
|
||||
: sql-array% ( array -- )
|
||||
B
|
||||
unclip
|
||||
{
|
||||
{ \ create [ "create table" sql% ] }
|
||||
{ \ drop [ "drop table" sql% ] }
|
||||
{ \ insert [ "insert into" sql% ] }
|
||||
{ \ update [ "update" sql% ] }
|
||||
{ \ delete [ "delete" sql% ] }
|
||||
{ \ select [ B "select" sql% "," (sql-interleave) ] }
|
||||
{ \ columns [ "," (sql-interleave) ] }
|
||||
{ \ from [ "from" "," sql-interleave ] }
|
||||
{ \ where [ B "where" 0, sql-where ] }
|
||||
{ \ group-by [ "group by" "," sql-interleave ] }
|
||||
{ \ having [ "having" "," sql-interleave ] }
|
||||
{ \ order-by [ "order by" "," sql-interleave ] }
|
||||
{ \ offset [ "offset" sql% sql% ] }
|
||||
{ \ limit [ "limit" sql% sql% ] }
|
||||
{ \ select [ "(select" sql% sql% ")" sql% ] }
|
||||
{ \ table [ sql% ] }
|
||||
{ \ set [ "set" "," sql-interleave ] }
|
||||
{ \ values [ "values(" sql% "," (sql-interleave) ")" sql% ] }
|
||||
{ \ count [ "count" sql-function, ] }
|
||||
{ \ sum [ "sum" sql-function, ] }
|
||||
{ \ avg [ "avg" sql-function, ] }
|
||||
{ \ min [ "min" sql-function, ] }
|
||||
{ \ max [ "max" sql-function, ] }
|
||||
{ \ create [ sql-create ] }
|
||||
{ \ drop [ sql-drop ] }
|
||||
{ \ insert [ sql-insert ] }
|
||||
{ \ update [ sql-update ] }
|
||||
{ \ delete [ sql-delete ] }
|
||||
{ \ select [ sql-select ] }
|
||||
{ \ columns [ sql-columns ] }
|
||||
{ \ from [ sql-from ] }
|
||||
{ \ where [ sql-where ] }
|
||||
{ \ group-by [ sql-group-by ] }
|
||||
{ \ having [ sql-having ] }
|
||||
{ \ order-by [ sql-order-by ] }
|
||||
{ \ offset [ sql-offset ] }
|
||||
{ \ limit [ sql-limit ] }
|
||||
{ \ table [ sql-table ] }
|
||||
{ \ set [ sql-set ] }
|
||||
{ \ values [ sql-values ] }
|
||||
{ \ count [ sql-count ] }
|
||||
{ \ sum [ sql-sum ] }
|
||||
{ \ avg [ sql-avg ] }
|
||||
{ \ min [ sql-min ] }
|
||||
{ \ max [ sql-max ] }
|
||||
[ sql% [ sql% ] each ]
|
||||
} case ;
|
||||
*/
|
||||
|
||||
: sql-array% ( array -- ) drop ;
|
||||
ERROR: no-sql-match ;
|
||||
: sql% ( obj -- )
|
||||
{
|
||||
|
|
@ -74,4 +172,5 @@ ERROR: no-sql-match ;
|
|||
} cond ;
|
||||
|
||||
: parse-sql ( obj -- sql in-spec out-spec in out )
|
||||
[ [ sql% ] each ] { { } { } { } } nmake ;
|
||||
[ [ sql% ] each ] { { } { } { } } nmake
|
||||
[ " " join ] 2dip ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,191 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: classes help.markup help.syntax io.streams.string kernel
|
||||
quotations sequences strings multiline math ;
|
||||
IN: db.tuples
|
||||
|
||||
HELP: define-persistent
|
||||
{ $values
|
||||
{ "class" class } { "table" string } { "columns" "an array of slot specifiers" } }
|
||||
{ $description "Defines a relation from a Factor " { $snippet "tuple class" } " to a SQL database table name. The format for the slot specifiers is as follows:"
|
||||
{ $list
|
||||
{ "a slot name from the " { $snippet "tuple class" } }
|
||||
{ "the name of a database column that maps to the slot" } { "a database type (see " { $link "db.types" } ")" }
|
||||
} } ;
|
||||
|
||||
HELP: create-table
|
||||
{ $values
|
||||
{ "class" class } }
|
||||
{ $description "Creates a SQL table from a mapping defined by " { $link define-persistent } ". If the table already exists, the database will likely throw an error." } ;
|
||||
|
||||
HELP: ensure-table
|
||||
{ $values
|
||||
{ "class" class } }
|
||||
{ $description "Creates a SQL table from a mapping defined by " { $link define-persistent } ". If the table already exists, the error is silently ignored." } ;
|
||||
|
||||
HELP: ensure-tables
|
||||
{ $values
|
||||
{ "classes" null } }
|
||||
{ $description "Creates a SQL table from a mapping defined by " { $link define-persistent } ". If a table already exists, the error is silently ignored." } ;
|
||||
|
||||
HELP: recreate-table
|
||||
{ $values
|
||||
{ "class" class } }
|
||||
{ $description "Drops an existing table and re-creates it from a mapping defined by " { $link define-persistent } ". If the table does not exist the error is silently ignored." }
|
||||
{ $warning { $emphasis "THIS WORD WILL DELETE YOUR DATA." } $nl
|
||||
" Use " { $link ensure-table } " unless you want to delete the data in this table." } ;
|
||||
|
||||
{ create-table ensure-table ensure-tables recreate-table } related-words
|
||||
|
||||
HELP: drop-table
|
||||
{ $values
|
||||
{ "class" class } }
|
||||
{ $description "Drops an existing table which deletes all of the data. The database will probably throw an error if the table does not exist." }
|
||||
{ $warning { $emphasis "THIS WORD WILL DELETE YOUR DATA." } } ;
|
||||
|
||||
HELP: insert-tuple
|
||||
{ $values
|
||||
{ "tuple" tuple } }
|
||||
{ $description "Inserts a tuple into a database if a relation has been defined with " { $link define-persistent } ". If a mapping states that the database assigns a primary key to the tuple, this value will be set after this word runs." }
|
||||
{ $notes "Objects should only be inserted into a database once per object. To store the object after the initial insert, call " { $link update-tuple } "." } ;
|
||||
|
||||
HELP: update-tuple
|
||||
{ $values
|
||||
{ "tuple" tuple } }
|
||||
{ $description "Updates a tuple that has already been inserted into a database. The tuple must have a primary key that has been set by " { $link insert-tuple } " or that is user-defined." } ;
|
||||
|
||||
HELP: delete-tuples
|
||||
{ $values
|
||||
{ "tuple" tuple } }
|
||||
{ $description "Uses the " { $snippet "tuple" } " as an exemplar object and deletes any objects that have the same slots set. If a slot is not " { $link f } ", then it is used to generate a SQL statement that deletes tuples." }
|
||||
{ $warning "This word will delete your data." } ;
|
||||
|
||||
{ insert-tuple update-tuple delete-tuples } related-words
|
||||
|
||||
HELP: select-tuple
|
||||
{ $values
|
||||
{ "tuple" tuple }
|
||||
{ "tuple/f" "a tuple or f" } }
|
||||
{ $description "A SQL query is constructed from the slots of the exemplar tuple that are not " { $link f } ". Returns a single tuple from the database if it matches the query constructed from the exemplar tuple." } ;
|
||||
|
||||
HELP: select-tuples
|
||||
{ $values
|
||||
{ "tuple" tuple }
|
||||
{ "tuples" "an array of tuples" } }
|
||||
{ $description "A SQL query is constructed from the slots of the exemplar tuple that are not " { $link f } ". Returns a multiple tuples from the database that match the query constructed from the exemplar tuple." } ;
|
||||
|
||||
HELP: count-tuples
|
||||
{ $values
|
||||
{ "tuple" tuple } { "groups" "an array of slots to group by" }
|
||||
{ "n" integer } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: query
|
||||
{ $values
|
||||
{ "tuple" null } { "query" null }
|
||||
{ "tuples" null } }
|
||||
{ $description "" } ;
|
||||
|
||||
{ select-tuple select-tuples count-tuples query } related-words
|
||||
|
||||
ARTICLE: "db-tuples" "High-level tuple/database integration"
|
||||
"Start with a tutorial:"
|
||||
{ $subsection "db-tuples-tutorial" }
|
||||
"Useful words:"
|
||||
{ $subsection "db-tuples-words" }
|
||||
|
||||
;
|
||||
|
||||
ARTICLE: "db-tuples-words" "High-level tuple/database words"
|
||||
"Making tuples work with a database:"
|
||||
{ $subsection define-persistent }
|
||||
"Creating tables:"
|
||||
{ $subsection create-table }
|
||||
{ $subsection ensure-table }
|
||||
{ $subsection ensure-tables }
|
||||
{ $subsection recreate-table }
|
||||
"Dropping tables:"
|
||||
{ $subsection drop-table }
|
||||
"Inserting a tuple:"
|
||||
{ $subsection insert-tuple }
|
||||
"Updating a tuple:"
|
||||
{ $subsection update-tuple }
|
||||
"Deleting tuples:"
|
||||
{ $subsection delete-tuples }
|
||||
"Querying tuples:"
|
||||
{ $subsection select-tuple }
|
||||
{ $subsection select-tuples }
|
||||
{ $subsection count-tuples }
|
||||
"Advanced querying of tuples:"
|
||||
{ $subsection query } ;
|
||||
|
||||
|
||||
ARTICLE: "db-tuples-protocol" "High-level tuple/database protocol"
|
||||
;
|
||||
|
||||
ARTICLE: "db-tuples-tutorial" "Tuple database tutorial"
|
||||
"Let's make a tuple and store it in a database. To follow along, click on each code example and run it in the listener. If you forget to run an example, just start at the top and run them all again in order." $nl
|
||||
"We're going to store books in this tutorial."
|
||||
{ $code "TUPLE: book id title author date-published edition cover-price condition ;" }
|
||||
"The title, author, and publisher should be strings; the date-published a timestamp; the edition an integer; the cover-price a float. These are the Factor types for which we will need to look up the corresponding " { $link "db.types" } ". " $nl
|
||||
"To actually bind the tuple slots to the database types, we'll use " { $link define-persistent } "."
|
||||
{ $code
|
||||
<" USING: db.tuples db.types ;
|
||||
book "BOOK"
|
||||
{
|
||||
{ "id" "ID" +db-assigned-id+ }
|
||||
{ "title" "TITLE" VARCHAR }
|
||||
{ "author" "AUTHOR" VARCHAR }
|
||||
{ "date-published" "DATE_PUBLISHED" TIMESTAMP }
|
||||
{ "edition" "EDITION" INTEGER }
|
||||
{ "cover-price" "COVER_PRICE" DOUBLE }
|
||||
{ "condition" "CONDITION" VARCHAR }
|
||||
} define-persistent "> }
|
||||
"That's all we'll have to do with the database for this tutorial. Now let's make a book."
|
||||
{ $code <" USING: calendar namespaces ;
|
||||
T{ book
|
||||
{ title "Factor for Sheeple" }
|
||||
{ author "Mister Stacky Pants" }
|
||||
{ date-published T{ timestamp { year 2009 } { month 3 } { day 3 } } }
|
||||
{ edition 1 }
|
||||
{ cover-price 13.37 }
|
||||
} book set
|
||||
"> }
|
||||
"Now we've created a book. Let's save it to the database."
|
||||
{ $code <" USING: db db.sqlite fry io.files ;
|
||||
: with-book-tutorial ( quot -- )
|
||||
'[ "book-tutorial.db" temp-file sqlite-db , with-db ] call ;
|
||||
|
||||
[
|
||||
book recreate-table
|
||||
book get insert-tuple
|
||||
] with-book-tutorial
|
||||
"> }
|
||||
"Is it really there?"
|
||||
{ $code <" [
|
||||
T{ book { title "Factor for Sheeple" } } select-tuples .
|
||||
] with-book-tutorial "> }
|
||||
"Oops, we spilled some orange juice on the book cover."
|
||||
{ $code <" book get "Small orange juice stain on cover" >>condition "> }
|
||||
"Now let's save the modified book."
|
||||
{ $code <" [
|
||||
book get update-tuple
|
||||
] with-book-tutorial "> }
|
||||
"And select it again. You can query the database by any field -- just set it in the exemplar tuple you pass to " { $link select-tuples } "."
|
||||
{ $code <" [
|
||||
T{ book { title "Factor for Sheeple" } } select-tuples
|
||||
] with-book-tutorial "> }
|
||||
"Let's drop the table because we're done."
|
||||
{ $code <" [
|
||||
book drop-table
|
||||
] with-book-tutorial "> }
|
||||
"To summarize, the steps for using Factor's tuple database are:"
|
||||
{ $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" } }
|
||||
{ "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 } }
|
||||
} ;
|
||||
|
||||
ABOUT: "db-tuples"
|
||||
|
|
@ -49,36 +49,6 @@ HOOK: <count-statement> db ( tuple class groups -- n )
|
|||
HOOK: insert-tuple* db ( tuple statement -- )
|
||||
|
||||
GENERIC: eval-generator ( singleton -- obj )
|
||||
SINGLETON: retryable
|
||||
|
||||
: make-retryable ( obj -- obj' )
|
||||
dup sequence? [
|
||||
[ make-retryable ] map
|
||||
] [
|
||||
retryable >>type
|
||||
10 >>retries
|
||||
] if ;
|
||||
|
||||
: regenerate-params ( statement -- statement )
|
||||
dup
|
||||
[ bind-params>> ] [ in-params>> ] bi
|
||||
[
|
||||
dup generator-bind? [
|
||||
generator-singleton>> eval-generator >>value
|
||||
] [
|
||||
drop
|
||||
] if
|
||||
] 2map >>bind-params ;
|
||||
|
||||
M: retryable execute-statement* ( statement type -- )
|
||||
drop [ retries>> ] [
|
||||
[
|
||||
nip
|
||||
[ query-results dispose t ]
|
||||
[ ]
|
||||
[ regenerate-params bind-statement* f ] cleanup
|
||||
] curry
|
||||
] bi attempt-all drop ;
|
||||
|
||||
: resulting-tuple ( class row out-params -- tuple )
|
||||
rot class new [
|
||||
|
|
@ -98,9 +68,6 @@ M: retryable execute-statement* ( statement type -- )
|
|||
>r slot-name>> r> set-slot-named
|
||||
] curry 2each ;
|
||||
|
||||
: sql-props ( class -- columns table )
|
||||
[ db-columns ] [ db-table ] bi ;
|
||||
|
||||
: with-disposals ( seq quot -- )
|
||||
over sequence? [
|
||||
[ with-disposal ] curry each
|
||||
|
|
|
|||
|
|
@ -0,0 +1,303 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: classes hashtables help.markup help.syntax io.streams.string kernel sequences strings ;
|
||||
IN: db.types
|
||||
|
||||
HELP: (lookup-type)
|
||||
{ $values
|
||||
{ "obj" object }
|
||||
{ "string" string } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: +autoincrement+
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: +db-assigned-id+
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: +default+
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: +foreign-id+
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: +has-many+
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: +not-null+
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: +null+
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: +primary-key+
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: +random-id+
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: +serial+
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: +unique+
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: +user-assigned-id+
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: <generator-bind>
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: <literal-bind>
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: <low-level-binding>
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: BIG-INTEGER
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: BLOB
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: BOOLEAN
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: DATE
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: DATETIME
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: DOUBLE
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: FACTOR-BLOB
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: INTEGER
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: NULL
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: REAL
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: SIGNED-BIG-INTEGER
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: TEXT
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: TIME
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: TIMESTAMP
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: UNSIGNED-BIG-INTEGER
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: URL
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: VARCHAR
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: assigned-id-spec?
|
||||
{ $values
|
||||
{ "spec" null }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: bind#
|
||||
{ $values
|
||||
{ "spec" null } { "obj" object } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: bind%
|
||||
{ $values
|
||||
{ "spec" null } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: compound
|
||||
{ $values
|
||||
{ "string" string } { "obj" object }
|
||||
{ "hash" hashtable } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: db-assigned-id-spec?
|
||||
{ $values
|
||||
{ "spec" null }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: double-quote
|
||||
{ $values
|
||||
{ "string" string }
|
||||
{ "new-string" null } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: find-primary-key
|
||||
{ $values
|
||||
{ "specs" null }
|
||||
{ "obj" object } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: find-random-generator
|
||||
{ $values
|
||||
{ "seq" sequence }
|
||||
{ "obj" object } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: generator-bind
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: get-slot-named
|
||||
{ $values
|
||||
{ "name" null } { "obj" object }
|
||||
{ "value" null } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: join-space
|
||||
{ $values
|
||||
{ "string1" string } { "string2" string }
|
||||
{ "new-string" null } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: literal-bind
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: lookup-create-type
|
||||
{ $values
|
||||
{ "obj" object }
|
||||
{ "string" string } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: lookup-modifier
|
||||
{ $values
|
||||
{ "obj" object }
|
||||
{ "string" string } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: lookup-type
|
||||
{ $values
|
||||
{ "obj" object }
|
||||
{ "string" string } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: low-level-binding
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: modifiers
|
||||
{ $values
|
||||
{ "spec" null }
|
||||
{ "string" string } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: no-sql-type
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: normalize-spec
|
||||
{ $values
|
||||
{ "spec" null } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: number>string*
|
||||
{ $values
|
||||
{ "n/string" null }
|
||||
{ "string" string } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: offset-of-slot
|
||||
{ $values
|
||||
{ "string" string } { "obj" object }
|
||||
{ "n" null } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: paren
|
||||
{ $values
|
||||
{ "string" string }
|
||||
{ "new-string" null } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: persistent-table
|
||||
{ $values
|
||||
|
||||
{ "hash" hashtable } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: primary-key?
|
||||
{ $values
|
||||
{ "spec" null }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: random-id-generator
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: relation?
|
||||
{ $values
|
||||
{ "spec" null }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: remove-db-assigned-id
|
||||
{ $values
|
||||
{ "specs" null }
|
||||
{ "obj" object } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: remove-id
|
||||
{ $values
|
||||
{ "specs" null }
|
||||
{ "obj" object } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: remove-relations
|
||||
{ $values
|
||||
{ "specs" null }
|
||||
{ "newcolumns" null } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: set-slot-named
|
||||
{ $values
|
||||
{ "value" null } { "name" null } { "obj" object } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: single-quote
|
||||
{ $values
|
||||
{ "string" string }
|
||||
{ "new-string" null } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: spec>tuple
|
||||
{ $values
|
||||
{ "class" class } { "spec" null }
|
||||
{ "tuple" null } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: sql-spec
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: tuple>filled-slots
|
||||
{ $values
|
||||
{ "tuple" null }
|
||||
{ "alist" "an array of key/value pairs" } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: tuple>params
|
||||
{ $values
|
||||
{ "specs" null } { "tuple" null }
|
||||
{ "obj" object } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: unknown-modifier
|
||||
{ $description "" } ;
|
||||
|
||||
ARTICLE: "db.types" "Database types"
|
||||
"The " { $vocab-link "db.types" } " vocabulary maps Factor types to database types."
|
||||
;
|
||||
|
||||
ABOUT: "db.types"
|
||||
|
|
@ -316,3 +316,17 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
|||
! [ f ] [ 3 wlet-&&-test ] unit-test
|
||||
! [ f ] [ 8 wlet-&&-test ] unit-test
|
||||
! [ t ] [ 12 wlet-&&-test ] unit-test
|
||||
|
||||
[ { 10 } ] [ 10 [| a | { a } ] call ] unit-test
|
||||
[ { 10 20 } ] [ 10 20 [| a b | { a b } ] call ] unit-test
|
||||
[ { 10 20 30 } ] [ 10 20 30 [| a b c | { a b c } ] call ] unit-test
|
||||
|
||||
[ { 10 20 30 } ] [ [let | a [ 10 ] b [ 20 ] c [ 30 ] | { a b c } ] ] unit-test
|
||||
|
||||
[ V{ 10 20 30 } ] [ 10 20 30 [| a b c | V{ a b c } ] call ] unit-test
|
||||
|
||||
[ H{ { 10 "a" } { 20 "b" } { 30 "c" } } ]
|
||||
[ 10 20 30 [| a b c | H{ { a "a" } { b "b" } { c "c" } } ] call ] unit-test
|
||||
|
||||
[ T{ slice f 0 3 "abc" } ]
|
||||
[ 0 3 "abc" [| from to seq | T{ slice f from to seq } ] call ] unit-test
|
||||
|
|
@ -119,7 +119,7 @@ ERROR: no-vocab vocab ;
|
|||
{ "assoc3" assoc } { "newassoc" assoc }
|
||||
{ "alist" "an array of key/value pairs" }
|
||||
{ "keys" sequence } { "values" sequence }
|
||||
{ "class" class }
|
||||
{ "class" class } { "tuple" tuple }
|
||||
} at* ;
|
||||
|
||||
: add-using ( object -- )
|
||||
|
|
|
|||
|
|
@ -338,7 +338,7 @@ HELP: if-empty
|
|||
HELP: when-empty
|
||||
{ $values
|
||||
{ "seq" sequence } { "quot" "the first quotation of an " { $link if-empty } } }
|
||||
{ $description "Makes an implicit check if the sequence is empty. An empty sequence is dropped and the " { $snippet "quot1" } " is called." }
|
||||
{ $description "Makes an implicit check if the sequence is empty. An empty sequence is dropped and the " { $snippet "quot" } " is called." }
|
||||
{ $examples "This word is equivalent to " { $link if-empty } " with an empty second quotation:"
|
||||
{ $example
|
||||
"USING: sequences prettyprint ;"
|
||||
|
|
@ -355,7 +355,7 @@ HELP: when-empty
|
|||
HELP: unless-empty
|
||||
{ $values
|
||||
{ "seq" sequence } { "quot" "the second quotation of an " { $link if-empty } } }
|
||||
{ $description "Makes an implicit check if the sequence is empty. An empty sequence is dropped. Otherwise, the " { $snippet "quot2" } " is called on the sequence." }
|
||||
{ $description "Makes an implicit check if the sequence is empty. An empty sequence is dropped. Otherwise, the " { $snippet "quot" } " is called on the sequence." }
|
||||
{ $examples "This word is equivalent to " { $link if-empty } " with an empty first quotation:"
|
||||
{ $example
|
||||
"USING: sequences prettyprint ;"
|
||||
|
|
|
|||
Loading…
Reference in New Issue