number>string " limit " swap 3append
] curry change-sql drop ;
-: make-query ( tuple query -- tuple' )
+: make-query* ( tuple query -- tuple' )
dupd
{
[ group>> [ drop ] [ do-group ] if-empty ]
[ offset>> [ do-offset ] [ drop ] if* ]
} 2cleave ;
-M: db <query> ( tuple class query -- tuple )
- [ <select-by-slots-statement> ] dip make-query ;
+M: db make-query ( tuple class query -- tuple )
+ [ <select-by-slots-statement> ] dip make-query* ;
! select ID, NAME, SCORE from EXAM limit 1 offset 3
\ query new
swap >>group
[ [ "select count(*) from " 0% 0% where-clause ] query-make ]
- dip make-query ;
+ dip make-query* ;
: create-index ( index-name table-name columns -- )
[
\ ensure-table must-infer
\ create-table must-infer
\ drop-table must-infer
+
+: test-queries ( -- )
+ [ ] [ exam ensure-table ] unit-test
+ ! [ ] [ T{ exam f f "Kyle" 100 } insert-tuple ] unit-test
+ ! [ ] [ T{ exam f f "Stan" 80 } insert-tuple ] unit-test
+ ! [ ] [ T{ exam f f "Kenny" 60 } insert-tuple ] unit-test
+ ! [ ] [ T{ exam f f "Cartman" 41 } insert-tuple ] unit-test
+ [ ] [ 10 [ random-exam insert-tuple ] times ] unit-test
+ [ ] [ ] unit-test
+ ! [ ] [ query ] unit-test
+
+ ;
+
+: test-db ( -- )
+ "tuples-test.db" temp-file sqlite-db make-db db-open db set ;
destructors mirrors ;
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: <insert-db-assigned-statement> db ( class -- object )
+HOOK: <insert-user-assigned-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: insert-tuple* db ( tuple statement -- )
+
: define-persistent ( class table columns -- )
>r dupd "db-table" set-word-prop dup r>
[ relation? ] partition swapd
: next-sql-counter ( -- str )
sql-counter [ inc ] [ get ] bi number>string ;
-! returns a sequence of prepared-statements
-HOOK: create-sql-statement db ( class -- object )
-HOOK: drop-sql-statement db ( class -- object )
-
-HOOK: <insert-db-assigned-statement> db ( class -- object )
-HOOK: <insert-user-assigned-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 )
-TUPLE: query group order offset limit ;
-HOOK: <query> db ( tuple class query -- statement' )
-HOOK: <count-statement> db ( tuple class groups -- n )
-
-HOOK: insert-tuple* db ( tuple statement -- )
-
GENERIC: eval-generator ( singleton -- object )
: resulting-tuple ( exemplar-tuple row out-params -- tuple )
[ [ bind-tuple ] [ query-tuples ] 2bi ] with-disposal ;
: query ( tuple query -- tuples )
- [ dup dup class ] dip <query> do-select ;
+ [ dup dup class ] dip make-query 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 <query> do-select
+ dup dup class \ query new 1 >>limit make-query do-select
[ f ] [ first ] if-empty ;
: do-count ( exemplar-tuple statement -- tuples )