empty selectors and nil count as identity path now fixing #5, remove IDENTITY-PATH in favor of nil

This commit is contained in:
Nathan Marz 2015-05-31 08:50:00 -04:00
parent 228a949ac1
commit 50576e447b
3 changed files with 82 additions and 55 deletions

View file

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

View file

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

View file

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