retryable statements actually retry now

extra/db/db.factor

@@ -42,7 +42,6 @@ TUPLE: prepared-statement < statement ;
 
 SINGLETON: throwable
 SINGLETON: nonthrowable
-SINGLETON: retryable
 
 : make-throwable ( obj -- obj' )
     dup sequence? [
@@ -58,13 +57,6 @@ SINGLETON: retryable
         nonthrowable >>type
     ] if ;
 
-: make-retryable ( obj quot -- obj' )
-    over sequence? [
-        [ make-retryable ] curry map
-    ] [
-        retryable >>type
-    ] if ;
-
 TUPLE: result-set sql in-params out-params handle n max ;
 
 : construct-statement ( sql in out class -- statement )
@@ -78,6 +70,7 @@ HOOK: <simple-statement> db ( str in out -- statement )
 HOOK: <prepared-statement> db ( str in out -- statement )
 GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( statement -- )
+GENERIC: low-level-bind ( statement -- )
 GENERIC: bind-tuple ( tuple statement -- )
 GENERIC: query-results ( query -- result-set )
 GENERIC: #rows ( result-set -- n )
@@ -95,12 +88,6 @@ M: throwable execute-statement* ( statement type -- )
 M: nonthrowable execute-statement* ( statement type -- )
     drop [ query-results dispose ] [ 2drop ] recover ;
 
-M: retryable execute-statement* ( statement type -- )
-    [
-        dup dup quot>> call
-        [ query-results dispose ] [ 2drop ] recover
-    ] curry 10 retry ;
-
 : execute-statement ( statement -- )
     dup sequence? [
         [ execute-statement ] each

extra/db/sqlite/ffi/ffi.factor

@@ -108,7 +108,7 @@ LIBRARY: sqlite
 FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ;
 FUNCTION: int sqlite3_close ( sqlite3* pDb ) ;
 FUNCTION: char* sqlite3_errmsg ( sqlite3* pDb ) ;
-FUNCTION: int sqlite3_prepare ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
+FUNCTION: int sqlite3_prepare_v2 ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
 FUNCTION: int sqlite3_finalize ( sqlite3_stmt* pStmt ) ;
 FUNCTION: int sqlite3_reset ( sqlite3_stmt* pStmt ) ;
 FUNCTION: int sqlite3_step ( sqlite3_stmt* pStmt ) ;
@@ -123,6 +123,7 @@ FUNCTION: int sqlite3_bind_int64 ( sqlite3_stmt* pStmt, int index, sqlite3_int64
 FUNCTION: int sqlite3_bind_null ( sqlite3_stmt* pStmt, int n ) ;
 FUNCTION: int sqlite3_bind_text ( sqlite3_stmt* pStmt, int index, char* text, int len, int destructor ) ;
 FUNCTION: int sqlite3_bind_parameter_index ( sqlite3_stmt* pStmt, char* name ) ;
+FUNCTION: int sqlite3_clear_bindings ( sqlite3_stmt* pStmt ) ;
 FUNCTION: int sqlite3_column_count ( sqlite3_stmt* pStmt ) ;
 FUNCTION: void* sqlite3_column_blob ( sqlite3_stmt* pStmt, int col ) ;
 FUNCTION: int sqlite3_column_bytes ( sqlite3_stmt* pStmt, int col ) ;

extra/db/sqlite/lib/lib.factor

@@ -33,7 +33,7 @@ IN: db.sqlite.lib
 
 : sqlite-prepare ( db sql -- handle )
     dup length "void*" <c-object> "void*" <c-object>
-    [ sqlite3_prepare sqlite-check-result ] 2keep
+    [ sqlite3_prepare_v2 sqlite-check-result ] 2keep
     drop *void* ;
 
 : sqlite-bind-parameter-index ( handle name -- index )
@@ -114,6 +114,8 @@ IN: db.sqlite.lib
 
 : sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ;
 : sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ;
+: sqlite-clear-bindings ( handle -- )
+    sqlite3_clear_bindings sqlite-check-result ;
 : sqlite-#columns ( query -- int ) sqlite3_column_count ;
 : sqlite-column ( handle index -- string ) sqlite3_column_text ;
 : sqlite-column-name ( handle index -- string ) sqlite3_column_name ;

extra/db/sqlite/sqlite.factor

@@ -7,6 +7,7 @@ continuations db.sqlite.lib db.sqlite.ffi db.tuples
 words combinators.lib db.types combinators math.intervals
 io namespaces.lib accessors vectors math.ranges random
 math.bitfields.lib ;
+USE: tools.walker
 IN: db.sqlite
 
 TUPLE: sqlite-db < db path ;
@@ -43,17 +44,21 @@ M: sqlite-statement dispose ( statement -- )
 M: sqlite-result-set dispose ( result-set -- )
     f >>handle drop ;
 
-: sqlite-bind ( triples handle -- )
-    swap [ first3 sqlite-bind-type ] with each ;
-
 : reset-statement ( statement -- )
     sqlite-maybe-prepare handle>> sqlite-reset ;
 
+: reset-bindings ( statement -- )
+    sqlite-maybe-prepare
+    handle>> [ sqlite3_reset drop ] [ sqlite3_clear_bindings drop ] bi ;
+
+M: sqlite-statement low-level-bind ( statement -- )
+    [ statement-bind-params ] [ statement-handle ] bi
+    swap [ first3 sqlite-bind-type ] with each ;
+
 M: sqlite-statement bind-statement* ( statement -- )
     sqlite-maybe-prepare
-    dup statement-bound? [ dup reset-statement ] when
-    [ statement-bind-params ] [ statement-handle ] bi
-    sqlite-bind ;
+    dup statement-bound? [ dup reset-bindings ] when
+    low-level-bind ;
 
 GENERIC: sqlite-bind-conversion ( tuple obj -- array )
 
@@ -140,13 +145,16 @@ M: sqlite-db <insert-native-statement> ( tuple -- statement )
                         dup 0% random-id-quot
                     ] with-random
                 ] curry
-                [ type>> ] bi 10 <generator-bind> 1,
+                [ type>> ] bi <generator-bind> 1,
             ] [
                 bind%
             ] if
         ] interleave
         ");" 0%
