diff --git a/extra/db/queries/queries.factor b/extra/db/queries/queries.factor index d524080e57..29abe9bddc 100644 --- a/extra/db/queries/queries.factor +++ b/extra/db/queries/queries.factor @@ -3,7 +3,7 @@ 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 -- ) @@ -146,7 +146,7 @@ M: db ( tuple class -- statement ) 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* ] @@ -155,6 +155,43 @@ M: db ( tuple class -- statement ) [ offset>> [ do-offset ] [ drop ] if* ] } 2cleave ; -M: db ( tuple class group order limit offset -- tuple ) - advanced-statement boa - [ ] dip make-advanced-statement ; +M: db ( tuple class group order limit offset -- tuple ) + \ query boa + [ ] 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> + maybe-make-retryable do-select ; + +M: db ( 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> + maybe-make-retryable do-select ; diff --git a/extra/db/sql/sql.factor b/extra/db/sql/sql.factor index 756aeea7c0..dc8b5d1fb1 100755 --- a/extra/db/sql/sql.factor +++ b/extra/db/sql/sql.factor @@ -5,7 +5,7 @@ IN: db.sql 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 @@ -25,12 +25,27 @@ DEFER: sql% : 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 ] } @@ -51,7 +66,7 @@ DEFER: sql% 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% ] } @@ -61,13 +76,4 @@ ERROR: no-sql-match ; } 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 ; diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index f9a597e814..665afa6a51 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -227,7 +227,7 @@ TUPLE: exam id name score ; : 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 ; @@ -340,7 +340,9 @@ TUPLE: exam id name score ; } ] [ T{ exam } select-tuples - ] unit-test ; + ] unit-test + + [ 4 ] [ T{ exam } count-tuples ] unit-test ; TUPLE: bignum-test id m n o ; : ( m n o -- obj ) diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 09fd63b233..d121e06445 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -42,8 +42,9 @@ HOOK: db ( class -- obj ) HOOK: db ( class -- obj ) HOOK: db ( tuple class -- obj ) HOOK: db ( tuple class -- tuple ) -TUPLE: advanced-statement group order offset limit ; -HOOK: db ( tuple class group order offset limit -- tuple ) +TUPLE: query group order offset limit ; +HOOK: db ( tuple class group order offset limit -- tuple ) +HOOK: db ( tuple class -- n ) HOOK: insert-tuple* db ( tuple statement -- ) @@ -152,9 +153,20 @@ M: retryable execute-statement* ( statement type -- ) dup dup class do-select ; : select-tuple ( tuple -- tuple/f ) - dup dup class f f f 1 + dup dup class f f f 1 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> - do-select ; + 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> do-count + dup length 1 = [ first first string>number ] [ + [ first string>number ] map + ] if ;