USING: accessors kernel math namespaces sequences random
strings math.parser math.intervals combinators
math.bitfields.lib namespaces.lib db db.tuples db.types
-sequences.lib ;
+sequences.lib db.sql classes words shuffle arrays ;
IN: db.queries
GENERIC: where ( specs obj -- )
number>string " limit " prepend append
] curry change-sql drop ;
-: make-advanced-statement ( tuple advanced -- tuple' )
+: make-query ( tuple query -- tuple' )
dupd
{
[ group>> [ do-group ] [ drop ] if* ]
[ offset>> [ do-offset ] [ drop ] if* ]
} 2cleave ;
-M: db <advanced-select-statement> ( tuple class group order limit offset -- tuple )
- advanced-statement boa
- [ <select-by-slots-statement> ] dip make-advanced-statement ;
+M: db <query> ( tuple class group order limit offset -- tuple )
+ \ query boa
+ [ <select-by-slots-statement> ] dip make-query ;
+
+! select ID, NAME, SCORE from EXAM limit 1 offset 3
+
+: select-tuples* ( tuple -- statement )
+ dup
+ [
+ select 0,
+ dup class db-columns [ ", " 0, ]
+ [ dup column-name>> 0, 2, ] interleave
+ from 0,
+ class word-name 0,
+ ] { { } { } { } } nmake
+ >r >r parse-sql 4drop r> r>
+ <simple-statement> maybe-make-retryable do-select ;
+
+M: db <count-statement> ( tuple class groups -- statement )
+ f f f \ query boa
+ [ [ "select count(*) from " 0% 0% where-clause ] query-make ]
+ dip make-query ;
+
+: where-clause* ( tuple specs -- )
+ dupd filter-slots [
+ drop
+ ] [
+ \ where 0,
+ [ 2dup slot-name>> swap get-slot-named where ] map 2array 0,
+ drop
+ ] if-empty ;
+
+: delete-tuple* ( tuple -- sql )
+ dup
+ [
+ delete 0, from 0, dup class db-table 0,
+ dup class db-columns where-clause*
+ ] { { } { } { } } nmake
+ >r >r parse-sql 4drop r> r>
+ <simple-statement> maybe-make-retryable do-select ;
SYMBOLS: insert update delete select distinct columns from as
where group-by having order-by limit offset is-null desc all
-any count avg table values ? ;
+any count avg table values ;
! Output an s-exp sql statement and an alist of keys/values
: sql-function, ( seq function -- )
sql% "(" sql% unclip sql% ")" sql% [ sql% ] each ;
+: sql-where ( seq -- )
+B
+ [
+ [ second 0, ]
+ [ first 0, ]
+ [ third 1, \ ? 0, ] tri
+ ] each ;
+
: 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 [ "where" "and" sql-interleave ] }
+ { \ where [ B "where" 0, sql-where ] }
{ \ group-by [ "group by" "," sql-interleave ] }
{ \ having [ "having" "," sql-interleave ] }
{ \ order-by [ "order by" "," sql-interleave ] }
ERROR: no-sql-match ;
: sql% ( obj -- )
{
- { [ dup string? ] [ " " 0% 0% ] }
+ { [ dup string? ] [ 0, ] }
{ [ dup array? ] [ sql-array% ] }
{ [ dup number? ] [ number>string sql% ] }
{ [ dup symbol? ] [ unparse sql% ] }
} cond ;
: parse-sql ( obj -- sql in-spec out-spec in out )
- [
- unclip {
- { \ create [ "create table" sql% ] }
- { \ drop [ "drop table" sql% ] }
- { \ insert [ "insert into" sql% ] }
- { \ update [ "update" sql% ] }
- { \ delete [ "delete" sql% ] }
- { \ select [ "select" sql% ] }
- } case [ sql% ] each
- ] { "" { } { } { } { } } nmake ;
+ [ [ sql% ] each ] { { } { } { } } nmake ;
: random-exam ( -- exam )
f
- 6 [ CHAR: a CHAR: b [a,b] random ] replicate >string
+ 6 [ CHAR: a CHAR: z [a,b] random ] replicate >string
100 random
exam boa ;
}
] [
T{ exam } select-tuples
- ] unit-test ;
+ ] unit-test
+
+ [ 4 ] [ T{ exam } count-tuples ] unit-test ;
TUPLE: bignum-test id m n o ;
: <bignum-test> ( m n o -- obj )
HOOK: <update-tuple-statement> db ( class -- obj )
HOOK: <delete-tuples-statement> db ( tuple class -- obj )
HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
-TUPLE: advanced-statement group order offset limit ;
-HOOK: <advanced-select-statement> db ( tuple class group order offset limit -- tuple )
+TUPLE: query group order offset limit ;
+HOOK: <query> db ( tuple class group order offset limit -- tuple )
+HOOK: <count-statement> db ( tuple class -- n )
HOOK: insert-tuple* db ( tuple statement -- )
dup dup class <select-by-slots-statement> do-select ;
: select-tuple ( tuple -- tuple/f )
- dup dup class f f f 1 <advanced-select-statement>
+ dup dup class f f f 1 <query>
do-select ?first ;
-: advanced-select ( tuple groups order offset limit -- tuples )
+: query ( tuple groups order offset limit -- tuples )
>r >r >r >r dup dup class r> r> r> r>
- <advanced-select-statement> do-select ;
+ <query> do-select ;
+
+: 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
+ dup length 1 = [ first first string>number ] [
+ [ first string>number ] map
+ ] if ;