{ $values { "statement" statement } }
{ $description } ;
-ARTICLE: "db" "Low-level database library"
+ARTICLE: "db" "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" }
+! { $subsection "db-tuples" }
+! { $subsection "db-tuples-protocol" }
+! { $subsection "db-tuples-tutorial" }
"Supported database backends:"
{ $vocab-subsection "SQLite" "db.sqlite" }
{ $vocab-subsection "PostgreSQL" "db.postgresql" }
"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
{ $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" } ")" }
-} } ;
+} "Throws an error if the slot name (column one from each row) is not a slot in the tuple or its superclases." }
+{ $examples
+ { $unchecked-example "USING: db.tuples db.types ;"
+ "TUPLE: boat id year name ;"
+ "boat \"BOAT\" {"
+ " { \"id\" \"ID\" +db-assigned-id+ }"
+ " { \"year\" \"YEAR\" INTEGER }"
+ " { \"name\" \"NAME\" TEXT }"
+ "} define-persistent"
+ ""
+ }
+} ;
HELP: create-table
{ $values
HELP: select-tuple
{ $values
- { "tuple" tuple }
+ { "query/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 }
+ { "query/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" }
+ { "query/tuple" tuple }
{ "n" integer } }
{ $description "" } ;
-HELP: query
-{ $values
- { "tuple" tuple } { "query" query }
- { "tuples" "a sequence of tuples" } }
-{ $description "Allows for queries with group by, order by, limit, and offset clauses. " } ;
-
{ 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" }
"Querying tuples:"
{ $subsection select-tuple }
{ $subsection select-tuples }
-{ $subsection count-tuples }
-"Advanced querying of tuples:"
-{ $subsection query } ;
+{ $subsection count-tuples } ;
ARTICLE: "db-tuples-protocol" "High-level tuple/database protocol"
destructors mirrors sets ;
IN: db.tuples
+<PRIVATE
! returns a sequence of prepared-statements
HOOK: create-sql-statement db ( class -- object )
HOOK: drop-sql-statement db ( class -- object )
HOOK: insert-tuple* db ( tuple statement -- )
-ERROR: no-slots-named class seq ;
-: check-columns ( class columns -- )
- tuck
- [ [ first ] map ]
- [ all-slots [ name>> ] map ] bi* diff
- [ drop ] [ no-slots-named ] if-empty ;
-
-: define-persistent ( class table columns -- )
- pick dupd
- check-columns
- [ dupd "db-table" set-word-prop dup ] dip
- [ relation? ] partition swapd
- dupd [ spec>tuple ] with map
- "db-columns" set-word-prop
- "db-relations" set-word-prop ;
-
ERROR: not-persistent class ;
: db-table ( class -- object )
: resulting-tuple ( exemplar-tuple row out-params -- tuple )
rot class new [
- [
- [ slot-name>> ] dip set-slot-named
- ] curry 2each
+ [ [ slot-name>> ] dip set-slot-named ] curry 2each
] keep ;
: query-tuples ( exemplar-tuple statement -- seq )
: do-count ( exemplar-tuple statement -- tuples )
[ [ bind-tuple ] [ nip default-query ] 2bi ] with-disposal ;
+PRIVATE>
+
! High level
+ERROR: no-slots-named class seq ;
+: check-columns ( class columns -- )
+ tuck
+ [ [ first ] map ]
+ [ all-slots [ name>> ] map ] bi* diff
+ [ drop ] [ no-slots-named ] if-empty ;
+
+: define-persistent ( class table columns -- )
+ pick dupd
+ check-columns
+ [ dupd "db-table" set-word-prop dup ] dip
+ [ relation? ] partition swapd
+ dupd [ spec>tuple ] with map
+ "db-columns" set-word-prop
+ "db-relations" set-word-prop ;
TUPLE: query tuple group order offset limit ;
M: tuple >query <query> swap >>tuple ;
-
: create-table ( class -- )
create-sql-statement [ execute-statement ] with-disposals ;