error-kitを使ってretry

error-kitとtrampolineを使ったリトライ処理の実装。

(ns jp.t2ru.retry
  (:use
    [clojure.contrib.error-kit]))

(defn- do-with-retry [f & args]
  (with-handler
    {:result (apply f args)}
    (bind-continue retry [& args]
      #(apply do-with-retry f args))))

(defn with-retry* [f & args]
  (:result (apply trampoline do-with-retry f args)))

(defmacro with-retry [bindings & body]
  (let [bind-pairs (partition 2 bindings)
        bind-syms (map first bind-pairs)
        bind-vals (map second bind-pairs)]
    `(with-retry* (fn ~(vec bind-syms) ~@body) ~@bind-vals)))

(defmacro with-retry-handler [bindings & body]
  (let [handler-labels #{'handle 'bind-continue}
        [main-forms handle-forms] (split-with #(not (handler-labels (first %))) body)]
    `(with-handler
       (with-retry ~bindings ~@main-forms)
       ~@handle-forms)))

(defmacro retry [& args]
  `(continue ~'retry ~@args))

(comment

(deferror hoge [] [x])

(defn t []
  (with-retry-handler [a 1]
    (if (< a 10)
      (do (prn "Next" a) (raise hoge a))
      (do (prn "Finish" a) a))
    (handle hoge [x]
      (prn "handling" x)
      (retry (inc x)))))

)