From 16be5d03536c2deceb2567e05b835c3e120be1ef Mon Sep 17 00:00:00 2001
From: Alexander Iljin <ajsoft@yandex.ru>
Date: Wed, 14 Feb 2018 15:26:28 +0100
Subject: [PATCH] db.tuples[-docs]: add each-tuple

---
 basis/db/tuples/tuples-docs.factor |  9 ++++++++-
 basis/db/tuples/tuples.factor      | 17 ++++++++++++++---
 2 files changed, 22 insertions(+), 4 deletions(-)

diff --git a/basis/db/tuples/tuples-docs.factor b/basis/db/tuples/tuples-docs.factor
index a744701b56..a579e7bb88 100644
--- a/basis/db/tuples/tuples-docs.factor
+++ b/basis/db/tuples/tuples-docs.factor
@@ -130,6 +130,12 @@ HELP: delete-tuples
 
 { insert-tuple update-tuple delete-tuples } related-words
 
+HELP: each-tuple
+{ $values
+     { "query/tuple" tuple }
+     { "quot" { $quotation ( tuple -- ) } } }
+{ $description "An SQL query is constructed from the slots of the exemplar tuple that are not " { $link f } ". The " { $snippet "quot" } " is applied to each tuple from the database that matches the query constructed from the exemplar tuple." } ;
+
 HELP: select-tuple
 { $values
      { "query/tuple" tuple }
@@ -148,7 +154,7 @@ HELP: count-tuples
      { "n" integer } }
 { $description "Returns the number of items that would be returned if the query were a select query. Counting the tuples with this word is more efficient than calling " { $link length } " on the result of " { $link select-tuples } "." } ;
 
-{ select-tuple select-tuples count-tuples } related-words
+{ each-tuple select-tuple select-tuples count-tuples } related-words
 
 
 
@@ -183,6 +189,7 @@ ARTICLE: "db-tuples-words" "High-level tuple/database words"
 { $subsections delete-tuples }
 "Querying tuples:"
 { $subsections
+    each-tuple
     select-tuple
     select-tuples
     count-tuples
diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor
index 76bba72dbe..bf2580c52a 100644
--- a/basis/db/tuples/tuples.factor
+++ b/basis/db/tuples/tuples.factor
@@ -33,10 +33,13 @@ GENERIC: eval-generator ( singleton -- object )
         '[ slot-name>> _ set-slot-named ] 2each
     ] keep ;
 
+: query-tuples-each ( exemplar-tuple statement quot: ( tuple -- ) -- )
+    [ [ out-params>> ] keep query-results ] dip '[
+        [ sql-row-typed swap resulting-tuple @ ] 2with query-each
+    ] with-disposal ; inline
+
 : query-tuples ( exemplar-tuple statement -- seq )
-    [ out-params>> ] keep query-results [
-        [ sql-row-typed swap resulting-tuple ] 2with query-map
-    ] with-disposal ;
+    [ ] collector [ query-tuples-each ] dip { } like ;
 
 : query-modify-tuple ( tuple statement -- )
     [ query-results [ sql-row-typed ] with-disposal ] keep
@@ -61,6 +64,10 @@ GENERIC: eval-generator ( singleton -- object )
     [ <insert-user-assigned-statement> ] cache
     [ bind-tuple ] keep execute-statement ;
 
+: do-each-tuple ( exemplar-tuple statement quot: ( tuple -- ) -- tuples )
+    '[ [ bind-tuple ] [ _ query-tuples-each ] 2bi ] with-disposal
+    ; inline
+
 : do-select ( exemplar-tuple statement -- tuples )
     [ [ bind-tuple ] [ query-tuples ] 2bi ] with-disposal ;
 
@@ -155,3 +162,7 @@ ERROR: no-defined-persistent object ;
 : count-tuples ( query/tuple -- n )
     >query [ tuple>> ] [ <count-statement> ] bi do-count
     [ first string>number ] map dup length 1 = [ first ] when ;
+
+: each-tuple ( query/tuple quot: ( tuple -- ) -- )
+    [ >query [ tuple>> ] [ query>statement ] bi ] dip do-each-tuple
+    ; inline