Generalize retry criteria

README.md

@@ -22,9 +22,13 @@ Add this to your project.clj :dependencies list:
 
 ;; but with the addition of a first options arg, if you don't
 (try-try-again {:sleep 5000 :tries 100} #(some-fn arg1 arg2))
-(try-try-again {:sleep nil :tries 100} #(some-fn arg1 arg2))
+(try-try-again {:sleep nil :tries 100} some-fn arg1 arg2)
 (try-try-again {:decay :exponential :tries 100} #(some-fn arg1 arg2))
 
+;; by default, a failure is detected when the function throws an
+;; exception. options can refine that criterion based on the type of
+;; exception thrown or by classifying some return values as failures.
+
 (try-try-again {;; all options are optional
 
                 ;; :sleep is used to specify how long to sleep
@@ -41,30 +45,51 @@ Add this to your project.clj :dependencies list:
                 ;; if you want your sleep amount to change over
                 ;; time, you can provide a decay function:
                 ;; a number - your sleep will be multiplied by it
-                ;; a function - your sleep will passed into it
+                ;; a function - your sleep will passed into it, or
                 ;; a keyword - for out of the box decay algorithms
                 ;;             :exponential, :double, :golden-ratio
                 ;; default is identity
                 :decay :exponential
 
+                ;; if the function signals failure by its return value
+                ;; rather than (or in addition to) throwing
+                ;; exceptions, you can provide a return? predicate to
+                ;; detect failures. The predicate will be given a
+                ;; candidate return value and should return truthy if
+                ;; the value should be returned or falsey to request a
+                ;; retry. The :return? option value should be either:
+                ;; a function of one argument, or
+                ;; a keyword - for out of the box predicates:
+                ;;             :always, :truthy?, :falsey?
+                ;; default is :always
+                :return? :truthy?
+
                 ;; if you want to only retry when particular
                 ;; exceptions are thrown, you can add a :catch
                 ;; clause.  it works with either a single type
                 ;; or a collection.  
                 ;; default is Exception
                 :catch [java.io.IOException java.sql.SQLException]
 
-                ;; if you would like a function to be called on
-                ;; each failure (for instance, logging each failed
-                ;; attempt), you can specify an error-hook.
-                ;; The error that occurred is passed into the
-                ;; error-hook function as an argument.
-                ;; The error-hook method can also force a
-                ;; short-circuit failure by returning false, or
+                ;; if you would like a function to be called on each
+                ;; failure (for instance, logging each failed
+                ;; attempt), you can specify an error-hook. The error
+                ;; that occurred (an exception or a return value that
+                ;; the :return? predicate classified as indicating
+                ;; failure) is passed into the error-hook function as
+                ;; an argument. The error-hook function can also force
+                ;; a short-circuit failure by returning false, or
                 ;; force an additional retry by returning true.
+
                 :error-hook (fn [e] (println "I got an error:" e))}
                #(some-fn arg1 arg2))
 
+;; When retries are exhausted, try-try-again will either:
+;; - throw the last exception caught if the last try generated an
+;;   exception, or
+;; - return the last return value that the :return? predicate
+;;   classified as indicating falure.
+
 ;; In addition, four dynamic variables are bound in both the
 ;; passed in and error-hook functions:
 ;; *first-try* - true if this is the first try

src/robert/bruce.clj

@@ -5,19 +5,40 @@
 (def default-options {:sleep 10000
                       :tries 5
                       :decay identity
+                      :return? :always
                       :catch Exception
-                      :try 1  ;; try is not overrideable
                       :error-hook (constantly nil)})
 
-(defn double [x]
+(defn double
+  "decay option: 2^n"
+  [x]
   (* 2 x))
 
-(defn exponential [x]
+(defn exponential
+  "decay option: e^n"
+  [x]
   (* Math/E x))
 
-(defn golden-ratio [x]
+(defn golden-ratio
+  "decay option: φ^n"
+  [x]
   (* 1.6180339887 x))
 
+(defn always
+  ":return? option (default): any return value indicates success"
+  [x]
+  true)
+
+(defn truthy?
+  ":return? option: only truthy return values indicate success"
+  [x]
+  (boolean x))
+
+(defn falsey?
+  ":return? option: only falsey return values indicate success"
+  [x]
+  (not x))
+
 (defn catch
   "internal function that returns a collection of exceptions to catch"
   [options]
@@ -26,39 +47,58 @@
       catch
       [catch])))
 
-(defn decay
-  "internal function that returns of a function that implements the selected
-decay strategy, said function will take a number as an operand and return a
-number as a result"
+(defn resolve-keyword
+  "resolves k as a function named in this namespace"
+  [k]
+  (when-let [f (->> k name symbol (ns-resolve 'robert.bruce))]
+    @f))
+
+(defn resolve-decay
+  "internal function that resolves the value of :decay in options to a
+  decay strategy: a function that accepts a current time delay
+  milliseconds in and returns a new time delay milliseconds"
+  [{d :decay :as options}]
+  (if-let [d (cond (nil? d) identity
+                   (fn? d) d
+                   (number? d) #(* d %)
+                   (keyword? d) (resolve-keyword d))]
+    (assoc options :decay d)
+    (throw (IllegalArgumentException.
+            (str "Unrecognized :decay option " d)))))
+
+(defn resolve-return
+  "internal function that resolves the value of :return? in options to
+  a return? filter: a function that accepts a candidate return value
+  and returns truthy to approve it being returned or falsey to request
+  a retry."
+  [{r :return? :as options}]
+  (if-let [r (cond (nil? r) always
+                   (fn? r) r
+                   (keyword? r) (resolve-keyword r))]
+    (assoc options :return? r)
+    (throw (IllegalArgumentException.
+            (str "Unrecognized :return? option " r)))))
+
+(defn init-options
   [options]
-  (let [d (:decay options)]
-    (cond (nil? d) identity
-          (fn? d) d
-          (number? d) #(* d %)
-          (keyword? d) @(ns-resolve 'robert.bruce (symbol (name d))))))
+  (-> options (assoc :try 1) resolve-decay resolve-return))
 
 (defn parse
   "internal function that parses arguments into usable bits"
-  [args]
-  (let [argc (count args)
-        fn (first (filter fn? args))
-        options (if (and (> argc 1)
-                         (map? (first args)))
-                  (first args)
-                  {})
-        options (merge default-options
-                       (select-keys (meta fn)
-                                    (keys default-options))
-                       options)
-        options (assoc options :try 1)
-        args (rest (drop-while (complement fn?) args))]
-    [options fn args]))
+  [arg & args]
+  (let [[arg-options [f & args]] (if (map? arg)
+                                   [arg args]
+                                   [nil (cons arg args)])
+        meta-options (select-keys (meta f) (keys default-options))
+        options (merge default-options meta-options arg-options)]
+    [options f args]))
 
 (defn try-again?
   "internal function that determines whether we try again"
-  [options t]
+  [options error]
   (let [tries (:tries options)]
-    (and (some #(isa? (type t) %) (catch options))
+    (and (or (not (instance? Throwable error))
+             (some #(isa? (type error) %) (catch options)))
          (or (= :unlimited (keyword tries))
              (pos? tries)))))
 
@@ -75,7 +115,7 @@ number as a result"
   "internal function that updates sleep with the decay function"
   [options]
   (update-in options [:sleep] (if (:sleep options)
-                                (decay options)
+                                (:decay options)
                                 identity)))
 
 (def ^{:dynamic true} *first-try* nil)
@@ -90,29 +130,35 @@ number as a result"
             *first-try* (= 1 (:try options))
             *last-try* (= 1 (:tries options))
             *error* (::error options)]
-    (try
-      (let [ret (f)]
-        (if (instance? IObj ret)
-          (vary-meta ret assoc :tries *try*)
-          ret))
-      (catch Throwable t
-        (let [options (-> options
+    (let [{:keys [returned thrown]}
+          (try
+            {:returned (f)}
+            (catch Throwable t
+              {:thrown t}))]
+      (if (and (not thrown) ((:return? options) returned))
+        (if (instance? IObj returned)
+          (vary-meta returned assoc :tries *try*)
+          returned)
+        (let [error (or thrown returned)
+              options (-> options
                           update-tries
-                          (assoc ::error t))
-              continue ((:error-hook options) t)]
+                          (assoc ::error error))
+              continue ((:error-hook options) error)]
           (if (or (true? continue)
                   (and (not (false? continue))
-                       (try-again? options t)))
+                       (try-again? options error)))
             (do
               (when-let [sleep (:sleep options)]
                 (Thread/sleep (long sleep)))
               #(retry (update-sleep options) f))
-            (throw t)))))))
-
+            (if thrown
+              (throw thrown)
+              returned)))))))
 
 (defn try-try-again
   "if at first you don't succeed, intelligent retry trampolining"
   {:arglists '([fn] [fn & args] [options fn] [options fn & args])}
-  [& args]
-  (let [[options fn args] (parse args)]
+  [arg & args]
+  (let [[options fn args] (apply parse arg args)
+        options (init-options options)]
     (trampoline retry options #(apply fn args))))