change what select-tuples/select-tuple/count-tuples takes

diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor
index 300822cc50b4d9b302a5a7e3550fc13747421cab..7451676752cb85ad4b2b39aa9edea21e2b200b29 100644 (file)
--- a/basis/db/queries/queries.factor
+++ b/basis/db/queries/queries.factor
@@ -177,7 +177,8 @@ M: db <select-by-slots-statement> ( 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
     [ <select-by-slots-statement> ] 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>
     <simple-statement> maybe-make-retryable do-select ;
 
-M: db <count-statement> ( tuple class groups -- statement )
-    \ query new
-        swap >>group
+M: db <count-statement> ( 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 45a51719f98550930327fe044ef18b28ab0aa477..656802136d62c6daee91015fb252676abfffef78 100755 (executable)
--- 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 ;
 : <bignum-test> ( m n o -- obj )

diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor
index 2bdbb138d76e8667286fa6ea87263975accf0c12..3f1889aef2118ac1a98816eb59cb3999faaa4558 100755 (executable)
--- 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 ) \ 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 )
@@ -25,8 +15,8 @@ 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: <count-statement> 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>> [ <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 ;
 
@@ -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>> [ <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?
@@ -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 ;
-
-: 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 ;