From 969763e80798a0f530d9e589897da93815e3d4e9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 24 Sep 2008 17:59:17 -0500 Subject: [PATCH] change what select-tuples/select-tuple/count-tuples takes --- basis/db/queries/queries.factor | 8 +-- basis/db/tuples/tuples-tests.factor | 2 +- basis/db/tuples/tuples.factor | 83 ++++++++++++++--------------- 3 files changed, 44 insertions(+), 49 deletions(-) diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index 300822cc50..7451676752 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -177,7 +177,8 @@ M: db ( tuple class -- statement ) [ offset>> [ do-offset ] [ drop ] if* ] } 2cleave ; -M: db make-query ( tuple class query -- tuple ) +M: db query>statement ( query -- tuple ) + [ tuple>> dup class ] keep [ ] dip make-query* ; ! select ID, NAME, SCORE from EXAM limit 1 offset 3 @@ -194,9 +195,8 @@ M: db make-query ( tuple class query -- tuple ) >r >r parse-sql 4drop r> r> maybe-make-retryable do-select ; -M: db ( tuple class groups -- statement ) - \ query new - swap >>group +M: db ( query -- statement ) + [ tuple>> dup class ] keep [ [ "select count(*) from " 0% 0% where-clause ] query-make ] dip make-query* ; diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index 45a51719f9..656802136d 100755 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -357,7 +357,7 @@ TUPLE: exam id name score ; T{ exam } select-tuples ] unit-test - [ 4 ] [ T{ exam } f count-tuples ] unit-test ; + [ 4 ] [ T{ exam } count-tuples ] unit-test ; TUPLE: bignum-test id m n o ; : ( m n o -- obj ) diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index 2bdbb138d7..3f1889aef2 100755 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -6,16 +6,6 @@ math.parser io prettyprint db.types continuations destructors mirrors sets ; IN: db.tuples -TUPLE: query tuple group order offset limit ; - -: ( -- query ) \ query new ; - -GENERIC: >query ( object -- query ) - -M: query >query ; - -M: tuple >query swap >>tuple ; - ! returns a sequence of prepared-statements HOOK: create-sql-statement db ( class -- object ) HOOK: drop-sql-statement db ( class -- object ) @@ -25,8 +15,8 @@ HOOK: db ( class -- object ) HOOK: db ( class -- object ) HOOK: db ( tuple class -- object ) HOOK: db ( tuple class -- tuple ) -HOOK: db ( tuple class groups -- statement ) -HOOK: make-query db ( tuple class query -- statement ) +HOOK: db ( query -- statement ) +HOOK: query>statement db ( query -- statement ) HOOK: insert-tuple* db ( tuple statement -- ) @@ -93,6 +83,35 @@ GENERIC: eval-generator ( singleton -- object ) with-disposal ] if ; inline +: insert-db-assigned-statement ( tuple -- ) + dup class + db get insert-statements>> [ ] cache + [ bind-tuple ] 2keep insert-tuple* ; + +: insert-user-assigned-statement ( tuple -- ) + dup class + db get insert-statements>> [ ] 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 new ; + +GENERIC: >query ( object -- query ) + +M: query >query clone ; + +M: tuple >query swap >>tuple ; + + : create-table ( class -- ) create-sql-statement [ execute-statement ] with-disposals ; @@ -105,21 +124,9 @@ GENERIC: eval-generator ( singleton -- object ) ] 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>> [ ] cache - [ bind-tuple ] 2keep insert-tuple* ; - -: insert-user-assigned-statement ( tuple -- ) - dup class - db get insert-statements>> [ ] 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? @@ -135,26 +142,14 @@ GENERIC: eval-generator ( singleton -- object ) [ bind-tuple ] keep execute-statement ] with-disposal ; -: do-select ( exemplar-tuple statement -- tuples ) - [ [ bind-tuple ] [ query-tuples ] 2bi ] with-disposal ; +: select-tuples ( query/tuple -- tuples ) + >query [ tuple>> ] [ query>statement ] bi do-select ; -: query ( tuple query -- tuples ) - [ dup dup class ] dip make-query do-select ; - - -: select-tuples ( tuple -- tuples ) - dup dup class 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> do-count +: count-tuples ( query/tuple -- n ) + >query [ tuple>> ] [ ] bi do-count dup length 1 = [ first first string>number ] [ [ first string>number ] map ] if ;