v/handle-fn and test watching.

hanjos · Nov 30, 2023 · cc1441b · cc1441b
1 parent b07424e
commit cc1441b
Show file tree

Hide file tree

Showing 3 changed files with 59 additions and 26 deletions.
diff --git a/deps.edn b/deps.edn
@@ -3,30 +3,38 @@
  :deps      {}
 
  :aliases
- {:test     {:extra-paths ["test"]}
+ {:test   {:extra-paths ["test"]}
 
   ;; clojure -X:test:runner
   ;; clojure -X:test:runner :fail-fast? false
-  :runner   {:extra-deps {lambdaisland/kaocha {:mvn/version "1.87.1366"}
-                          lambdaisland/kaocha-cloverage {:mvn/version "1.1.89"}}
-             :exec-fn    kaocha.runner/exec-fn
-             :exec-args  {:kaocha/reporter [kaocha.report/documentation]
-                          :kaocha/plugins  [:kaocha.plugin/profiling
-                                            :kaocha.plugin/cloverage]}
-             :jvm-opts   ["-XX:-OmitStackTraceInFastThrow"]}
+  :runner {:extra-deps {lambdaisland/kaocha           {:mvn/version "1.87.1366"}
+                        lambdaisland/kaocha-cloverage {:mvn/version "1.1.89"}}
+           :exec-fn    kaocha.runner/exec-fn
+           :exec-args  {:kaocha/reporter [kaocha.report/documentation]
+                        :kaocha/plugins  [:kaocha.plugin/profiling
+                                          :kaocha.plugin/cloverage]}
+           :jvm-opts   ["-XX:-OmitStackTraceInFastThrow"]}
+
+  ;; clojure -X:test:runner:watch
+  :watch  {:exec-args {:watch?          true
+                       :skip-meta       :slow
+                       :fail-fast?      true
+                       :kaocha/reporter [kaocha.report/documentation]
+                       :kaocha/plugins  [:kaocha.plugin/profiling
+                                         :kaocha.plugin/cloverage]}}
 
   ;; clojure -T:build <fn> <opts>
-  :build    {:extra-paths ["src"] ; XXX required for codox
-             :deps        {io.github.clojure/tools.build {:mvn/version "0.9.6"}
-                           codox/codox                   {:mvn/version "0.10.8"}}
-             :ns-default  build}
+  :build  {:extra-paths ["src"] ; XXX required for codox
+           :deps        {io.github.clojure/tools.build {:mvn/version "0.9.6"}
+                         codox/codox                   {:mvn/version "0.10.8"}}
+           :ns-default  build}
 
   ;; clojure -M:build:test:repl
-  :repl     {:extra-deps {nrepl/nrepl       {:mvn/version "1.0.0"}
-                          cider/cider-nrepl {:mvn/version "0.40.0"}}
-             :main-opts  ["-m" "nrepl.cmdline"
-                          "--color" "--interactive"
-                          "--middleware" "[cider.nrepl/cider-middleware]"]}}
+  :repl   {:extra-deps {nrepl/nrepl       {:mvn/version "1.0.0"}
+                        cider/cider-nrepl {:mvn/version "0.40.0"}}
+           :main-opts  ["-m" "nrepl.cmdline"
+                        "--color" "--interactive"
+                        "--middleware" "[cider.nrepl/cider-middleware]"]}}
 
  ;; XXX required for GitHub Packages
  :mvn/repos {"github" {:url       "https://maven.pkg.github.com/hanjos/conditio-clj"

diff --git a/src/org/sbrubbles/conditio/vars.clj b/src/org/sbrubbles/conditio/vars.clj
@@ -101,17 +101,35 @@
                       (recur (conj (conj ret `(var ~(first vvs))) (second vvs))
                              (next (next vvs)))
                       (seq ret))))]
-    `(let [merge-bindings# (fn [chain-map# bindings#]
-                             (reduce-kv (fn [acc# k# v#]
-                                          (assoc acc# k# (if (contains? acc# k#)
-                                                           (conj (get acc# k#) v#)
-                                                           (list v#))))
-                                        chain-map#
-                                        bindings#))]
-       (binding [*handlers* (merge-bindings# *handlers*
-                                             (hash-map ~@(var-ize bindings)))]
+    `(let [merge# (fn [chain-map# bindings#]
+                    (reduce-kv (fn [acc# k# v#]
+                                 (assoc acc# k# (if (contains? acc# k#)
+                                                  (conj (get acc# k#) v#)
+                                                  (list v#))))
+                               chain-map#
+                               bindings#))]
+       (binding [*handlers* (merge# *handlers*
+                                    (hash-map ~@(var-ize bindings)))]
          ~@body))))
 
+(defn handle-fn
+  "Returns a function, which will install the given handlers (in a
+  var-function map) and then run `f`.
+
+  This may be used to define a helper function which runs on a different
+  thread, but needs the given handlers in place."
+  [binding-map f]
+  (let [merge-bindings (fn [chain-map# bindings#]
+                         (reduce-kv (fn [acc# k# v#]
+                                      (assoc acc# k# (if (contains? acc# k#)
+                                                       (conj (get acc# k#) v#)
+                                                       (list v#))))
+                                    chain-map#
+                                    bindings#))]
+    (with-bindings*
+      {#'*handlers* (merge-bindings *handlers* binding-map)}
+      (fn [] (bound-fn* f)))))
+
 (defn restart
   "Searches for a restart mapped to `option`, and then runs it with `args`.
 
@@ -146,6 +164,7 @@
 
 (defn with-fn
   "Returns a function, which will install the given restarts and then run `f`.
+  
   This may be used to define a helper function which runs on a different
   thread, but needs the given restarts in place."
   [binding-map f]

diff --git a/test/org/sbrubbles/conditio/vars_test.clj b/test/org/sbrubbles/conditio/vars_test.clj
@@ -86,6 +86,12 @@
            (c 1 2 3)
            (list 1 2 3))))
 
+  (let [c-prime (v/handle-fn {#'c list}
+                             (fn [& args]
+                               (apply c args)))]
+    (is (= (c-prime 1 2 3)
+           (list 1 2 3))))
+
   (is (thrown? ExceptionInfo (c 1 2 3))))
 
 (deftest restarting