added putval and IDENTITY-PATH selectors
This commit is contained in:
parent
96c5db7a35
commit
6bae041970
3 changed files with 46 additions and 0 deletions
|
|
@ -124,6 +124,8 @@
|
||||||
|
|
||||||
(def FIRST (->FirstStructurePath))
|
(def FIRST (->FirstStructurePath))
|
||||||
|
|
||||||
|
(def IDENTITY-PATH (->IdentityPath))
|
||||||
|
|
||||||
(defn srange-dynamic [start-fn end-fn] (->SRangePath start-fn end-fn))
|
(defn srange-dynamic [start-fn end-fn] (->SRangePath start-fn end-fn))
|
||||||
|
|
||||||
(defn srange [start end] (srange-dynamic (fn [_] start) (fn [_] end)))
|
(defn srange [start end] (srange-dynamic (fn [_] start) (fn [_] end)))
|
||||||
|
|
@ -180,3 +182,13 @@
|
||||||
|
|
||||||
(defn collect-one [& selector]
|
(defn collect-one [& selector]
|
||||||
(->SelectCollector select-one (comp-paths* 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))
|
||||||
|
|
|
||||||
|
|
@ -448,5 +448,21 @@
|
||||||
(->> structure ((.view-fn this)) next-fn)
|
(->> 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)
|
||||||
|
))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -227,3 +227,21 @@
|
||||||
[:a]
|
[:a]
|
||||||
[[1 3 5] [2] [7 11 4 2] [10 1] []]
|
[[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)))
|
||||||
|
)))
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue