Skip to content

Commit

Permalink
Remove :override metadata
Browse files Browse the repository at this point in the history 
Instead of :override metadata, instead differentiate between keys
generated from expansions, and keys set directly in the configuration.
Keys from expansions have a lower priority than keys from the
configuration.
  • Loading branch information
@weavejester
weavejester committed Aug 31, 2024
1 parent 13a44cf commit 99d8470
Show file tree
Hide file tree
Showing 2 changed files with 64 additions and 78 deletions.
100 changes: 49 additions & 51 deletions src/integrant/core.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -390,8 +390,6 @@
{:arglists '([key value])}
(fn [key _value] (normalize-key key)))

(defmethod expand-key :default [k v] ^:override {k v})

(defmulti init-key
"Turn a config value associated with a key into a concrete implementation.
For example, a database URL might be turned into a database connection."
Expand Down Expand Up @@ -478,76 +476,76 @@
(reduce-kv (fn [m k v] (assoc m k (if (keyset k) (prep-key k v) v)))
{} config))))

(defn- normal-map? [x]
(and (map? x) (not (reflike? x))))

(defn- nested-values [idx [k v]]
(if (and (normal-map? v) (seq v))
(mapcat #(nested-values (conj idx k) %) v)
(list {:index (conj idx k), :value v})))

(defn- converge-values [[k v]]
(let [override? (:override (meta v))]
(letfn [(gen-converges [idx [kn vn] override?]
(if (and (map? vn) (not (reflike? vn)) (seq vn))
(let [override? (or override? (:override (meta vn)))]
(mapcat #(gen-converges (conj idx kn) % override?) vn))
(list {:key k
:index (conj idx kn)
:value vn
:override? (and override? (not (map? vn)))})))]
(mapcat #(gen-converges [] % override?) v))))

(defn- one-element? [coll]
(and (seq coll) (nil? (next coll))))

(defn- converge-conflicts [converges]
(filter (fn [conflicts]
(and (next conflicts)
(not (one-element? (filter :override? conflicts)))))
(vals (group-by :index converges))))
(->> (mapcat #(nested-values [] %) v)
(map #(assoc % :key k))))

(defn- converge-conflicts [converges overrides]
(let [override-indexes (set (map :index overrides))]
(->> converges
(remove (comp override-indexes :index))
(group-by :index)
(vals)
(filter next))))

(defn- converge-conflict-exception [config expansions]
(let [index (-> expansions first :index)
keys (map :key expansions)]
(ex-info (str "Conflicting values at index " index " when converging: "
(str/join ", " keys) ". Use the ^:override metadata to "
"set the preferred value.")
(str/join ", " keys) ".")
{:reason ::conflicting-expands
:config config
:conflicting-index index
:expand-keys keys})))

(defn- find-in [m ks]
(if (next ks)
(-> (get-in m (butlast ks)) (find (last ks)))
(find m (first ks))))

(defn- assoc-converge [m {:keys [index value override?]}]
(if-some [[_ v] (find-in m index)]
(if (or override? (= v {})) (assoc-in m index value) m)
(assoc-in m index value)))
(defn- assoc-converge [m {:keys [index value]}]
(if (or (not= value {}) (= ::missing (get-in m index ::missing)))
(assoc-in m index value)
m))

(defn converge
"Deep-merge the values of a map. Raises an error on conflicting keys, unless
one (and only one) of the values is tagged with the `^:override` metadata."
[m]
{:pre [(map? m) (every? map? (vals m))]}
(let [converges (mapcat converge-values m)]
(when-let [conflict (first (converge-conflicts converges))]
(throw (converge-conflict-exception m conflict)))
(reduce assoc-converge {} converges)))
an override is specified via the override-map."
([m] (converge m {}))
([m override-map]
{:pre [(map? m) (every? map? (vals m))]}
(let [converges (mapcat converge-values m)
overrides (mapcat #(nested-values [] %) override-map)]
(when-let [conflict (first (converge-conflicts converges overrides))]
(throw (converge-conflict-exception m conflict)))
(reduce assoc-converge {} (concat converges overrides)))))

(defn- can-expand-key? [k]
(get-method expand-key (normalize-key k)))

(defn expand
"Expand modules in the config map prior to initiation. The [[expand-key]]
method is applied to each entry in the map, and the results deep-merged
together using [[converge]]to produce a new configuration.
If there are conflicting keys with different values, an exception will be
raised. Conflicts can be resolved by tagging one value with the `^:override`
metadata key."
method is applied to each entry in the map to create an expansion, and the
results are deep-merged together using [[converge]] to produce a new
configuration.
If two expansions generate different values for the same keys, an exception
will be raised. Configuration values that do not come from an expansion will
override keys from expansions, allowing conflicts to be resolved by user-
defined values."
([config]
(expand config (keys config)))
([config keys]
{:pre [(map? config)]}
(let [expand? (set keys)
expanded (into {} (for [[k v] config]
(if (expand? k)
[k (expand-key k v)]
[k {k v}])))]
(converge expanded))))
(let [key-set (set keys)
expand-key? (fn [[k _]] (and (key-set k) (can-expand-key? k)))]
(converge (->> (filter expand-key? config)
(reduce (fn [m [k v]] (assoc m k (expand-key k v))) {}))
(->> (remove expand-key? config)
(into {}))))))

(defn init
"Turn a config map into an system map. Keys are traversed in dependency
Expand Down
42 changes: 15 additions & 27 deletions test/integrant/core_test.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -256,34 +256,28 @@
{:x 1})))

(testing "overrides"
(is (= (ig/converge {:a {:x 1}, :b ^:override {:x 2}})
(is (= (ig/converge {:a {:x 1}, :b {:x 2}} {:x 2})
{:x 2}))
(is (= (ig/converge {:a {:x {:y 1}}, :b {:x ^:override {:y 2}}})
(is (= (ig/converge {:a {:x {:y 1}}, :b {:x {:y 2}}} {:x {:y 2}})
{:x {:y 2}}))
(is (= (ig/converge {:a {:x {:y 1}}, :b ^:override {:x {:y 2}}})
{:x {:y 2}})))
(is (= (ig/converge {:a {:x {:y 1}}, :b {:x {:y 2}}} {:x {:y 3}})
{:x {:y 3}})))

(testing "conflicts"
(is (thrown-with-msg?
#?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo)
(re-pattern (str "^Conflicting values at index "
"\\[:x\\] when converging: :a, :b. Use the "
"\\^:override metadata to set the preferred "
"value\\.$"))
"\\[:x\\] when converging: :a, :b\\."))
(ig/converge {:a {:x 1}, :b {:x 2}})))
(is (thrown-with-msg?
#?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo)
(re-pattern (str "^Conflicting values at index "
"\\[:x\\] when converging: :a, :b. Use the "
"\\^:override metadata to set the preferred "
"value\\.$"))
(ig/converge {:a ^:override {:x 1}, :b ^:override {:x 2}})))
"\\[:x\\] when converging: :a, :b\\."))
(ig/converge {:a {:x 1}, :b {:x 2}})))
(is (thrown-with-msg?
#?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo)
(re-pattern (str "^Conflicting values at index "
"\\[:x :y\\] when converging: :a, :b. Use the "
"\\^:override metadata to set the preferred "
"value\\.$"))
"\\[:x :y\\] when converging: :a, :b\\."))
(ig/converge {:a {:x {:y 1}}, :b {:x {:y 2, :z 3}}})))))

