added putval and IDENTITY-PATH selectors

This commit is contained in:
Nathan Marz 2015-05-27 01:02:19 -04:00
parent 96c5db7a35
commit 6bae041970
3 changed files with 46 additions and 0 deletions

View file

@ -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))

View file

@ -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)
))

View file

@ -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)))
)))