feat: add new activation utility functions and utility binding macro,…

… add more tests

CHANGELOG.md

@@ -1,4 +1,9 @@
 This is a history of changes to k13labs/hierarchy
 
-# 0.1.0
+# 0.0.2 - 2024-09-02
+* Removed default alter-var-root in `core` namespace, user code must now invoke `activate!` manually.
+* Add utility functions `activate!` and `deactivate!` to alter the `derive` and `underive` var bindings.
+* Add utility macro `hierarchy.core/bound` to redef the `derive` and `underive` var bindings at runtime.
+
+# 0.0.1 - 2024-09-01
 * The initial release.

README.md

@@ -8,22 +8,37 @@ or that child must be either a namespace-qualified symbol or keyword or a class.
 
 # _Usage_
 
-Here's a simple example.
+Here's are a couple of examples.
 
 ```clj
 (ns user
-  (:require [hierarchy.core]))
+  (:require [hierarchy.core :as h]))
 
-;;; using global hierarchy
-(derive :bar :that)
+;;; using with a hierarchy
+(-> (make-hierarchy)
+    (h/derive+ :bar [:that "thing"])
+    (h/derive+ :foo :bar)
+    (isa? :foo [:that "thing"])) ;; => true
+
+;;; using global hierarchy via `derive+` and `underive+` directly
+(h/derive+ :bar [:that "thing"])
+(h/derive+ :foo :bar)
+(isa? :foo [:that "thing"]) ;; => true
+
+;;; using global hierarchy with redef'd `derive` and `underive` using `bound`
+(h/bound ;;; this allows more precise use where needed
+  (derive :bar [:that "thing"])
+  (derive :foo :bar)
+  (isa? :foo [:that "thing"])) ;; => true
+
+;;; using global hierarchy with altered `derive` and `underive` vars using `activate!`
+(h/activate!) ;;; your application can activate global bindings
+
+(derive :bar [:that "thing"])
 (derive :foo :bar)
-(isa? :foo :bar) ;; => true
+(isa? :foo [:that "thing"]) ;; => true
 
-;;; using via make-hierarchy
-(-> (make-hierarchy)
-    (derive :bar :that)
-    (derive :foo :bar)
-    (isa? :foo :bar)) ;; => true
+(h/deactivate!) ;;; this exists mainly for testing
 ```
 
 See the existing tests for more examples.

dev/user.clj

@@ -1,5 +1,6 @@
 (ns user
-  (:require [criterium.core :refer [report-result
+  (:require [hierarchy.core :as h]
+            [criterium.core :refer [report-result
                                     with-progress-reporting
                                     quick-benchmark] :as crit]))
 
@@ -8,9 +9,9 @@
    (with-progress-reporting
      (quick-benchmark
       (-> (make-hierarchy)
-          (derive :bar :that)
-          (derive :foo :bar)
-          (isa? :foo :bar))
+          (h/derive+ :bar [:that "thing"])
+          (h/derive+ :foo :bar)
+          (isa? :foo [:that "thing"]))
       {:verbose true})))) ;; => true
 
 (comment

src/hierarchy/core.clj

@@ -1,6 +1,36 @@
 (ns hierarchy.core
   (:require [clojure.core :as core]))
 
+(declare derive+ underive+)
+
+(defonce ^:private activation-map
+  (delay
+    {#'core/derive [derive derive+]
+     #'core/underive [underive underive+]}))
+
+(defn activate!
+  "Replaces clojure.core's `derive` and `underive` with `derive+` and `underive+` respectively via alter-var-root"
+  []
+  (doseq [[v [_ f]] @activation-map]
+    (alter-var-root v (constantly f)))
+  {#'core/derive core/derive
+   #'core/underive core/underive})
+
+(defn deactivate!
+  "Restores clojure.core's `derive` and `underive` respectively via alter-var-root"
+  []
+  (doseq [[v [f _]] @activation-map]
+    (alter-var-root v (constantly f)))
+  {#'core/derive core/derive
+   #'core/underive core/underive})
+
+(defmacro bound
+  "Dynamically binds clojure.core's `derive` and `underive` with `derive+` and `underive+` respectively via `with-bindings`."
+  [& body]
+  `(with-redefs [core/derive derive+
+                 core/underive underive+]
+     ~@body))
+
 (defn derive+
   "Establishes a parent/child relationship between parent and tag.
   Unlike `clojure.core/underive`, there is no requirement that
@@ -62,9 +92,3 @@
                (core/make-hierarchy)
                deriv-seq)
        h))))
-
-(when (not= core/derive derive+)
-  (alter-var-root #'core/derive (constantly derive+)))
-
-(when (not= core/underive underive+)
-  (alter-var-root #'core/underive (constantly underive+)))

test/hierarchy/core_test.clj

@@ -25,12 +25,21 @@
    [:vector hierarchy-id]
    hierarchy-id])
 
-(deftest hierarchy-bindings-are-installed-test
+(deftest hierarchy-bindings-are-active-global-test
+  (h/activate!)
   (testing "derive is installed"
     (is (= h/derive+ derive)))
   (testing "underive is installed"
     (is (= h/underive+ underive))))
 
+(deftest hierarchy-bindings-are-active-bound-test
+  (h/deactivate!)
+  (h/bound
+   (testing "derive is installed"
+     (is (= h/derive+ derive)))
+   (testing "underive is installed"
+     (is (= h/underive+ underive)))))
+
 (defspec derive-tests
   1000
   (prop/for-all
@@ -39,8 +48,20 @@
            :descendants {that #{bar foo}, bar #{foo}},
            :ancestors {bar #{that}, foo #{bar that}}}
           (-> (make-hierarchy)
-              (derive bar that)
-              (derive foo bar))))))
+              (h/derive+ bar that)
+              (h/derive+ foo bar))))))
+
+(defspec derive-bound-tests
+  1000
+  (prop/for-all
+   [[foo bar that] (gen/vector-distinct (mg/generator hierarchy-member) {:num-elements 3})]
+   (h/bound
+    (is (= {:parents {bar #{that}, foo #{bar}},
+            :descendants {that #{bar foo}, bar #{foo}},
+            :ancestors {bar #{that}, foo #{bar that}}}
+           (-> (make-hierarchy)
+               (derive bar that)
+               (derive foo bar)))))))
 
 (defspec underive-tests
   1000
@@ -50,9 +71,22 @@
            :descendants {bar #{foo}},
            :ancestors {foo #{bar}}}
           (-> (make-hierarchy)
-              (derive bar that)
-              (derive foo bar)
-              (underive bar that))))))
+              (h/derive+ bar that)
+              (h/derive+ foo bar)
+              (h/underive+ bar that))))))
+
+(defspec underive-bound-tests
+  1000
+  (prop/for-all
+   [[foo bar that] (gen/vector-distinct (mg/generator hierarchy-member) {:num-elements 3})]
+   (h/bound
+    (is (= {:parents {foo #{bar}},
+            :descendants {bar #{foo}},
+            :ancestors {foo #{bar}}}
+           (-> (make-hierarchy)
+               (derive bar that)
+               (derive foo bar)
+               (underive bar that)))))))
 
 (defn- reset-global-hierarchy!
   []
@@ -66,6 +100,7 @@
   1000
   (prop/for-all
    [[foo bar that] (gen/vector-distinct (mg/generator hierarchy-member) {:num-elements 3})]
+   (h/activate!)
    (reset-global-hierarchy!)
    (derive bar that)
    (derive foo bar)
@@ -79,6 +114,7 @@
   1000
   (prop/for-all
    [[foo bar that] (gen/vector-distinct (mg/generator hierarchy-member) {:num-elements 3})]
+   (h/activate!)
    (reset-global-hierarchy!)
    (derive bar that)
    (derive foo bar)