empty selectors and nil count as identity path now fixing #5, remove IDENTITY-PATH in favor of nil
This commit is contained in:
parent
228a949ac1
commit
50576e447b
3 changed files with 82 additions and 55 deletions
|
|
@ -124,8 +124,6 @@
|
||||||
|
|
||||||
(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)))
|
||||||
|
|
@ -184,7 +182,7 @@
|
||||||
(->SelectCollector select-one (comp-paths* selector)))
|
(->SelectCollector select-one (comp-paths* selector)))
|
||||||
|
|
||||||
(defn putval
|
(defn putval
|
||||||
"Adds an external value to the collected vals. Useful when additional arguments
|
"Adds an external value to the collected vals. Useful when additional arguments
|
||||||
are required to the update function that would otherwise require partial
|
are required to the update function that would otherwise require partial
|
||||||
application or a wrapper function.
|
application or a wrapper function.
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -50,8 +50,8 @@
|
||||||
(defn no-prot-error-str [obj]
|
(defn no-prot-error-str [obj]
|
||||||
(str "Protocol implementation cannot be found for object.
|
(str "Protocol implementation cannot be found for object.
|
||||||
Extending Specter protocols should not be done inline in a deftype definition
|
Extending Specter protocols should not be done inline in a deftype definition
|
||||||
because that prevents Specter from finding the protocol implementations for
|
because that prevents Specter from finding the protocol implementations for
|
||||||
optimized performance. Instead, you should extend the protocols via an
|
optimized performance. Instead, you should extend the protocols via an
|
||||||
explicit extend-protocol call. \n" obj))
|
explicit extend-protocol call. \n" obj))
|
||||||
|
|
||||||
(defn find-protocol-impl! [prot obj]
|
(defn find-protocol-impl! [prot obj]
|
||||||
|
|
@ -85,7 +85,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn structure-path-impl [this]
|
(defn structure-path-impl [this]
|
||||||
(if (fn? this)
|
(if (fn? this)
|
||||||
;;TODO: this isn't kosher, it uses knowledge of internals of protocols
|
;;TODO: this isn't kosher, it uses knowledge of internals of protocols
|
||||||
(-> StructurePath :impls (get clojure.lang.AFn))
|
(-> StructurePath :impls (get clojure.lang.AFn))
|
||||||
(find-protocol-impl! StructurePath this)))
|
(find-protocol-impl! StructurePath this)))
|
||||||
|
|
@ -121,6 +121,9 @@
|
||||||
(or (fn? obj) (obj-extends? StructurePath obj)))
|
(or (fn? obj) (obj-extends? StructurePath obj)))
|
||||||
|
|
||||||
(extend-protocol CoerceTransformFunctions
|
(extend-protocol CoerceTransformFunctions
|
||||||
|
nil ; needs its own path because it doesn't count as an Object
|
||||||
|
(coerce-path [this]
|
||||||
|
(coerce-structure-path nil))
|
||||||
|
|
||||||
TransformFunctions
|
TransformFunctions
|
||||||
(coerce-path [this]
|
(coerce-path [this]
|
||||||
|
|
@ -145,30 +148,32 @@
|
||||||
))
|
))
|
||||||
|
|
||||||
(defn- combine-same-types [[^TransformFunctions f & _ :as all]]
|
(defn- combine-same-types [[^TransformFunctions f & _ :as all]]
|
||||||
(let [^ExecutorFunctions exs (.executors f)
|
(if (empty? all)
|
||||||
|
(coerce-path nil)
|
||||||
t (.type exs)
|
(let [^ExecutorFunctions exs (.executors f)
|
||||||
|
|
||||||
combiner
|
t (.type exs)
|
||||||
(if (= t :svalspath)
|
|
||||||
(fn [curr next]
|
combiner
|
||||||
(fn [vals structure next-fn]
|
(if (= t :svalspath)
|
||||||
(curr vals structure
|
(fn [curr next]
|
||||||
(fn [vals-next structure-next]
|
(fn [vals structure next-fn]
|
||||||
(next vals-next structure-next next-fn)
|
(curr vals structure
|
||||||
))))
|
(fn [vals-next structure-next]
|
||||||
(fn [curr next]
|
(next vals-next structure-next next-fn)
|
||||||
(fn [structure next-fn]
|
))))
|
||||||
(curr structure (fn [structure] (next structure next-fn)))))
|
(fn [curr next]
|
||||||
)]
|
(fn [structure next-fn]
|
||||||
|
(curr structure (fn [structure] (next structure next-fn)))))
|
||||||
(reduce (fn [^TransformFunctions curr ^TransformFunctions next]
|
)]
|
||||||
(->TransformFunctions
|
|
||||||
exs
|
(reduce (fn [^TransformFunctions curr ^TransformFunctions next]
|
||||||
(combiner (.selector curr) (.selector next))
|
(->TransformFunctions
|
||||||
(combiner (.updater curr) (.updater next))
|
exs
|
||||||
))
|
(combiner (.selector curr) (.selector next))
|
||||||
all)))
|
(combiner (.updater curr) (.updater next))
|
||||||
|
))
|
||||||
|
all))))
|
||||||
|
|
||||||
(defn coerce-structure-vals [^TransformFunctions tfns]
|
(defn coerce-structure-vals [^TransformFunctions tfns]
|
||||||
(if (= (extype tfns) :svalspath)
|
(if (= (extype tfns) :svalspath)
|
||||||
|
|
@ -209,14 +214,14 @@
|
||||||
:else (throw-illegal (no-prot-error-str this))
|
:else (throw-illegal (no-prot-error-str this))
|
||||||
))
|
))
|
||||||
|
|
||||||
;;this composes paths together much faster than comp-paths* but the resulting composition
|
;;this composes paths together much faster than comp-paths* but the resulting composition
|
||||||
;;won't execute as fast. Useful for when select/update are used without pre-compiled paths
|
;;won't execute as fast. Useful for when select/update are used without pre-compiled paths
|
||||||
;;(where cost of compiling dominates execution time)
|
;;(where cost of compiling dominates execution time)
|
||||||
(defn comp-unoptimal [sp]
|
(defn comp-unoptimal [sp]
|
||||||
(if (instance? java.util.List sp)
|
(if (instance? java.util.List sp)
|
||||||
(->> sp
|
(->> sp
|
||||||
(map (fn [p] (-> p coerce-structure-vals-direct)))
|
(map (fn [p] (-> p coerce-structure-vals-direct)))
|
||||||
combine-same-types)
|
combine-same-types)
|
||||||
(coerce-path sp)))
|
(coerce-path sp)))
|
||||||
|
|
||||||
;; cell implementation idea taken from prismatic schema library
|
;; cell implementation idea taken from prismatic schema library
|
||||||
|
|
@ -272,8 +277,8 @@
|
||||||
|
|
||||||
(defn- walk-until [pred on-match-fn structure]
|
(defn- walk-until [pred on-match-fn structure]
|
||||||
(if (pred structure)
|
(if (pred structure)
|
||||||
(on-match-fn structure)
|
(on-match-fn structure)
|
||||||
(walk/walk (partial walk-until pred on-match-fn) identity structure)
|
(walk/walk (partial walk-until pred on-match-fn) identity structure)
|
||||||
))
|
))
|
||||||
|
|
||||||
(defn- fn-invocation? [f]
|
(defn- fn-invocation? [f]
|
||||||
|
|
@ -285,7 +290,7 @@
|
||||||
(if (pred structure)
|
(if (pred structure)
|
||||||
(on-match-fn structure)
|
(on-match-fn structure)
|
||||||
(let [ret (walk/walk (partial codewalk-until pred on-match-fn) identity structure)]
|
(let [ret (walk/walk (partial codewalk-until pred on-match-fn) identity structure)]
|
||||||
(if (and (fn-invocation? structure) (fn-invocation? ret))
|
(if (and (fn-invocation? structure) (fn-invocation? ret))
|
||||||
(with-meta ret (meta structure))
|
(with-meta ret (meta structure))
|
||||||
ret
|
ret
|
||||||
))))
|
))))
|
||||||
|
|
@ -314,7 +319,7 @@
|
||||||
[(conj s e) (assoc m pos i)]
|
[(conj s e) (assoc m pos i)]
|
||||||
orig
|
orig
|
||||||
)))
|
)))
|
||||||
[[] {}]
|
[[] {}]
|
||||||
(range (count aseq))
|
(range (count aseq))
|
||||||
)))
|
)))
|
||||||
|
|
||||||
|
|
@ -410,7 +415,7 @@
|
||||||
))
|
))
|
||||||
|
|
||||||
(deftype SelectCollector [sel-fn selector])
|
(deftype SelectCollector [sel-fn selector])
|
||||||
|
|
||||||
(extend-protocol Collector
|
(extend-protocol Collector
|
||||||
SelectCollector
|
SelectCollector
|
||||||
(collect-val [^SelectCollector this structure]
|
(collect-val [^SelectCollector this structure]
|
||||||
|
|
@ -448,16 +453,6 @@
|
||||||
(->> 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])
|
(deftype PutValCollector [val])
|
||||||
|
|
||||||
(extend-protocol Collector
|
(extend-protocol Collector
|
||||||
|
|
@ -466,3 +461,11 @@
|
||||||
(.val this)
|
(.val this)
|
||||||
))
|
))
|
||||||
|
|
||||||
|
|
||||||
|
(extend-protocol StructurePath
|
||||||
|
nil
|
||||||
|
(select* [this structure next-fn]
|
||||||
|
(next-fn structure))
|
||||||
|
(update* [this structure next-fn]
|
||||||
|
(next-fn structure)
|
||||||
|
))
|
||||||
|
|
|
||||||
|
|
@ -232,16 +232,42 @@
|
||||||
(for-all+
|
(for-all+
|
||||||
[i gen/int
|
[i gen/int
|
||||||
afn (gen/elements [inc dec])]
|
afn (gen/elements [inc dec])]
|
||||||
(and (= [i] (select IDENTITY-PATH i))
|
(and (= [i] (select nil i))
|
||||||
(= (afn i) (update IDENTITY-PATH afn i)))))
|
(= (afn i) (update nil afn i)))))
|
||||||
|
|
||||||
(defspec putval-test
|
(defspec putval-test
|
||||||
(for-all+
|
(for-all+
|
||||||
[kw gen/keyword
|
[kw gen/keyword
|
||||||
m (max-size 10 (gen-map-with-keys gen/keyword gen/int kw))
|
m (max-size 10 (gen-map-with-keys gen/keyword gen/int kw))
|
||||||
c gen/int]
|
c gen/int]
|
||||||
(= (update [(putval c) kw] + m)
|
(= (update [(putval c) kw] + m)
|
||||||
(update [kw (putval c)] + m)
|
(update [kw (putval c)] + m)
|
||||||
(assoc m kw (+ c (get m kw)))
|
(assoc m kw (+ c (get m kw)))
|
||||||
)))
|
)))
|
||||||
|
|
||||||
|
(defspec empty-selector-test
|
||||||
|
(for-all+
|
||||||
|
[v (gen/vector gen/int)]
|
||||||
|
(= [v]
|
||||||
|
(select [] v)
|
||||||
|
(select nil v)
|
||||||
|
(select (comp-paths) v)
|
||||||
|
(select (comp-paths nil) v)
|
||||||
|
(select [nil nil nil] v)
|
||||||
|
)))
|
||||||
|
|
||||||
|
(defspec empty-selector-update-test
|
||||||
|
(for-all+
|
||||||
|
[kw gen/keyword
|
||||||
|
m (max-size 10 (gen-map-with-keys gen/keyword gen/int kw))]
|
||||||
|
(and (= m
|
||||||
|
(update nil identity m)
|
||||||
|
(update [] identity m)
|
||||||
|
(update (comp-paths []) identity m)
|
||||||
|
(update (comp-paths nil nil) identity m)
|
||||||
|
)
|
||||||
|
(= (update kw inc m)
|
||||||
|
(update [nil kw] inc m)
|
||||||
|
(update (comp-paths kw nil) inc m)
|
||||||
|
(update (comp-paths nil kw nil) inc m)
|
||||||
|
))))
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue