From 67286436f5b13d017f9bfa5e797f41603b26b0c5 Mon Sep 17 00:00:00 2001
From: Brent Soles <17535379+bnert@users.noreply.github.com>
Date: Sat, 30 Mar 2024 12:03:17 -0400
Subject: [PATCH] Add ':binding' support

Per #54 in metosin/seippari, this commit
could be considered a starting point for supporting
bindings support in clojure.

The initial implementation used the starting
point @robert-stuttaford posted in the referenced
issue.

A tradeoff here, is that in order to support sync/async
w/ the various runtimes, using (bound-fn*) seems to be necessary
given the different thread pool implemenations. Counsequently,
there is a a perf hit needing to push/pop thread local vars. It
doesn't seem to be too much in the general case, but with manifold,
it seems to a an order of magnitude slower, though still in the
microseconds.
---
 .gitignore                                 |  2 ++
 src/sieppari/async.cljc                    | 41 ++++++++++++++++++---
 src/sieppari/async/core_async.cljc         |  6 +++-
 src/sieppari/async/manifold.clj            | 24 ++++++++++---
 src/sieppari/core.cljc                     | 11 ++++--
 test/clj/sieppari/core_async_test.clj      | 33 +++++++++++++++++
 test/clj/sieppari/core_execute_test.clj    | 20 +++++++++++
 test/clj/sieppari/manifold_test.clj        | 42 ++++++++++++++++++++++
 test/clj/sieppari/promesa_test.clj         | 35 ++++++++++++++++++
 test/cljc/sieppari/async/promesa_test.cljc |  4 +--
 10 files changed, 204 insertions(+), 14 deletions(-)

diff --git a/.gitignore b/.gitignore
index 26e34f4..ce2e07c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -12,3 +12,5 @@ pom.xml.asc
 /.lumo_cache/
 .idea/
 *.iml
+.clj-kondo/.cache/
+.lsp/
diff --git a/src/sieppari/async.cljc b/src/sieppari/async.cljc
index 724b65e..5c387ea 100644
--- a/src/sieppari/async.cljc
+++ b/src/sieppari/async.cljc
@@ -5,6 +5,18 @@
                    java.util.concurrent.CompletionException
                    java.util.function.Function)))
 
+#?(:clj
+  (defn -forward-bindings
+    ([f]
+     (fn [ctx]
+       (println "fwd" ctx)
+       (with-bindings (or (:bindings ctx) {})
+         ((bound-fn* f) ctx))))
+    ([f ctx]
+     (with-bindings (or (:bindings ctx) {})
+       ((bound-fn* f) ctx)))))
+
+
 (defprotocol AsyncContext
   (async? [t])
   (continue [t f])
@@ -15,12 +27,17 @@
    (deftype FunctionWrapper [f]
      Function
      (apply [_ v]
+       (println "V>" f v)
        (f v))))
 
 #?(:clj
    (extend-protocol AsyncContext
      Object
      (async? [_] false)
+     ; Given the implementation of enter/leave,
+     ; `continue` won't be called, and therefore,
+     ; the function call does not need to be bound
+     ; here.
      (continue [t f] (f t))
      (await [t] t)))
 
@@ -28,15 +45,22 @@
    (extend-protocol AsyncContext
      default
      (async? [_] false)
+     ; Given the implementation of enter/leave,
+     ; `continue` won't be called, and therefore,
+     ; the function call does not need to be bound
+     ; here.
      (continue [t f] (f t))))
 
 #?(:clj
    (extend-protocol AsyncContext
      clojure.lang.IDeref
      (async? [_] true)
-     (continue [c f] (future (f @c)))
-     (catch [c f] (future (let [c @c]
-                            (if (exception? c) (f c) c))))
+     (continue [c f]
+       (future ((-forward-bindings f) @c)))
+     (catch [c f]
+       (future
+         (let [c @c]
+           (if (exception? c) ((-forward-bindings f) c) c))))
      (await [c] @c)))
 
 #?(:clj
@@ -44,9 +68,16 @@
      CompletionStage
      (async? [_] true)
      (continue [this f]
+       ; f may a callable value (i.e. a promise), which doesn't look to
+       ; play nicely with with-binding/bound-fn*.
+       ;
+       ; Therefore, only forwarding bindings when value is
+       ; a function and not some other type.
        (.thenApply ^CompletionStage this
-                   ^Function (->FunctionWrapper f)))
-
+                   ^Function (->FunctionWrapper
+                               (cond-> f
+                                 (fn? f)
+                                   (-forward-bindings)))))
      (catch [this f]
        (letfn [(handler [e]
                   (if (instance? CompletionException e)
diff --git a/src/sieppari/async/core_async.cljc b/src/sieppari/async/core_async.cljc
index d62123c..f6eb093 100644
--- a/src/sieppari/async/core_async.cljc
+++ b/src/sieppari/async/core_async.cljc
@@ -9,7 +9,11 @@
   #?(:clj  clojure.core.async.impl.protocols.Channel
      :cljs cljs.core.async.impl.channels/ManyToManyChannel)
   (async? [_] true)
-  (continue [c f] (go (f (cca/<! c))))
+  #?(:clj  (continue [c f]
+            (let [f' (sa/-forward-bindings f)]
+              (go 
+                (f' (cca/<! c)))))
+     :cljs (continue [c f] (go (f (cca/<! c)))))
   (catch [c f] (go (let [c (cca/<! c)]
                      (if (exception? c) (f c) c))))
   #?(:clj (await [c] (<!! c))))
diff --git a/src/sieppari/async/manifold.clj b/src/sieppari/async/manifold.clj
index f8178a2..1bb05f8 100644
--- a/src/sieppari/async/manifold.clj
+++ b/src/sieppari/async/manifold.clj
@@ -2,15 +2,31 @@
   (:require [sieppari.async :as sa]
             [manifold.deferred :as d]))
 
+; chain'-, as is being used here, is chain'-/3
+; chain'-/3, at the time of writing, has an arglist of:
+;  [d x f]
+; where:
+;  - `d` is a non-realized manifold deferred value, or nil
+;    to signal a deferred should be returned/provided
+;  - `x` is either a deferred or a value. If it is a deferred,
+;    then the deferred is recurively realized until a non-deferred value
+;    is yeilded.
+;  - `f` is a function applied to the unwrapped value `x`, before being either realized
+;    into `d` or being returned as a sucess or error deferred, depending on the result
+;    of `(f x)`.
 (extend-protocol sa/AsyncContext
   manifold.deferred.Deferred
   (async? [_] true)
-  (continue [d f] (d/chain'- nil d f))
-  (catch [d f] (d/catch' d f))
+  (continue [d f]
+    (d/chain'- nil d (sa/-forward-bindings f)))
+  (catch [d f]
+    (d/catch' d (sa/-forward-bindings f)))
   (await [d] (deref d))
 
   manifold.deferred.ErrorDeferred
   (async? [_] true)
-  (continue [d f] (d/chain'- nil d f))
-  (catch [d f] (d/catch' d f))
+  (continue [d f]
+    (d/chain'- nil d (sa/-forward-bindings f)))
+  (catch [d f]
+    (d/catch' d (sa/-forward-bindings f)))
   (await [d] (deref d)))
diff --git a/src/sieppari/core.cljc b/src/sieppari/core.cljc
index a818f9e..d14413e 100644
--- a/src/sieppari/core.cljc
+++ b/src/sieppari/core.cljc
@@ -14,10 +14,17 @@
   c/Context
   (context? [_] true))
 
+
 (defn- -try [ctx f]
   (if f
     (try
-      (let [ctx* (f ctx)]
+      (let [ctx* #?(:clj (with-bindings (or (:bindings ctx) {})
+                           ; Given the various async
+                           ; executors may exec on different threads,
+                           ; the fn must be bound in order to preserve
+                           ; bindings
+                           ((bound-fn* f) ctx))
+                    :cljs (f ctx))]
         (if (a/async? ctx*)
           (a/catch ctx* (fn [e] (assoc ctx :error e)))
           ctx*))
@@ -79,7 +86,7 @@
       (callback result))))
 
 (defn- remove-context-keys [ctx]
-  (dissoc ctx :error :queue :stack))
+  (dissoc ctx :bindings :error :queue :stack))
 
 ;;
 ;; Public API:
diff --git a/test/clj/sieppari/core_async_test.clj b/test/clj/sieppari/core_async_test.clj
index 3db2c70..6ac10b5 100644
--- a/test/clj/sieppari/core_async_test.clj
+++ b/test/clj/sieppari/core_async_test.clj
@@ -246,3 +246,36 @@
                [:error :c]
                [:error :b]
                [:leave :a]])))
+
+(def ^:dynamic *boundv* 41)
+
+(defn bindings-handler [_]
+  (is (= 43 *boundv*))
+  (go
+    *boundv*))
+
+(def bindings-chain
+  [{:enter (fn [ctx]
+             (go
+               (assoc ctx
+                      :bindings
+                      {#'*boundv* 42})))
+    :leave (fn [ctx]
+             (go
+               (is (= 42 *boundv*))
+               ctx))}
+   {:enter (fn [ctx]
+             (is (= 42 *boundv*)
+                  "In interceptor failed")
+             (go
+               (update-in ctx [:bindings #'*boundv*] inc)))
+    :leave (fn [ctx]
+             (go
+               (update-in ctx [:bindings #'*boundv*] dec)))}
+
+   bindings-handler])
+
+(deftest async-bindings-test
+  (fact "bindings are conveyed across interceptor chain"
+    (sc/execute bindings-chain {}) => 43))
+
diff --git a/test/clj/sieppari/core_execute_test.clj b/test/clj/sieppari/core_execute_test.clj
index 1f9d8ed..a65293c 100644
--- a/test/clj/sieppari/core_execute_test.clj
+++ b/test/clj/sieppari/core_execute_test.clj
@@ -269,6 +269,26 @@
         [:leave :x]
         [:leave :a]]))
 
+
+(def ^:dynamic *boundv* 41)
+
+(defn bindings-handler [_]
+  (is (= 42 *boundv*))
+  *boundv*)
+
+(def bindings-chain
+  [{:enter (fn [ctx] (assoc ctx
+                            :bindings
+                            {#'*boundv* 42}))}
+   {:enter (fn [ctx]
+             (is (= 42 *boundv*))
+             ctx)}
+   bindings-handler])
+
+(deftest use-bindings-test
+  (fact "bindings are conveyed across interceptor chain"
+    (s/execute bindings-chain {}) => 42))
+
 ; TODO: figure out how enqueue should work? Should enqueue add interceptors just
 ; before the handler?
 #_(deftest enqueue-interceptor-test
diff --git a/test/clj/sieppari/manifold_test.clj b/test/clj/sieppari/manifold_test.clj
index a8af771..0e27f2e 100644
--- a/test/clj/sieppari/manifold_test.clj
+++ b/test/clj/sieppari/manifold_test.clj
@@ -228,3 +228,45 @@
                [:error :c]
                [:error :b]
                [:leave :a]])))
+
+(def ^:dynamic *boundv* 41)
+
+(defn bindings-handler [_]
+  (is (= 43 *boundv*))
+  (d/chain
+    nil
+    (fn [_]
+      *boundv*)))
+
+(def bindings-chain
+  [{:enter (fn [ctx]
+             (d/future
+               (assoc ctx
+                      :bindings
+                      {#'*boundv* 42})))
+    :leave (fn [ctx]
+             (d/chain
+               ctx
+               (fn [ctx']
+                 (is (= 42 *boundv*))
+                 ctx')))}
+   {:enter (fn [ctx]
+             (is (= 42 *boundv*)
+                  "In interceptor failed")
+             (d/chain
+               ctx
+               #(update-in
+                  %
+                  [:bindings #'*boundv*] inc)))
+    :leave (fn [ctx]
+             (d/chain
+               ctx
+               #(update-in
+                  %
+                  [:bindings #'*boundv*] dec)))}
+   bindings-handler])
+
+(deftest async-bindings-test
+  (fact "bindings are conveyed across interceptor chain"
+    (sc/execute bindings-chain {}) => 43))
+
diff --git a/test/clj/sieppari/promesa_test.clj b/test/clj/sieppari/promesa_test.clj
index 23de0a9..b6f34e5 100644
--- a/test/clj/sieppari/promesa_test.clj
+++ b/test/clj/sieppari/promesa_test.clj
@@ -228,3 +228,38 @@
                [:error :c]
                [:error :b]
                [:leave :a]])))
+
+(def ^:dynamic *boundv* 41)
+
+(defn bindings-handler [_]
+  (is (= 43 *boundv*))
+  (p/resolved
+    *boundv*))
+
+(def bindings-chain
+  [{:enter (fn [ctx]
+             (p/resolved
+               (assoc ctx
+                      :bindings
+                      {#'*boundv* 42})))
+    :leave (fn [ctx]
+             (is (= 42 *boundv*))
+             ctx)}
+   {:enter (fn [ctx]
+             (is (= 42 *boundv*))
+             (-> ctx
+                 (update-in [:bindings #'*boundv*]
+                            inc)
+                 (p/resolved)))
+    :leave (fn [ctx]
+             (is (= 43 *boundv*))
+             (-> ctx
+                 (update-in [:bindings #'*boundv*]
+                            dec)
+                 (p/resolved)))}
+   bindings-handler])
+
+(deftest async-bindings-test
+  (fact "bindings are conveyed across interceptor chain"
+    (sc/execute bindings-chain {}) => 43))
+
diff --git a/test/cljc/sieppari/async/promesa_test.cljc b/test/cljc/sieppari/async/promesa_test.cljc
index 938e0b1..3b1e186 100644
--- a/test/cljc/sieppari/async/promesa_test.cljc
+++ b/test/cljc/sieppari/async/promesa_test.cljc
@@ -8,7 +8,7 @@
   (is (as/async? (p/promise 1))))
 
 #?(:clj
-   (deftest core-async-continue-cljs-callback-test
+   (deftest core-async-continue-clj-callback-test
      (let [respond (promise)
            p (p/create
                (fn [resolve _]
@@ -26,7 +26,7 @@
                               (done))))))))
 
 #?(:clj
-   (deftest core-async-catch-cljs-callback-test
+   (deftest core-async-catch-clj-callback-test
      (let [respond (promise)
            p (p/create
                (fn [_ reject]