From a7afae250d4de6f18fe9e98e4ae5621e0d793477 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 1 Jun 2008 00:48:38 -0500
Subject: [PATCH] clean up code some make \# retries user configurable

---
 extra/db/db.factor              |  4 ++--
 extra/db/queries/queries.factor | 10 +++++-----
 extra/db/sql/sql.factor         |  4 +++-
 extra/db/tuples/tuples.factor   | 14 ++++++++------
 4 files changed, 18 insertions(+), 14 deletions(-)

diff --git a/extra/db/db.factor b/extra/db/db.factor
index 8d1feca6c7..889eff196c 100755
--- a/extra/db/db.factor
+++ b/extra/db/db.factor
@@ -35,7 +35,7 @@ HOOK: db-close db ( handle -- )
         handle>> db-close
     ] with-variable ;
 
-TUPLE: statement handle sql in-params out-params bind-params bound? type ;
+TUPLE: statement handle sql in-params out-params bind-params bound? type retries ;
 TUPLE: simple-statement < statement ;
 TUPLE: prepared-statement < statement ;
 
@@ -89,7 +89,7 @@ M: object execute-statement* ( statement type -- )
         swap >>out-params
         swap >>in-params
         swap >>sql ;
-    
+
 : sql-row ( result-set -- seq )
     dup #columns [ row-column ] with map ;
 
diff --git a/extra/db/queries/queries.factor b/extra/db/queries/queries.factor
index 59ee60aa1f..d524080e57 100644
--- a/extra/db/queries/queries.factor
+++ b/extra/db/queries/queries.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel math namespaces sequences random
 strings math.parser math.intervals combinators
-math.bitfields.lib namespaces.lib db db.tuples db.types ;
+math.bitfields.lib namespaces.lib db db.tuples db.types
+sequences.lib ;
 IN: db.queries
 
 GENERIC: where ( specs obj -- )
@@ -99,16 +100,15 @@ M: string where ( spec obj -- ) object-where ;
     ] with filter ;
 
 : where-clause ( tuple specs -- )
-    dupd filter-slots
-    dup empty? [
-        2drop
+    dupd filter-slots [
+        drop
     ] [
         " where " 0% [
             " and " 0%
         ] [
             2dup slot-name>> swap get-slot-named where
         ] interleave drop
-    ] if ;
+    ] if-empty ;
 
 M: db <delete-tuples-statement> ( tuple table -- sql )
     [
diff --git a/extra/db/sql/sql.factor b/extra/db/sql/sql.factor
index 82c6e370bd..756aeea7c0 100755
--- a/extra/db/sql/sql.factor
+++ b/extra/db/sql/sql.factor
@@ -5,7 +5,9 @@ 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
 
 : input-spec, 1, ;
 : output-spec, 2, ;
diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor
index bac141d6d2..b7bf6a7fbe 100755
--- a/extra/db/tuples/tuples.factor
+++ b/extra/db/tuples/tuples.factor
@@ -55,6 +55,7 @@ SINGLETON: retryable
         [ make-retryable ] map
     ] [
         retryable >>type
+        10 >>retries
     ] if ;
 
 : regenerate-params ( statement -- statement )
@@ -69,12 +70,13 @@ SINGLETON: retryable
     ] 2map >>bind-params ;
 
 M: retryable execute-statement* ( statement type -- )
-    drop
-    [
-        [ query-results dispose t ]
-        [ ]
-        [ regenerate-params bind-statement* f ] cleanup
-    ] curry 10 retry drop ;
+    drop [
+        [
+            [ query-results dispose t ]
+            [ ]
+            [ regenerate-params bind-statement* f ] cleanup
+        ] curry
+    ] [ retries>> ] bi retry drop ;
 
 : resulting-tuple ( class row out-params -- tuple )
     rot class new [