-    ] sqlite-make ;
+    ] sqlite-make
+    dup in-params>> [ generator-bind? ] contains? [
+        make-retryable
+    ] when ;
 
 M: sqlite-db <insert-nonnative-statement> ( tuple -- statement )
     <insert-native-statement> ;

extra/db/tuples/tuples-tests.factor

@@ -346,7 +346,7 @@ C: <secret> secret
     ] unit-test
 
     [ t ] [
-        T{ secret } select-tuples length 3 =
+        T{ secret } select-tuples dup . length 3 =
     ] unit-test ;
 
 [ test-random-id ] test-sqlite

extra/db/tuples/tuples.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes db kernel namespaces
-classes.tuple words sequences slots math
+classes.tuple words sequences slots math accessors
 math.parser io prettyprint db.types continuations
 mirrors sequences.lib tools.walker combinators.lib ;
 IN: db.tuples
@@ -49,6 +49,40 @@ HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
 
 HOOK: insert-tuple* db ( tuple statement -- )
 
+SINGLETON: retryable
+
+: make-retryable ( obj -- obj' )
+    dup sequence? [
+        [ make-retryable ] map
+    ] [
+        retryable >>type
+    ] if ;
+
+: regenerate-params ( statement -- statement )
+    dup
+    [ bind-params>> ] [ in-params>> ] bi
+    [
+        dup generator-bind? [
+            quot>> call over set-second
+        ] [
+            drop
+        ] if
+    ] 2map >>bind-params ;
+
+: handle-random-id ( statement -- )
+    dup in-params>> [ type>> +random-id+ = ] find drop >boolean [
+        retryable >>type
+        random-id-quot >>quot
+    ] when drop ;
+
+M: retryable execute-statement* ( statement type -- )
+    drop
+    [
+        [ query-results dispose t ]
+        [ ]
+        [ regenerate-params bind-statement* f ] cleanup
+    ] curry 10 retry drop ;
+
 : resulting-tuple ( row out-params -- tuple )
     dup first sql-spec-class new [
         [

extra/db/types/types.factor

@@ -19,7 +19,7 @@ TUPLE: sql-spec class slot-name column-name type primary-key modifiers ;
 TUPLE: literal-bind key type value ;
 C: <literal-bind> literal-bind
 
-TUPLE: generator-bind key quot type retries ;
+TUPLE: generator-bind key quot type ;
 C: <generator-bind> generator-bind
 
 SINGLETON: +native-id+
@@ -64,12 +64,6 @@ SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+
 
 : relation? ( spec -- ? ) [ +has-many+ = ] deep-find ;
 
-: handle-random-id ( statement -- )
-    dup in-params>> [ type>> +random-id+ = ] find drop >boolean [
-        retryable >>type
-        random-id-quot >>quot
-    ] when drop ;
-
 SYMBOLS: INTEGER BIG-INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER
 DOUBLE REAL BOOLEAN TEXT VARCHAR DATE TIME DATETIME TIMESTAMP BLOB
 FACTOR-BLOB NULL ;