response.clj

(defn- ^Function java-fn [f]
  (reify java.util.function.Function
    (apply [_ x] (f x))))

(defn- to-completion-stage [response]
  (if (instance? CompletionStage response)
    response
    (CompletableFuture/completedFuture response)))

(defn bind-response
  "Applies f to the possibly asynchronous response. If response is a
  CompletionStage, f is applied to the response map it wraps when and if
  that becomes available. f is expected to return a possibly asynchronous
  response"
  [response f & args]
  (if-not (instance? CompletionStage response)
    (apply f response args)
    (.thenCompose
     ^CompletionStage response
     (java-fn (fn [response-map]
                (to-completion-stage (apply f response-map args)))))))

(defn cs-response-catch
  [^CompletionStage response f]
  (-> response
      (.handle (reify java.util.function.BiFunction
                  (apply [_ response ex] (if ex (f ex) response))))
      (.thenCompose (java-fn to-completion-stage))))

(defn cs-response-do-after
  [^CompletionStage response f]
  (.whenComplete response
    (reify java.util.function.BiConsumer
      (accept [_ _ _] (f)))))

(defmacro try-handler
  "Like try but also catches exceptions in asynchronous response."
  [& body]
  (let [[exprs catch-clauses]
        (split-with #(not (and (seq? %) (= 'catch (first %)))) body)
        [catch-clauses [finally-clause]]
        (split-with #(not= 'finally (first %)) catch-clauses)]
    (cond-> `(do ~@exprs)
      (seq? catch-clauses)
      ((fn [body] `(letfn [(do-catch# [ex#] (try (throw ex#) ~@catch-clauses))]
                    (try
                      (let [response# ~body]
                        (if (instance? CompletionStage response#)
                          (cs-response-catch response# do-catch#)
                          response#))
                      (catch Throwable t# (do-catch# t#))))))
      finally-clause
      ((fn [body] `(letfn [(do-finally# [] ~@(next finally-clause))]
                    (let [response# (try ~body (catch Throwable t# (do-finally#) (throw t#)))]
                      (if (instance? CompletionStage response#)
                        (cs-response-do-after response# do-finally#)
                        (do (do-finally#) response#)))))))))