(deftest expand-test
Expand All @@ -304,12 +298,10 @@
(is (= (ig/expand {::mod 1, ::b {:x 1}, ::c 2})
{::a 1, ::b {:v 1, :x 1}, ::c 2})))
(testing "expand with direct override"
(is (= (ig/expand {::mod {:x 1}, ::a ^:override {:x 2}})
(is (= (ig/expand {::mod {:x 1}, ::a {:x 2}})
{::a {:x 2}, ::b {:v {:x 1}}})))
(testing "expand with nested override"
(is (= (ig/expand {::mod {:x 1, :y 1}, ::mod-a ^:override {:y 2}})
{::a {:x 1, :y 2}, ::b {:v {:x 1, :y 1}}}))
(is (= (ig/expand {::mod-c 1, ::c ^:override {:x {:y {:z 2}}}})
(is (= (ig/expand {::mod-c 1, ::c {:x {:y {:z 2}}}})
{::c {:x {:y {:z 2}}}})))
(testing "expand with default override"
(is (= (ig/expand {::mod 1, ::a 2}) {::a 2, ::b {:v 1}}))
Expand All @@ -320,29 +312,25 @@
(re-pattern (str "^Conflicting values at index "
"\\[:integrant\\.core-test/a\\] "
"when converging: :integrant\\.core-test/mod, "
":integrant\\.core-test/mod-a\\. Use the "
"\\^:override metadata to set the preferred "
"value\\.$"))
":integrant\\.core-test/mod-a\\."))
(ig/expand {::mod 1, ::mod-a 2}))))
(testing "unresolved conflicting nested index"
(is (thrown-with-msg?
#?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo)
(re-pattern (str "^Conflicting values at index "
"\\[:integrant\\.core-test/b :v\\] "
"when converging: :integrant\\.core-test/mod, "
":integrant\\.core-test/mod-b\\. Use the "
"\\^:override metadata to set the preferred "
"value\\.$"))
":integrant\\.core-test/mod-b\\."))
(ig/expand {::mod 1, ::mod-b 2}))))
(testing "resolved conflict"
(is (= (ig/expand {::mod {:x 1}, ::mod-a {:x 2}, ::a ^:override {:x 3}})
(is (= (ig/expand {::mod {:x 1}, ::mod-a {:x 2}, ::a {:x 3}})
{::a {:x 3}, ::b {:v {:x 1}}})))
(testing "resolved nested conflict"
(is (= (ig/expand {::mod 1, ::mod-b 2, ::b ^:override {:v 3}})
(is (= (ig/expand {::mod 1, ::mod-b 2, ::b {:v 3}})
{::a 1, ::b {:v 3}}))
(is (= (ig/expand {[::one ::mod-c] 1
[::two ::mod-c] 2
::c ^:override {:x {:y {:z 3}}}})
::c {:x {:y {:z 3}}}})
{::c {:x {:y {:z 3}}}})))
(testing "expand with refs"
(let [m {::a (ig/ref ::b) ::b 1}]
Expand Down

0 comments on commit 99d8470

Please sign in to comment.