From 38e860189737989f77d10dee362bc19e06f15600 Mon Sep 17 00:00:00 2001 From: Jose Gomez Date: Mon, 2 Sep 2024 10:55:47 -0500 Subject: [PATCH] feat: add new activation utility functions and utility binding macro, add more tests --- CHANGELOG.md | 7 +++++- README.md | 35 ++++++++++++++++++-------- dev/user.clj | 9 ++++--- src/hierarchy/core.clj | 36 ++++++++++++++++++++++----- test/hierarchy/core_test.clj | 48 +++++++++++++++++++++++++++++++----- 5 files changed, 108 insertions(+), 27 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d69a003..58714cd 100644 --- a/CHANGELOG.md +++ b/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. diff --git a/README.md b/README.md index d4e1960..fe72667 100644 --- a/README.md +++ b/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. diff --git a/dev/user.clj b/dev/user.clj index 09c6eff..dfe3b05 100644 --- a/dev/user.clj +++ b/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 diff --git a/src/hierarchy/core.clj b/src/hierarchy/core.clj index 24c4887..2369b62 100644 --- a/src/hierarchy/core.clj +++ b/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+))) diff --git a/test/hierarchy/core_test.clj b/test/hierarchy/core_test.clj index 31fd782..c57e71e 100644 --- a/test/hierarchy/core_test.clj +++ b/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)