destructors mirrors sets ;
IN: db.tuples
-TUPLE: query tuple group order offset limit ;
-
-: <query> ( -- query ) \ query new ;
-
-GENERIC: >query ( object -- query )
-
-M: query >query ;
-
-M: tuple >query <query> swap >>tuple ;
-
! returns a sequence of prepared-statements
HOOK: create-sql-statement db ( class -- object )
HOOK: drop-sql-statement db ( class -- object )
HOOK: <update-tuple-statement> db ( class -- object )
HOOK: <delete-tuples-statement> db ( tuple class -- object )
HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
-HOOK: <count-statement> db ( tuple class groups -- statement )
-HOOK: make-query db ( tuple class query -- statement )
+HOOK: <count-statement> db ( query -- statement )
+HOOK: query>statement db ( query -- statement )
HOOK: insert-tuple* db ( tuple statement -- )
with-disposal
] if ; inline
+: insert-db-assigned-statement ( tuple -- )
+ dup class
+ db get insert-statements>> [ <insert-db-assigned-statement> ] cache
+ [ bind-tuple ] 2keep insert-tuple* ;
+
+: insert-user-assigned-statement ( tuple -- )
+ dup class
+ db get insert-statements>> [ <insert-user-assigned-statement> ] cache
+ [ bind-tuple ] keep execute-statement ;
+
+: do-select ( exemplar-tuple statement -- tuples )
+ [ [ bind-tuple ] [ query-tuples ] 2bi ] with-disposal ;
+
+: do-count ( exemplar-tuple statement -- tuples )
+ [ [ bind-tuple ] [ nip default-query ] 2bi ] with-disposal ;
+
+! High level
+
+TUPLE: query tuple group order offset limit ;
+
+: <query> ( -- query ) \ query new ;
+
+GENERIC: >query ( object -- query )
+
+M: query >query clone ;
+
+M: tuple >query <query> swap >>tuple ;
+
+
: create-table ( class -- )
create-sql-statement [ execute-statement ] with-disposals ;
] curry ignore-errors
] [ create-table ] bi ;
-: ensure-table ( class -- )
- [ create-table ] curry ignore-errors ;
+: ensure-table ( class -- ) [ create-table ] curry ignore-errors ;
-: ensure-tables ( classes -- )
- [ ensure-table ] each ;
-
-: insert-db-assigned-statement ( tuple -- )
- dup class
- db get insert-statements>> [ <insert-db-assigned-statement> ] cache
- [ bind-tuple ] 2keep insert-tuple* ;
-
-: insert-user-assigned-statement ( tuple -- )
- dup class
- db get insert-statements>> [ <insert-user-assigned-statement> ] cache
- [ bind-tuple ] keep execute-statement ;
+: ensure-tables ( classes -- ) [ ensure-table ] each ;
: insert-tuple ( tuple -- )
dup class db-columns find-primary-key db-assigned-id-spec?
[ bind-tuple ] keep execute-statement
] with-disposal ;
-: do-select ( exemplar-tuple statement -- tuples )
- [ [ bind-tuple ] [ query-tuples ] 2bi ] with-disposal ;
-
-: query ( tuple query -- tuples )
- [ dup dup class ] dip make-query do-select ;
+: select-tuples ( query/tuple -- tuples )
+ >query [ tuple>> ] [ query>statement ] bi do-select ;
-
-: select-tuples ( tuple -- tuples )
- dup dup class <select-by-slots-statement> do-select ;
-
-: select-tuple ( tuple -- tuple/f )
- dup dup class \ query new 1 >>limit make-query do-select
+: select-tuple ( query/tuple -- tuple/f )
+ >query 1 >>limit [ tuple>> ] [ query>statement ] bi do-select
[ f ] [ first ] if-empty ;
-: do-count ( exemplar-tuple statement -- tuples )
- [
- [ bind-tuple ] [ nip default-query ] 2bi
- ] with-disposal ;
-
-: count-tuples ( tuple groups -- n )
- >r dup dup class r> <count-statement> do-count
+: count-tuples ( query/tuple -- n )
+ >query [ tuple>> ] [ <count-statement> ] bi do-count
dup length 1 =
[ first first string>number ] [ [ first string>number ] map ] if ;