diff --git a/src/clj/com/rpl/specter.clj b/src/clj/com/rpl/specter.clj index 9c627cd..7dc81a1 100644 --- a/src/clj/com/rpl/specter.clj +++ b/src/clj/com/rpl/specter.clj @@ -124,6 +124,8 @@ (def FIRST (->FirstStructurePath)) +(def IDENTITY-PATH (->IdentityPath)) + (defn srange-dynamic [start-fn end-fn] (->SRangePath start-fn end-fn)) (defn srange [start end] (srange-dynamic (fn [_] start) (fn [_] end))) @@ -180,3 +182,13 @@ (defn collect-one [& selector] (->SelectCollector select-one (comp-paths* selector))) + +(defn putval + "Adds an external value to the collected vals. Useful when additional arguments + are required to the update function that would otherwise require partial + application or a wrapper function. + + e.g., incrementing val at path [:a :b] by 3: + (update [:a :b (putval 3)] + some-map)" + [val] + (->PutValCollector val)) diff --git a/src/clj/com/rpl/specter/impl.clj b/src/clj/com/rpl/specter/impl.clj index 7e971af..82135f0 100644 --- a/src/clj/com/rpl/specter/impl.clj +++ b/src/clj/com/rpl/specter/impl.clj @@ -448,5 +448,21 @@ (->> structure ((.view-fn this)) next-fn) )) +(deftype IdentityPath []) +(extend-protocol StructurePath + IdentityPath + (select* [this structure next-fn] + (next-fn structure)) + (update* [this structure next-fn] + (next-fn structure) + )) + +(deftype PutValCollector [val]) + +(extend-protocol Collector + PutValCollector + (collect-val [^PutValCollector this structure] + (.val this) + )) diff --git a/test/clj/com/rpl/specter/core_test.clj b/test/clj/com/rpl/specter/core_test.clj index ad0aaae..2e45c7a 100644 --- a/test/clj/com/rpl/specter/core_test.clj +++ b/test/clj/com/rpl/specter/core_test.clj @@ -227,3 +227,21 @@ [:a] [[1 3 5] [2] [7 11 4 2] [10 1] []] )))) + +(defspec identity-test + (for-all+ + [i gen/int + afn (gen/elements [inc dec])] + (and (= [i] (select IDENTITY-PATH i)) + (= (afn i) (update IDENTITY-PATH afn i))))) + +(defspec putval-test + (for-all+ + [kw gen/keyword + m (max-size 10 (gen-map-with-keys gen/keyword gen/int kw)) + c gen/int] + (= (update [(putval c) kw] + m) + (update [kw (putval c)] + m) + (assoc m kw (+ c (get m kw))) + ))) +