luciano/specter
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

reformat code with parinfer

Browse source
This commit is contained in:
Nathan Marz 2016-08-11 10:13:27 -04:00
parent 87137c633d
commit ac3f604211
18 changed files with 1281 additions and 1294 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
project.clj
View file

@ -1,9 +1,9 @@
(def VERSION (.trim (slurp "VERSION"))) (def VERSION (.trim (slurp "VERSION")))
(defproject com.rpl/specter VERSION (defproject com.rpl/specter VERSION
:jvm-opts ["-XX:-OmitStackTraceInFastThrow" ; this prevents JVM from doing optimizations which can remove stack traces from NPE and other exceptions :jvm-opts ["-XX:-OmitStackTraceInFastThrow"] ; this prevents JVM from doing optimizations which can remove stack traces from NPE and other exceptions
;"-agentpath:/Applications/YourKit_Java_Profiler_2015_build_15056.app/Contents/Resources/bin/mac/libyjpagent.jnilib" ;"-agentpath:/Applications/YourKit_Java_Profiler_2015_build_15056.app/Contents/Resources/bin/mac/libyjpagent.jnilib"]
]
:source-paths ["src/clj"] :source-paths ["src/clj"]
:java-source-paths ["src/java"] :java-source-paths ["src/java"]
:test-paths ["test", "target/test-classes"] :test-paths ["test", "target/test-classes"]
@ -18,15 +18,14 @@
com.rpl.specter.transients] com.rpl.specter.transients]
:source-uri :source-uri
{#"target/classes" "https://github.com/nathanmarz/specter/tree/{version}/src/clj/{classpath}x#L{line}" {#"target/classes" "https://github.com/nathanmarz/specter/tree/{version}/src/clj/{classpath}x#L{line}"
#".*" "https://github.com/nathanmarz/specter/tree/{version}/src/clj/{classpath}#L{line}" #".*" "https://github.com/nathanmarz/specter/tree/{version}/src/clj/{classpath}#L{line}"}}
}
}
:profiles {:dev {:dependencies :profiles {:dev {:dependencies
[[org.clojure/test.check "0.7.0"] [[org.clojure/test.check "0.7.0"]
[org.clojure/clojure "1.7.0"] [org.clojure/clojure "1.7.0"]
[org.clojure/clojurescript "1.7.10"]] [org.clojure/clojurescript "1.7.10"]]}
}
:test {:dependencies [[org.clojure/clojure "1.7.0"]]} :test {:dependencies [[org.clojure/clojure "1.7.0"]]}}
}
:aliases {"deploy" ["do" "clean," "deploy" "clojars"]} :aliases {"deploy" ["do" "clean," "deploy" "clojars"]})
)

14
repl.clj
View file

@ -6,13 +6,13 @@
{:output-to "out/main.js" {:output-to "out/main.js"
:verbose true :verbose true
:warning-handlers [(fn [warning-type env extra] :warning-handlers [(fn [warning-type env extra]
(when (warning-type cljs.analyzer/*cljs-warnings*) (when (warning-type cljs.analyzer/*cljs-warnings*)
(when-let [s (cljs.analyzer/error-message warning-type extra)] (when-let [s (cljs.analyzer/error-message warning-type extra)]
(binding [*out* *err*] (binding [*out* *err*]
(println "WARNING:" (cljs.analyzer/message env s)) (println "WARNING:" (cljs.analyzer/message env s))
(println "Failed to build because of warning!") (println "Failed to build because of warning!"))
)
(System/exit 1))))]}) (System/exit 1))))]})
(cljs.repl/repl (cljs.repl.node/repl-env) (cljs.repl/repl (cljs.repl.node/repl-env)
:watch "target/classes/com/rpl" :watch "target/classes/com/rpl"

87
scripts/benchmarks.clj
View file

@ -3,8 +3,8 @@
[com.rpl.specter macros] [com.rpl.specter macros]
[com.rpl.specter.transients] [com.rpl.specter.transients]
[com.rpl.specter.impl :only [benchmark]]) [com.rpl.specter.impl :only [benchmark]])
(:require [clojure.walk :as walk]) (:require [clojure.walk :as walk]))
)
;; run via `lein repl` with `(load-file "scripts/benchmarks.clj")` ;; run via `lein repl` with `(load-file "scripts/benchmarks.clj")`
@ -19,8 +19,8 @@
(let [start (System/nanoTime) (let [start (System/nanoTime)
_ (dotimes [_ amt] (afn)) _ (dotimes [_ amt] (afn))
end (System/nanoTime)] end (System/nanoTime)]
(/ (- end start) 1000000.0) (/ (- end start) 1000000.0)))
))
(defn avg [numbers] (defn avg [numbers]
(/ (reduce + numbers) (/ (reduce + numbers)
@ -41,20 +41,20 @@
(fn [afn] (fn [afn]
(average-time-ms 8 amt-per-iter afn)) (average-time-ms 8 amt-per-iter afn))
afn-map) afn-map)
[[_ best-time] & _ :as sorted] (sort-by last results) [[_ best-time] & _ :as sorted] (sort-by last results)]
]
(println "\nAvg(ms)\t\tvs best\t\tCode") (println "\nAvg(ms)\t\tvs best\t\tCode")
(doseq [[k t] sorted] (doseq [[k t] sorted]
(println (pretty-float5 t) "\t\t" (pretty-float3 (/ t best-time 1.0)) "\t\t" k) (println (pretty-float5 t) "\t\t" (pretty-float3 (/ t best-time 1.0)) "\t\t" k))))
)))
(defmacro run-benchmark [name amt-per-iter & exprs] (defmacro run-benchmark [name amt-per-iter & exprs]
(let [afn-map (->> exprs shuffle (map (fn [e] [`(quote ~e) `(fn [] ~e)])) (into {}))] (let [afn-map (->> exprs shuffle (map (fn [e] [`(quote ~e) `(fn [] ~e)])) (into {}))]
`(do `(do
(println "Benchmark:" ~name (str "(" ~amt-per-iter " iterations)")) (println "Benchmark:" ~name (str "(" ~amt-per-iter " iterations)"))
(compare-benchmark ~amt-per-iter ~afn-map) (compare-benchmark ~amt-per-iter ~afn-map)
(println "\n********************************\n") (println "\n********************************\n"))))
)))
(let [data {:a {:b {:c 1}}} (let [data {:a {:b {:c 1}}}
p (comp-paths :a :b :c)] p (comp-paths :a :b :c)]
@ -66,8 +66,8 @@
(compiled-select-any p data) (compiled-select-any p data)
(get-in data [:a :b :c]) (get-in data [:a :b :c])
(-> data :a :b :c) (-> data :a :b :c)
(select-any [(keypath :a) (keypath :b) (keypath :c)] data) (select-any [(keypath :a) (keypath :b) (keypath :c)] data)))
))
;; because below 1.7 there is no update function ;; because below 1.7 there is no update function
@ -85,8 +85,8 @@
(run-benchmark "update value in nested map" 500000 (run-benchmark "update value in nested map" 500000
(update-in data [:a :b :c] inc) (update-in data [:a :b :c] inc)
(transform [:a :b :c] inc data) (transform [:a :b :c] inc data)
(manual-transform data inc) (manual-transform data inc)))
))
(defn map-vals-map-iterable [^clojure.lang.IMapIterable m afn] (defn map-vals-map-iterable [^clojure.lang.IMapIterable m afn]
(let [k-it (.keyIterator m) (let [k-it (.keyIterator m)
@ -95,10 +95,10 @@
(if (.hasNext k-it) (if (.hasNext k-it)
(let [k (.next k-it) (let [k (.next k-it)
v (.next v-it)] v (.next v-it)]
(recur (assoc ret k (afn v))) (recur (assoc ret k (afn v))))
)
ret ret))))
))))
(defn map-vals-map-iterable-transient [^clojure.lang.IMapIterable m afn] (defn map-vals-map-iterable-transient [^clojure.lang.IMapIterable m afn]
(persistent! (persistent!
@ -108,10 +108,10 @@
(if (.hasNext k-it) (if (.hasNext k-it)
(let [k (.next k-it) (let [k (.next k-it)
v (.next v-it)] v (.next v-it)]
(recur (assoc! ret k (afn v))) (recur (assoc! ret k (afn v))))
)
ret ret)))))
)))))
(let [data {:a 1 :b 2 :c 3 :d 4}] (let [data {:a 1 :b 2 :c 3 :d 4}]
(run-benchmark "transform values of a small map" 500000 (run-benchmark "transform values of a small map" 500000
@ -124,8 +124,8 @@
(zipmap (keys data) (map inc (vals data))) (zipmap (keys data) (map inc (vals data)))
(into {} (map (fn [e] [(key e) (inc (val e))]) data)) (into {} (map (fn [e] [(key e) (inc (val e))]) data))
(map-vals-map-iterable data inc) (map-vals-map-iterable data inc)
(map-vals-map-iterable-transient data inc) (map-vals-map-iterable-transient data inc)))
))
(let [data (->> (for [i (range 1000)] [i i]) (into {}))] (let [data (->> (for [i (range 1000)] [i i]) (into {}))]
(run-benchmark "transform values of large map" 600 (run-benchmark "transform values of large map" 600
@ -139,23 +139,23 @@
(zipmap (keys data) (map inc (vals data))) (zipmap (keys data) (map inc (vals data)))
(into {} (map (fn [e] [(key e) (inc (val e))]) data)) (into {} (map (fn [e] [(key e) (inc (val e))]) data))
(map-vals-map-iterable data inc) (map-vals-map-iterable data inc)
(map-vals-map-iterable-transient data inc) (map-vals-map-iterable-transient data inc)))
))
(let [data [1 2 3 4 5]] (let [data [1 2 3 4 5]]
(run-benchmark "map a function over a vector" 1000000 (run-benchmark "map a function over a vector" 1000000
(vec (map inc data)) (vec (map inc data))
(mapv inc data) (mapv inc data)
(transform ALL inc data) (transform ALL inc data)))
))
(let [data [1 2 3 4 5 6 7 8 9 10]] (let [data [1 2 3 4 5 6 7 8 9 10]]
(run-benchmark "filter a sequence" 500000 (run-benchmark "filter a sequence" 500000
(doall (filter even? data)) (doall (filter even? data))
(filterv even? data) (filterv even? data)
(select [ALL even?] data) (select [ALL even?] data)
(select-any (filterer even?) data) (select-any (filterer even?) data)))
))
(let [data [{:a 2 :b 2} {:a 1} {:a 4} {:a 6}] (let [data [{:a 2 :b 2} {:a 1} {:a 4} {:a 6}]
xf (comp (map :a) (filter even?))] xf (comp (map :a) (filter even?))]
@ -163,8 +163,8 @@
(select [ALL :a even?] data) (select [ALL :a even?] data)
(->> data (mapv :a) (filter even?) doall) (->> data (mapv :a) (filter even?) doall)
(into [] (comp (map :a) (filter even?)) data) (into [] (comp (map :a) (filter even?)) data)
(into [] xf data) (into [] xf data)))
))
(let [v (vec (range 1000))] (let [v (vec (range 1000))]
(run-benchmark "END on large vector" (run-benchmark "END on large vector"
@ -191,8 +191,8 @@
(defn tree-value-transform [afn atree] (defn tree-value-transform [afn atree]
(if (vector? atree) (if (vector? atree)
(mapv #(tree-value-transform afn %) atree) (mapv #(tree-value-transform afn %) atree)
(afn atree) (afn atree)))
))
(let [data [1 2 [[3]] [4 6 [7 [8]] 10]]] (let [data [1 2 [[3]] [4 6 [7 [8]] 10]]]
(run-benchmark "update every value in a tree (represented with vectors)" (run-benchmark "update every value in a tree (represented with vectors)"
@ -201,8 +201,8 @@
(transform [(walker number?) even?] inc data) (transform [(walker number?) even?] inc data)
(transform [TreeValues even?] inc data) (transform [TreeValues even?] inc data)
(transform [TreeValuesProt even?] inc data) (transform [TreeValuesProt even?] inc data)
(tree-value-transform (fn [e] (if (even? e) (inc e) e)) data) (tree-value-transform (fn [e] (if (even? e) (inc e) e)) data)))
))
(let [toappend (range 1000)] (let [toappend (range 1000)]
(run-benchmark "transient comparison: building up vectors" (run-benchmark "transient comparison: building up vectors"
@ -218,8 +218,8 @@
(reduce (fn [v i] (conj v i)) [] toappend) (reduce (fn [v i] (conj v i)) [] toappend)
(reduce (fn [v i] (conj! v i)) (transient []) toappend) (reduce (fn [v i] (conj! v i)) (transient []) toappend)
(reduce (fn [v i] (setval END [i] v)) [] toappend) (reduce (fn [v i] (setval END [i] v)) [] toappend)
(reduce (fn [v i] (setval END! [i] v)) (transient []) toappend) (reduce (fn [v i] (setval END! [i] v)) (transient []) toappend)))
))
(let [data (vec (range 1000)) (let [data (vec (range 1000))
tdata (transient data) tdata (transient data)
@ -280,19 +280,18 @@
(into #{} (traverse ALL data)) (into #{} (traverse ALL data))
(persistent! (persistent!
(reduce conj! (transient #{}) (traverse ALL data))) (reduce conj! (transient #{}) (traverse ALL data)))
(reduce conj #{} (traverse ALL data)) (reduce conj #{} (traverse ALL data))))
))
(defn mult-10 [v] (* 10 v)) (defn mult-10 [v] (* 10 v))
(let [data [1 2 3 4 5 6 7 8 9]] (let [data [1 2 3 4 5 6 7 8 9]]
(run-benchmark "multi-transform vs. consecutive transforms, one shared nav" 300000 (run-benchmark "multi-transform vs. consecutive transforms, one shared nav" 300000
(->> data (transform [ALL even?] mult-10) (transform [ALL odd?] dec)) (->> data (transform [ALL even?] mult-10) (transform [ALL odd?] dec))
(multi-transform [ALL (multi-path [even? (terminal mult-10)] [odd? (terminal dec)])] data) (multi-transform [ALL (multi-path [even? (terminal mult-10)] [odd? (terminal dec)])] data)))
))
(let [data [[1 2 3 4 :a] [5] [6 7 :b 8 9] [10 11 12 13]]] (let [data [[1 2 3 4 :a] [5] [6 7 :b 8 9] [10 11 12 13]]]
(run-benchmark "multi-transform vs. consecutive transforms, three shared navs" 150000 (run-benchmark "multi-transform vs. consecutive transforms, three shared navs" 150000
(->> data (transform [ALL ALL number? even?] mult-10) (transform [ALL ALL number? odd?] dec)) (->> data (transform [ALL ALL number? even?] mult-10) (transform [ALL ALL number? odd?] dec))
(multi-transform [ALL ALL number? (multi-path [even? (terminal mult-10)] [odd? (terminal dec)])] data) (multi-transform [ALL ALL number? (multi-path [even? (terminal mult-10)] [odd? (terminal dec)])] data)))
))

268
src/clj/com/rpl/specter.cljc
View file

@ -8,11 +8,11 @@
defnav defnav
defpathedfn defpathedfn
richnav richnav
defnavconstructor defnavconstructor]]
]]
[com.rpl.specter.util-macros :refer [com.rpl.specter.util-macros :refer
[doseqres]] [doseqres]]))
))
(:use [com.rpl.specter.protocols :only [ImplicitNav]] (:use [com.rpl.specter.protocols :only [ImplicitNav]]
#?(:clj [com.rpl.specter.macros :only #?(:clj [com.rpl.specter.macros :only
[fixed-pathed-collector [fixed-pathed-collector
@ -22,12 +22,12 @@
defpathedfn defpathedfn
richnav richnav
defnavconstructor]]) defnavconstructor]])
#?(:clj [com.rpl.specter.util-macros :only [doseqres]]) #?(:clj [com.rpl.specter.util-macros :only [doseqres]]))
)
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
[com.rpl.specter.navs :as n] [com.rpl.specter.navs :as n]
[clojure.set :as set]) [clojure.set :as set]))
)
(defn comp-paths (defn comp-paths
"Returns a compiled version of the given path for use with "Returns a compiled version of the given path for use with
@ -177,8 +177,8 @@
(select* [this params params-idx vals structure next-fn] (select* [this params params-idx vals structure next-fn]
(i/exec-rich-select* nav params (- params-idx needed) vals structure next-fn)) (i/exec-rich-select* nav params (- params-idx needed) vals structure next-fn))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(i/exec-rich-transform* nav params (- params-idx needed) vals structure next-fn) (i/exec-rich-transform* nav params (- params-idx needed) vals structure next-fn)))))
))))
;; Built-in pathing and context operations ;; Built-in pathing and context operations
@ -188,10 +188,10 @@
STOP STOP
[] []
(select* [this structure next-fn] (select* [this structure next-fn]
NONE ) NONE)
(transform* [this structure next-fn] (transform* [this structure next-fn]
structure structure))
))
(defnav (defnav
@ -213,8 +213,8 @@
(select* [this params params-idx vals structure next-fn] (select* [this params params-idx vals structure next-fn]
(i/throw-illegal "'terminal' should only be used in multi-transform")) (i/throw-illegal "'terminal' should only be used in multi-transform"))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(n/terminal* params params-idx vals structure) (n/terminal* params params-idx vals structure))))
)))
(defnavconstructor terminal-val (defnavconstructor terminal-val
"Like `terminal` but specifies a val to set at the location regardless of "Like `terminal` but specifies a val to set at the location regardless of
@ -240,11 +240,11 @@
[] []
(select* [this structure next-fn] (select* [this structure next-fn]
(doseqres NONE [v (vals structure)] (doseqres NONE [v (vals structure)]
(next-fn v) (next-fn v)))
))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(n/map-vals-transform structure next-fn) (n/map-vals-transform structure next-fn)))
))
(defcollector VAL [] (defcollector VAL []
@ -271,8 +271,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(n/srange-select structure (start-fn structure) (end-fn structure) next-fn)) (n/srange-select structure (start-fn structure) (end-fn structure) next-fn))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(n/srange-transform structure (start-fn structure) (end-fn structure) next-fn) (n/srange-transform structure (start-fn structure) (end-fn structure) next-fn)))
))
(defnav (defnav
^{:doc "Navigates to the subsequence bound by the indexes start (inclusive) ^{:doc "Navigates to the subsequence bound by the indexes start (inclusive)
@ -282,8 +282,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(n/srange-select structure start end next-fn)) (n/srange-select structure start end next-fn))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(n/srange-transform structure start end next-fn) (n/srange-transform structure start end next-fn)))
))
(defnav (defnav
^{:doc "Navigates to every continuous subsequence of elements matching `pred`"} ^{:doc "Navigates to every continuous subsequence of elements matching `pred`"}
@ -291,15 +291,15 @@
[pred] [pred]
(select* [this structure next-fn] (select* [this structure next-fn]
(doseqres NONE [[s e] (n/matching-ranges structure pred)] (doseqres NONE [[s e] (n/matching-ranges structure pred)]
(n/srange-select structure s e next-fn) (n/srange-select structure s e next-fn)))
))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(reduce (reduce
(fn [structure [s e]] (fn [structure [s e]]
(n/srange-transform structure s e next-fn)) (n/srange-transform structure s e next-fn))
structure structure
(reverse (n/matching-ranges structure pred)) (reverse (n/matching-ranges structure pred)))))
)))
(defnav (defnav
^{:doc "Navigate to the empty subsequence before the first element of the collection."} ^{:doc "Navigate to the empty subsequence before the first element of the collection."}
@ -309,8 +309,8 @@
(next-fn [])) (next-fn []))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(let [to-prepend (next-fn [])] (let [to-prepend (next-fn [])]
(n/prepend-all structure to-prepend) (n/prepend-all structure to-prepend))))
)))
(defnav (defnav
^{:doc "Navigate to the empty subsequence after the last element of the collection."} ^{:doc "Navigate to the empty subsequence after the last element of the collection."}
@ -320,8 +320,8 @@
(next-fn [])) (next-fn []))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(let [to-append (next-fn [])] (let [to-append (next-fn [])]
(n/append-all structure to-append) (n/append-all structure to-append))))
)))
(defnav (defnav
^{:doc "Navigates to the specified subset (by taking an intersection). ^{:doc "Navigates to the specified subset (by taking an intersection).
@ -336,8 +336,8 @@
newset (next-fn subset)] newset (next-fn subset)]
(-> structure (-> structure
(set/difference subset) (set/difference subset)
(set/union newset)) (set/union newset)))))
)))
(defnav (defnav
^{:doc "Navigates to the specified submap (using select-keys). ^{:doc "Navigates to the specified submap (using select-keys).
@ -401,8 +401,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (get structure key))) (next-fn (get structure key)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(assoc structure key (next-fn (get structure key))) (assoc structure key (next-fn (get structure key)))))
))
(defnav (defnav
^{:doc "Navigates to the key only if it exists in the map."} ^{:doc "Navigates to the key only if it exists in the map."}
@ -415,8 +415,8 @@
(transform* [this structure next-fn] (transform* [this structure next-fn]
(if (contains? structure k) (if (contains? structure k)
(assoc structure k (next-fn (get structure k))) (assoc structure k (next-fn (get structure k)))
structure structure)))
)))
(defnav (defnav
^{:doc "Navigates to result of running `afn` on the currently navigated value."} ^{:doc "Navigates to result of running `afn` on the currently navigated value."}
@ -425,8 +425,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (afn structure))) (next-fn (afn structure)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(next-fn (afn structure)) (next-fn (afn structure))))
))
(defnav (defnav
^{:doc "Navigate to the result of running `parse-fn` on the value. For ^{:doc "Navigate to the result of running `parse-fn` on the value. For
@ -437,8 +437,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (parse-fn structure))) (next-fn (parse-fn structure)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(unparse-fn (next-fn (parse-fn structure))) (unparse-fn (next-fn (parse-fn structure)))))
))
(defnav (defnav
^{:doc "Navigates to atom value."} ^{:doc "Navigates to atom value."}
@ -522,8 +522,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(if (afn structure) (next-fn structure) NONE)) (if (afn structure) (next-fn structure) NONE))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(if (afn structure) (next-fn structure) structure)) (if (afn structure) (next-fn structure) structure)))
)
(extend-type nil (extend-type nil
ImplicitNav ImplicitNav
@ -531,8 +531,8 @@
(extend-type #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword) (extend-type #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword)
ImplicitNav ImplicitNav
(implicit-nav [this] (keypath this)) (implicit-nav [this] (keypath this)))
)
(extend-type #?(:clj clojure.lang.AFn :cljs function) (extend-type #?(:clj clojure.lang.AFn :cljs function)
ImplicitNav ImplicitNav
@ -586,8 +586,8 @@
[& path] [& path]
(fixed-pathed-collector [late path] (fixed-pathed-collector [late path]
(collect-val [this structure] (collect-val [this structure]
(compiled-select late structure) (compiled-select late structure))))
)))
(defpathedfn (defpathedfn
^{:doc "Adds the result of running select-one with the given path on the ^{:doc "Adds the result of running select-one with the given path on the
@ -596,8 +596,8 @@
[& path] [& path]
(fixed-pathed-collector [late path] (fixed-pathed-collector [late path]
(collect-val [this structure] (collect-val [this structure]
(compiled-select-one late structure) (compiled-select-one late structure))))
)))
(defcollector (defcollector
^{:doc ^{:doc
@ -610,7 +610,7 @@
putval putval
[val] [val]
(collect-val [this structure] (collect-val [this structure]
val )) val))
(def (def
^{:doc "Drops all collected values for subsequent navigation."} ^{:doc "Drops all collected values for subsequent navigation."}
@ -620,69 +620,69 @@
(defpathedfn if-path (defpathedfn if-path
"Like cond-path, but with if semantics." "Like cond-path, but with if semantics."
([cond-p then-path] ([cond-p then-path]
(if-path cond-p then-path STOP)) (if-path cond-p then-path STOP))
([cond-p then-path else-path] ([cond-p then-path else-path]
(let [then-comp (i/comp-paths-internalized then-path) (let [then-comp (i/comp-paths-internalized then-path)
else-comp (i/comp-paths-internalized else-path) else-comp (i/comp-paths-internalized else-path)
then-needed (i/num-needed-params then-comp) then-needed (i/num-needed-params then-comp)
else-needed (i/num-needed-params else-comp) else-needed (i/num-needed-params else-comp)
then-nav (i/extract-rich-nav then-comp) then-nav (i/extract-rich-nav then-comp)
else-nav (i/extract-rich-nav else-comp)] else-nav (i/extract-rich-nav else-comp)]
(if-let [afn (n/extract-basic-filter-fn cond-p)] (if-let [afn (n/extract-basic-filter-fn cond-p)]
(richnav (+ then-needed else-needed) (richnav (+ then-needed else-needed)
(select* [this params params-idx vals structure next-fn] (select* [this params params-idx vals structure next-fn]
(n/if-select (n/if-select
params params
params-idx params-idx
vals vals
structure structure
next-fn next-fn
afn afn
then-nav then-nav
then-needed then-needed
else-nav else-nav))
))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(n/if-transform (n/if-transform
params params
params-idx params-idx
vals vals
structure structure
next-fn next-fn
afn afn
then-nav then-nav
then-needed then-needed
else-nav else-nav))))
))))
(let [cond-comp (i/comp-paths-internalized cond-p) (let [cond-comp (i/comp-paths-internalized cond-p)
cond-needed (i/num-needed-params cond-comp)] cond-needed (i/num-needed-params cond-comp)]
(richnav (+ then-needed else-needed cond-needed) (richnav (+ then-needed else-needed cond-needed)
(select* [this params params-idx vals structure next-fn] (select* [this params params-idx vals structure next-fn]
(let [late-cond (i/parameterize-path cond-comp params params-idx)] (let [late-cond (i/parameterize-path cond-comp params params-idx)]
(n/if-select (n/if-select
params params
(+ params-idx cond-needed) (+ params-idx cond-needed)
vals vals
structure structure
next-fn next-fn
#(n/selected?* late-cond %) #(n/selected?* late-cond %)
then-nav then-nav
then-needed then-needed
else-nav else-nav)))
)))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(let [late-cond (i/parameterize-path cond-comp params params-idx)] (let [late-cond (i/parameterize-path cond-comp params params-idx)]
(n/if-transform (n/if-transform
params params
(+ params-idx cond-needed) (+ params-idx cond-needed)
vals vals
structure structure
next-fn next-fn
#(n/selected?* late-cond %) #(n/selected?* late-cond %)
then-nav then-nav
then-needed then-needed
else-nav else-nav))))))))
))))))))
(defpathedfn cond-path (defpathedfn cond-path
"Takes in alternating cond-path path cond-path path... "Takes in alternating cond-path path cond-path path...
@ -700,8 +700,8 @@
(fn [p [tester apath]] (fn [p [tester apath]]
(if-path tester apath p)) (if-path tester apath p))
STOP STOP
pairs pairs)))
)))
(defpathedfn multi-path (defpathedfn multi-path
"A path that branches on multiple paths. For updates, "A path that branches on multiple paths. For updates,
@ -709,27 +709,27 @@
([] STAY) ([] STAY)
([path] (i/comp-paths* path)) ([path] (i/comp-paths* path))
([path1 path2] ([path1 path2]
(let [comp1 (i/comp-paths-internalized path1) (let [comp1 (i/comp-paths-internalized path1)
comp2 (i/comp-paths-internalized path2) comp2 (i/comp-paths-internalized path2)
comp1-needed (i/num-needed-params comp1) comp1-needed (i/num-needed-params comp1)
nav1 (i/extract-rich-nav comp1) nav1 (i/extract-rich-nav comp1)
nav2 (i/extract-rich-nav comp2) nav2 (i/extract-rich-nav comp2)]
]
(richnav (+ comp1-needed (i/num-needed-params comp2)) (richnav (+ comp1-needed (i/num-needed-params comp2))
(select* [this params params-idx vals structure next-fn] (select* [this params params-idx vals structure next-fn]
(let [res1 (i/exec-rich-select* nav1 params params-idx vals structure next-fn) (let [res1 (i/exec-rich-select* nav1 params params-idx vals structure next-fn)
res2 (i/exec-rich-select* nav2 params (+ params-idx comp1-needed) vals structure next-fn)] res2 (i/exec-rich-select* nav2 params (+ params-idx comp1-needed) vals structure next-fn)]
(if (identical? NONE res2) (if (identical? NONE res2)
res1 res1
res2 res2)))
)))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(let [s1 (i/exec-rich-transform* nav1 params params-idx vals structure next-fn)] (let [s1 (i/exec-rich-transform* nav1 params params-idx vals structure next-fn)]
(i/exec-rich-transform* nav2 params (+ params-idx comp1-needed) vals s1 next-fn) (i/exec-rich-transform* nav2 params (+ params-idx comp1-needed) vals s1 next-fn))))))
)))))
([path1 path2 & paths] ([path1 path2 & paths]
(reduce multi-path (multi-path path1 path2) paths) (reduce multi-path (multi-path path1 path2) paths)))
))
(defpathedfn stay-then-continue (defpathedfn stay-then-continue
"Navigates to the current element and then navigates via the provided path. "Navigates to the current element and then navigates via the provided path.

7
src/clj/com/rpl/specter/defhelpers.clj
View file

@ -11,10 +11,9 @@
`(~invoke-name [this# ~@args] `(~invoke-name [this# ~@args]
(let [~a (~(if clj? 'com.rpl.specter.impl/fast-object-array 'object-array) ~i)] (let [~a (~(if clj? 'com.rpl.specter.impl/fast-object-array 'object-array) ~i)]
~@setters ~@setters
(com.rpl.specter.impl/bind-params* this# ~a 0) (com.rpl.specter.impl/bind-params* this# ~a 0))))]
)))]
`(defrecord ~'ParamsNeededPath [~'rich-nav ~'num-needed-params] `(defrecord ~'ParamsNeededPath [~'rich-nav ~'num-needed-params]
~fn-type ~fn-type
~@impls ~@impls
~var-arity-impl ~var-arity-impl)))
)))

7
src/clj/com/rpl/specter/defnavhelpers.cljc
View file

@ -3,12 +3,11 @@
(defn param-delta [i] (defn param-delta [i]
(fn [^objects params params-idx] (fn [^objects params params-idx]
(aget params (+ params-idx i)) (aget params (+ params-idx i))))
))
(defn bound-params [path start-delta] (defn bound-params [path start-delta]
(fn [^objects params params-idx] (fn [^objects params params-idx]
(if (i/params-needed-path? path) (if (i/params-needed-path? path)
(i/bind-params* path params (+ params-idx start-delta)) (i/bind-params* path params (+ params-idx start-delta))
path path)))
)))

675
src/clj/com/rpl/specter/impl.cljc
View file

File diff suppressed because it is too large Load diff

220
src/clj/com/rpl/specter/macros.clj
View file

@ -3,8 +3,8 @@
[com.rpl.specter.impl :only [RichNavigator]]) [com.rpl.specter.impl :only [RichNavigator]])
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
[clojure.walk :as cljwalk] [clojure.walk :as cljwalk]
[com.rpl.specter.defnavhelpers :as dnh]) [com.rpl.specter.defnavhelpers :as dnh]))
)
(defn ^:no-doc gensyms [amt] (defn ^:no-doc gensyms [amt]
(vec (repeatedly amt gensym))) (vec (repeatedly amt gensym)))
@ -14,8 +14,8 @@
(if-not (= #{'select* 'transform*} (-> grouped keys set)) (if-not (= #{'select* 'transform*} (-> grouped keys set))
(i/throw-illegal "defnav must implement select* and transform*, instead got " (i/throw-illegal "defnav must implement select* and transform*, instead got "
(keys grouped))) (keys grouped)))
grouped grouped))
))
(defmacro richnav (defmacro richnav
"Defines a navigator with full access to collected vals, the parameters array, "Defines a navigator with full access to collected vals, the parameters array,
@ -30,8 +30,8 @@
s-next-fn-sym (last s-params) s-next-fn-sym (last s-params)
s-pidx-sym (nth s-params 2) s-pidx-sym (nth s-params 2)
t-next-fn-sym (last t-params) t-next-fn-sym (last t-params)
t-pidx-sym (nth t-params 2) t-pidx-sym (nth t-params 2)]
]
`(let [num-params# ~num-params `(let [num-params# ~num-params
nav# (reify RichNavigator nav# (reify RichNavigator
(~'rich-select* ~s-params (~'rich-select* ~s-params
@ -39,12 +39,12 @@
~@s-body)) ~@s-body))
(~'rich-transform* ~t-params (~'rich-transform* ~t-params
(let [~t-next-fn-sym (i/mk-jump-next-fn ~t-next-fn-sym ~t-pidx-sym num-params#)] (let [~t-next-fn-sym (i/mk-jump-next-fn ~t-next-fn-sym ~t-pidx-sym num-params#)]
~@t-body)) ~@t-body)))]
)]
(if (zero? num-params#) (if (zero? num-params#)
(i/no-params-rich-compiled-path nav#) (i/no-params-rich-compiled-path nav#)
(i/->ParamsNeededPath nav# num-params#) (i/->ParamsNeededPath nav# num-params#)))))
))))
(defmacro ^:no-doc lean-nav* [& impls] (defmacro ^:no-doc lean-nav* [& impls]
`(reify Navigator ~@impls)) `(reify Navigator ~@impls))
@ -60,16 +60,15 @@
binding-fn-syms)) binding-fn-syms))
body (op-maker binding-declarations)] body (op-maker binding-declarations)]
`(let [~@binding-fn-declarations] `(let [~@binding-fn-declarations]
~body ~body)))
)))
(defmacro ^:no-doc rich-nav-with-bindings [num-params-code bindings & impls] (defmacro ^:no-doc rich-nav-with-bindings [num-params-code bindings & impls]
(let [{[[_ s-structure-sym s-next-fn-sym] & s-body] 'select* (let [{[[_ s-structure-sym s-next-fn-sym] & s-body] 'select*
[[_ t-structure-sym t-next-fn-sym] & t-body] 'transform*} [[_ t-structure-sym t-next-fn-sym] & t-body] 'transform*}
(determine-params-impls impls) (determine-params-impls impls)
params-sym (gensym "params") params-sym (gensym "params")
params-idx-sym (gensym "params-idx") params-idx-sym (gensym "params-idx")]
]
(operation-with-bindings (operation-with-bindings
bindings bindings
params-sym params-sym
@ -84,8 +83,8 @@
next-params-idx# next-params-idx#
vals# vals#
structure#))] structure#))]
~@s-body ~@s-body))
))
(~'rich-transform* [this# ~params-sym ~params-idx-sym vals# ~t-structure-sym next-fn#] (~'rich-transform* [this# ~params-sym ~params-idx-sym vals# ~t-structure-sym next-fn#]
(let [~@binding-declarations (let [~@binding-declarations
next-params-idx# (+ ~params-idx-sym ~num-params-code) next-params-idx# (+ ~params-idx-sym ~num-params-code)
@ -94,9 +93,9 @@
next-params-idx# next-params-idx#
vals# vals#
structure#))] structure#))]
~@t-body ~@t-body)))))))
))
)))))
(defmacro ^:no-doc collector-with-bindings [num-params-code bindings impl] (defmacro ^:no-doc collector-with-bindings [num-params-code bindings impl]
(let [[_ [_ structure-sym] & body] impl (let [[_ [_ structure-sym] & body] impl
@ -110,21 +109,21 @@
`(let [num-params# ~num-params-code `(let [num-params# ~num-params-code
cfn# (fn [~params-sym ~params-idx-sym vals# ~structure-sym next-fn#] cfn# (fn [~params-sym ~params-idx-sym vals# ~structure-sym next-fn#]
(let [~@binding-declarations] (let [~@binding-declarations]
(next-fn# ~params-sym (+ ~params-idx-sym num-params#) (conj vals# (do ~@body)) ~structure-sym) (next-fn# ~params-sym (+ ~params-idx-sym num-params#) (conj vals# (do ~@body)) ~structure-sym)))]
))]
(reify RichNavigator (reify RichNavigator
(~'rich-select* [this# params# params-idx# vals# structure# next-fn#] (~'rich-select* [this# params# params-idx# vals# structure# next-fn#]
(cfn# params# params-idx# vals# structure# next-fn#)) (cfn# params# params-idx# vals# structure# next-fn#))
(~'rich-transform* [this# params# params-idx# vals# structure# next-fn#] (~'rich-transform* [this# params# params-idx# vals# structure# next-fn#]
(cfn# params# params-idx# vals# structure# next-fn#)) (cfn# params# params-idx# vals# structure# next-fn#))))))))
))))))
(defn- delta-param-bindings [params] (defn- delta-param-bindings [params]
(->> params (->> params
(map-indexed (fn [i p] [p `(dnh/param-delta ~i)])) (map-indexed (fn [i p] [p `(dnh/param-delta ~i)]))
(apply concat) (apply concat)
vec vec))
))
(defmacro nav (defmacro nav
"Defines a navigator with late bound parameters. This navigator can be precompiled "Defines a navigator with late bound parameters. This navigator can be precompiled
@ -143,10 +142,10 @@
(i/->ParamsNeededPath (i/->ParamsNeededPath
(rich-nav-with-bindings ~(count params) (rich-nav-with-bindings ~(count params)
~(delta-param-bindings params) ~(delta-param-bindings params)
~@impls ~@impls)
)
~(count params))} ~(count params))})))
)))
(defmacro collector (defmacro collector
"Defines a Collector with late bound parameters. This collector can be precompiled "Defines a Collector with late bound parameters. This collector can be precompiled
@ -157,8 +156,8 @@
[params body] [params body]
`(let [rich-nav# (collector-with-bindings ~(count params) `(let [rich-nav# (collector-with-bindings ~(count params)
~(delta-param-bindings params) ~(delta-param-bindings params)
~body ~body)]
)]
(if ~(empty? params) (if ~(empty? params)
(i/no-params-rich-compiled-path rich-nav#) (i/no-params-rich-compiled-path rich-nav#)
(vary-meta (vary-meta
@ -172,9 +171,9 @@
:params-needed-path :params-needed-path
(i/->ParamsNeededPath (i/->ParamsNeededPath
rich-nav# rich-nav#
~(count params) ~(count params))}))))
)}
))))
(defn ^:no-doc fixed-pathed-operation [bindings op-maker] (defn ^:no-doc fixed-pathed-operation [bindings op-maker]
(let [bindings (partition 2 bindings) (let [bindings (partition 2 bindings)
@ -184,8 +183,8 @@
compiled-syms (vec (gensyms (count bindings))) compiled-syms (vec (gensyms (count bindings)))
runtime-bindings (vec (mapcat runtime-bindings (vec (mapcat
(fn [l c d] (fn [l c d]
`[~l (dnh/bound-params ~c ~d)] `[~l (dnh/bound-params ~c ~d)])
)
late-path-syms late-path-syms
compiled-syms compiled-syms
delta-syms)) delta-syms))
@ -195,10 +194,10 @@
~compiled-syms compiled# ~compiled-syms compiled#
deltas# (cons 0 (reductions + (map i/num-needed-params compiled#))) deltas# (cons 0 (reductions + (map i/num-needed-params compiled#)))
~delta-syms deltas# ~delta-syms deltas#
~total-params-sym (last deltas#) ~total-params-sym (last deltas#)]
]
~body ~body)))
)))
(defmacro fixed-pathed-nav (defmacro fixed-pathed-nav
"This helper is used to define navigators that take in a fixed number of other "This helper is used to define navigators that take in a fixed number of other
@ -212,16 +211,16 @@
lean-bindings (mapcat vector late-syms compiled-syms)] lean-bindings (mapcat vector late-syms compiled-syms)]
`(if (zero? ~total-params-sym) `(if (zero? ~total-params-sym)
(let [~@lean-bindings] (let [~@lean-bindings]
(i/lean-compiled-path (lean-nav* ~@impls)) (i/lean-compiled-path (lean-nav* ~@impls)))
)
(i/->ParamsNeededPath (i/->ParamsNeededPath
(rich-nav-with-bindings ~total-params-sym (rich-nav-with-bindings ~total-params-sym
~runtime-bindings ~runtime-bindings
~@impls ~@impls)
)
~total-params-sym ~total-params-sym))))))
)))
)))
(defmacro fixed-pathed-collector (defmacro fixed-pathed-collector
@ -241,21 +240,21 @@
(i/->ParamsNeededPath (i/->ParamsNeededPath
(collector-with-bindings ~total-params-sym (collector-with-bindings ~total-params-sym
~runtime-bindings ~runtime-bindings
~@body ~@body)
)
~total-params-sym ~total-params-sym))))))
))))))
(defmacro paramsfn [params [structure-sym] & impl] (defmacro paramsfn [params [structure-sym] & impl]
`(nav ~params `(nav ~params
(~'select* [this# structure# next-fn#] (~'select* [this# structure# next-fn#]
(let [afn# (fn [~structure-sym] ~@impl)] (let [afn# (fn [~structure-sym] ~@impl)]
(i/filter-select afn# structure# next-fn#) (i/filter-select afn# structure# next-fn#)))
))
(~'transform* [this# structure# next-fn#] (~'transform* [this# structure# next-fn#]
(let [afn# (fn [~structure-sym] ~@impl)] (let [afn# (fn [~structure-sym] ~@impl)]
(i/filter-transform afn# structure# next-fn#) (i/filter-transform afn# structure# next-fn#)))))
))))
(defmacro defnav [name & body] (defmacro defnav [name & body]
`(def ~name (nav ~@body))) `(def ~name (nav ~@body)))
@ -293,24 +292,24 @@
num-params (count params) num-params (count params)
ssym (gensym "structure") ssym (gensym "structure")
rargs [(gensym "params") (gensym "pidx") (gensym "vals") ssym (gensym "next-fn")] rargs [(gensym "params") (gensym "pidx") (gensym "vals") ssym (gensym "next-fn")]
retrieve `(~m ~ssym) retrieve `(~m ~ssym)]
]
`(do `(do
(defprotocol ~prot-name (~m [structure#])) (defprotocol ~prot-name (~m [structure#]))
(let [nav# (reify RichNavigator (let [nav# (reify RichNavigator
(~'rich-select* [this# ~@rargs] (~'rich-select* [this# ~@rargs]
(let [inav# ~retrieve] (let [inav# ~retrieve]
(i/exec-rich-select* inav# ~@rargs) (i/exec-rich-select* inav# ~@rargs)))
))
(~'rich-transform* [this# ~@rargs] (~'rich-transform* [this# ~@rargs]
(let [inav# ~retrieve] (let [inav# ~retrieve]
(i/exec-rich-transform* inav# ~@rargs) (i/exec-rich-transform* inav# ~@rargs))))]
)))]
(def ~name (def ~name
(if (= ~num-params 0) (if (= ~num-params 0)
(i/no-params-rich-compiled-path nav#) (i/no-params-rich-compiled-path nav#)
(i/->ParamsNeededPath nav# ~num-params) (i/->ParamsNeededPath nav# ~num-params))))))))
)))))))
@ -342,12 +341,12 @@
(~'rich-select* [this# ~@rargs] (~'rich-select* [this# ~@rargs]
(~select-exec ~declared ~@rargs)) (~select-exec ~declared ~@rargs))
(~'rich-transform* [this# ~@rargs] (~'rich-transform* [this# ~@rargs]
(~transform-exec ~declared ~@rargs) (~transform-exec ~declared ~@rargs)))]
))]
(if (= ~num-params 0) (if (= ~num-params 0)
(i/no-params-rich-compiled-path nav#) (i/no-params-rich-compiled-path nav#)
(i/->ParamsNeededPath nav# ~num-params) (i/->ParamsNeededPath nav# ~num-params))))))))
)))))))
(defmacro providepath [name apath] (defmacro providepath [name apath]
`(let [comped# (i/comp-paths-internalized ~apath) `(let [comped# (i/comp-paths-internalized ~apath)
@ -357,8 +356,8 @@
(i/throw-illegal "Invalid number of params in provided path, expected " (i/throw-illegal "Invalid number of params in provided path, expected "
expected-params# " but got " needed-params#)) expected-params# " but got " needed-params#))
(def ~(declared-name name) (def ~(declared-name name)
(i/extract-rich-nav (i/coerce-compiled->rich-nav comped#)) (i/extract-rich-nav (i/coerce-compiled->rich-nav comped#)))))
)))
(defmacro extend-protocolpath (defmacro extend-protocolpath
"Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]." "Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]."
@ -420,15 +419,15 @@
(i/throw-illegal "Expected result navigator '" (quote ~anav) (i/throw-illegal "Expected result navigator '" (quote ~anav)
"' from nav constructor '" (quote ~name) "'" "' from nav constructor '" (quote ~name) "'"
" constructed with the provided constructor '" (quote ~csym) " constructed with the provided constructor '" (quote ~csym)
"'")) "'"))))))]
))))]
`(def ~name `(def ~name
(vary-meta (vary-meta
(let [~csym (i/layered-wrapper ~anav)] (let [~csym (i/layered-wrapper ~anav)]
(fn ~@checked-code)) (fn ~@checked-code))
assoc :layerednav (or (-> ~anav meta :highernav :type) :rich) assoc :layerednav (or (-> ~anav meta :highernav :type) :rich)))))
))
))
(defn ^:no-doc ic-prepare-path [locals-set path] (defn ^:no-doc ic-prepare-path [locals-set path]
@ -440,8 +439,8 @@
(if (contains? locals-set path) (if (contains? locals-set path)
`(com.rpl.specter.impl/->LocalSym ~path (quote ~path)) `(com.rpl.specter.impl/->LocalSym ~path (quote ~path))
;; var-get doesn't work in cljs, so capture the val in the macro instead ;; var-get doesn't work in cljs, so capture the val in the macro instead
`(com.rpl.specter.impl/->VarUse ~path (var ~path) (quote ~path)) `(com.rpl.specter.impl/->VarUse ~path (var ~path) (quote ~path)))
)
(i/fn-invocation? path) (i/fn-invocation? path)
(let [[op & params] path] (let [[op & params] path]
@ -452,12 +451,12 @@
`(com.rpl.specter.impl/->FnInvocation `(com.rpl.specter.impl/->FnInvocation
~(ic-prepare-path locals-set op) ~(ic-prepare-path locals-set op)
~(mapv #(ic-prepare-path locals-set %) params) ~(mapv #(ic-prepare-path locals-set %) params)
(quote ~path))) (quote ~path))))
)
:else :else
`(quote ~path) `(quote ~path)))
))
(defn ^:no-doc ic-possible-params [path] (defn ^:no-doc ic-possible-params [path]
(do (do
@ -473,10 +472,10 @@
(concat [e] (rest e) (ic-possible-params e)) (concat [e] (rest e) (ic-possible-params e))
(vector? e) (vector? e)
(ic-possible-params e) (ic-possible-params e)))
))
path path)))
)))
(defn cljs-macroexpand [env form] (defn cljs-macroexpand [env form]
(let [expand-fn (i/cljs-analyzer-macroexpand-1) (let [expand-fn (i/cljs-analyzer-macroexpand-1)
@ -490,13 +489,13 @@
(#{'fn 'fn* 'cljs.core/fn} (first form))) (#{'fn 'fn* 'cljs.core/fn} (first form)))
form form
(let [expanded (if (seq? form) (cljs-macroexpand env form) form)] (let [expanded (if (seq? form) (cljs-macroexpand env form) form)]
(cljwalk/walk #(cljs-macroexpand-all* env %) identity expanded) (cljwalk/walk #(cljs-macroexpand-all* env %) identity expanded))))
)))
(defn cljs-macroexpand-all [env form] (defn cljs-macroexpand-all [env form]
(let [ret (cljs-macroexpand-all* env form)] (let [ret (cljs-macroexpand-all* env form)]
ret ret))
))
;; still possible to mess this up with alter-var-root ;; still possible to mess this up with alter-var-root
(defmacro path (defmacro path
@ -509,15 +508,15 @@
platform (if (contains? &env :locals) :cljs :clj) platform (if (contains? &env :locals) :cljs :clj)
local-syms (if (= platform :cljs) local-syms (if (= platform :cljs)
(-> &env :locals keys set) ;cljs (-> &env :locals keys set) ;cljs
(-> &env keys set) ;clj (-> &env keys set)) ;clj
)
used-locals-cell (i/mutable-cell []) used-locals-cell (i/mutable-cell [])
_ (cljwalk/postwalk _ (cljwalk/postwalk
(fn [e] (fn [e]
(if (local-syms e) (if (local-syms e)
(i/update-cell! used-locals-cell #(conj % e)) (i/update-cell! used-locals-cell #(conj % e))
e e))
))
path) path)
used-locals (i/get-cell used-locals-cell) used-locals (i/get-cell used-locals-cell)
@ -549,10 +548,10 @@
(alter-var-root (alter-var-root
(var ~cache-sym) (var ~cache-sym)
(fn [_#] (i/mutable-cell))) (fn [_#] (i/mutable-cell)))
nil nil))))
))))
cache-sym cache-sym)
)
add-cache-code (if (= platform :clj) add-cache-code (if (= platform :clj)
`(i/set-cell! ~cache-sym ~info-sym) `(i/set-cell! ~cache-sym ~info-sym)
`(def ~cache-sym ~info-sym)) `(def ~cache-sym ~info-sym))
@ -567,9 +566,9 @@
`(i/handle-params `(i/handle-params
~precompiled-sym ~precompiled-sym
~params-maker-sym ~params-maker-sym
~(mapv (fn [p] `(fn [] ~p)) possible-params) ~(mapv (fn [p] `(fn [] ~p)) possible-params)))]
))
]
(if (= platform :clj) (if (= platform :clj)
(i/intern* *ns* cache-sym (i/mutable-cell))) (i/intern* *ns* cache-sym (i/mutable-cell)))
`(let [info# ~get-cache-code `(let [info# ~get-cache-code
@ -580,13 +579,13 @@
~prepared-path ~prepared-path
~(str *ns*) ~(str *ns*)
(quote ~used-locals) (quote ~used-locals)
(quote ~possible-params) (quote ~possible-params))]
)]
~add-cache-code ~add-cache-code
~info-sym ~info-sym)
)
info# info#)
)
~precompiled-sym (.-precompiled info#) ~precompiled-sym (.-precompiled info#)
~params-maker-sym (.-params-maker info#)] ~params-maker-sym (.-params-maker info#)]
@ -594,10 +593,10 @@
(i/comp-paths* ~(if (= (count path) 1) (first path) (vec path))) (i/comp-paths* ~(if (= (count path) 1) (first path) (vec path)))
(if (nil? ~params-maker-sym) (if (nil? ~params-maker-sym)
~precompiled-sym ~precompiled-sym
~handle-params-code ~handle-params-code)))))
)
))
))
(defmacro select (defmacro select
"Navigates to and returns a sequence of all the elements specified by the path. "Navigates to and returns a sequence of all the elements specified by the path.
@ -705,5 +704,4 @@
to capture all the collected values as a single vector." to capture all the collected values as a single vector."
[params & body] [params & body]
(let [platform (if (contains? &env :locals) :cljs :clj)] (let [platform (if (contains? &env :locals) :cljs :clj)]
`(i/collected?* (~'fn [~params] ~@body)) `(i/collected?* (~'fn [~params] ~@body))))
))

310
src/clj/com/rpl/specter/navs.cljc
View file

@ -8,19 +8,19 @@
defnav defnav
defpathedfn defpathedfn
richnav richnav
defnavconstructor defnavconstructor]]
]]
[com.rpl.specter.util-macros :refer [com.rpl.specter.util-macros :refer
[doseqres]] [doseqres]]))
))
(:use #?(:clj [com.rpl.specter macros]) (:use #?(:clj [com.rpl.specter macros])
#?(:clj [com.rpl.specter.util-macros :only [doseqres]])) #?(:clj [com.rpl.specter.util-macros :only [doseqres]]))
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
[clojure.walk :as walk] [clojure.walk :as walk]
#?(:clj [clojure.core.reducers :as r]) #?(:clj [clojure.core.reducers :as r])
[com.rpl.specter.defnavhelpers] ; so that for cljs it's loaded as macros expand to this [com.rpl.specter.defnavhelpers])) ; so that for cljs it's loaded as macros expand to this
)
)
(defn- append [coll elem] (defn- append [coll elem]
(-> coll vec (conj elem))) (-> coll vec (conj elem)))
@ -42,34 +42,34 @@
(let [r (continue-fn structure)] (let [r (continue-fn structure)]
(if-not (identical? r i/NONE) (if-not (identical? r i/NONE)
(i/set-cell! ret r)) (i/set-cell! ret r))
r r)
)
(walk/walk this identity structure) (walk/walk this identity structure)))]
))]
(walker structure) (walker structure)
(i/get-cell ret) (i/get-cell ret)))
))
(defn key-select [akey structure next-fn] (defn key-select [akey structure next-fn]
(next-fn (get structure akey))) (next-fn (get structure akey)))
(defn key-transform [akey structure next-fn] (defn key-transform [akey structure next-fn]
(assoc structure akey (next-fn (get structure akey)) (assoc structure akey (next-fn (get structure akey))))
))
(defn all-select [structure next-fn] (defn all-select [structure next-fn]
(doseqres i/NONE [e structure] (doseqres i/NONE [e structure]
(next-fn e))) (next-fn e)))
#?( #?(
:clj :clj
(defn queue? [coll] (defn queue? [coll]
(instance? clojure.lang.PersistentQueue coll)) (instance? clojure.lang.PersistentQueue coll))
:cljs
(defn queue? [coll]
(= (type coll) (type #queue []))))
:cljs
(defn queue? [coll]
(= (type coll) (type #queue [])))
)
(defprotocol AllTransformProtocol (defprotocol AllTransformProtocol
(all-transform [structure next-fn])) (all-transform [structure next-fn]))
@ -78,26 +78,26 @@
(reduce-kv (reduce-kv
(fn [m k v] (fn [m k v]
(let [[newk newv] (next-fn [k v])] (let [[newk newv] (next-fn [k v])]
(assoc m newk newv) (assoc m newk newv)))
))
empty-map empty-map
structure structure))
))
(extend-protocol AllTransformProtocol (extend-protocol AllTransformProtocol
nil nil
(all-transform [structure next-fn] (all-transform [structure next-fn]
nil nil)
)
;; in cljs they're PersistentVector so don't need a special case ;; in cljs they're PersistentVector so don't need a special case
#?(:clj clojure.lang.MapEntry) #?(:clj clojure.lang.MapEntry)
#?(:clj #?(:clj
(all-transform [structure next-fn] (all-transform [structure next-fn]
(let [newk (next-fn (key structure)) (let [newk (next-fn (key structure))
newv (next-fn (val structure))] newv (next-fn (val structure))]
(clojure.lang.MapEntry. newk newv) (clojure.lang.MapEntry. newk newv))))
)))
#?(:clj clojure.lang.PersistentVector :cljs cljs.core/PersistentVector) #?(:clj clojure.lang.PersistentVector :cljs cljs.core/PersistentVector)
(all-transform [structure next-fn] (all-transform [structure next-fn]
@ -105,31 +105,31 @@
#?(:clj clojure.lang.PersistentArrayMap) #?(:clj clojure.lang.PersistentArrayMap)
#?(:clj #?(:clj
(all-transform [structure next-fn] (all-transform [structure next-fn]
(let [k-it (.keyIterator structure) (let [k-it (.keyIterator structure)
v-it (.valIterator structure) v-it (.valIterator structure)
array (i/fast-object-array (* 2 (.count structure)))] array (i/fast-object-array (* 2 (.count structure)))]
(loop [i 0] (loop [i 0]
(if (.hasNext k-it) (if (.hasNext k-it)
(let [k (.next k-it) (let [k (.next k-it)
v (.next v-it) v (.next v-it)
[newk newv] (next-fn [k v])] [newk newv] (next-fn [k v])]
(aset array i newk) (aset array i newk)
(aset array (inc i) newv) (aset array (inc i) newv)
(recur (+ i 2))))) (recur (+ i 2)))))
(clojure.lang.PersistentArrayMap. array) (clojure.lang.PersistentArrayMap. array))))
)))
#?(:cljs cljs.core/PersistentArrayMap) #?(:cljs cljs.core/PersistentArrayMap)
#?(:cljs #?(:cljs
(all-transform [structure next-fn] (all-transform [structure next-fn]
(non-transient-map-all-transform structure next-fn {}) (non-transient-map-all-transform structure next-fn {})))
))
#?(:clj clojure.lang.PersistentTreeMap :cljs cljs.core/PersistentTreeMap) #?(:clj clojure.lang.PersistentTreeMap :cljs cljs.core/PersistentTreeMap)
(all-transform [structure next-fn] (all-transform [structure next-fn]
(non-transient-map-all-transform structure next-fn (empty structure)) (non-transient-map-all-transform structure next-fn (empty structure)))
)
#?(:clj clojure.lang.PersistentHashMap :cljs cljs.core/PersistentHashMap) #?(:clj clojure.lang.PersistentHashMap :cljs cljs.core/PersistentHashMap)
(all-transform [structure next-fn] (all-transform [structure next-fn]
@ -137,48 +137,48 @@
(reduce-kv (reduce-kv
(fn [m k v] (fn [m k v]
(let [[newk newv] (next-fn [k v])] (let [[newk newv] (next-fn [k v])]
(assoc! m newk newv) (assoc! m newk newv)))
))
(transient (transient
#?(:clj clojure.lang.PersistentHashMap/EMPTY :cljs cljs.core.PersistentHashMap.EMPTY) #?(:clj clojure.lang.PersistentHashMap/EMPTY :cljs cljs.core.PersistentHashMap.EMPTY))
)
structure structure)))
)))
#?(:clj Object) #?(:clj Object)
#?(:clj #?(:clj
(all-transform [structure next-fn] (all-transform [structure next-fn]
(let [empty-structure (empty structure)] (let [empty-structure (empty structure)]
(cond (and (list? empty-structure) (not (queue? empty-structure))) (cond (and (list? empty-structure) (not (queue? empty-structure)))
;; this is done to maintain order, otherwise lists get reversed ;; this is done to maintain order, otherwise lists get reversed
(doall (map next-fn structure)) (doall (map next-fn structure))
(map? structure) (map? structure)
;; reduce-kv is much faster than doing r/map through call to (into ...) ;; reduce-kv is much faster than doing r/map through call to (into ...)
(reduce-kv (reduce-kv
(fn [m k v] (fn [m k v]
(let [[newk newv] (next-fn [k v])] (let [[newk newv] (next-fn [k v])]
(assoc m newk newv) (assoc m newk newv)))
))
empty-structure empty-structure
structure structure)
)
:else
(->> structure (r/map next-fn) (into empty-structure))))))
:else
(->> structure (r/map next-fn) (into empty-structure))
))))
#?(:cljs default) #?(:cljs default)
#?(:cljs #?(:cljs
(all-transform [structure next-fn] (all-transform [structure next-fn]
(let [empty-structure (empty structure)] (let [empty-structure (empty structure)]
(if (and (list? empty-structure) (not (queue? empty-structure))) (if (and (list? empty-structure) (not (queue? empty-structure)))
;; this is done to maintain order, otherwise lists get reversed ;; this is done to maintain order, otherwise lists get reversed
(doall (map next-fn structure)) (doall (map next-fn structure))
(into empty-structure (map #(next-fn %)) structure) (into empty-structure (map #(next-fn %)) structure))))))
))))
)
(defprotocol MapValsTransformProtocol (defprotocol MapValsTransformProtocol
(map-vals-transform [structure next-fn])) (map-vals-transform [structure next-fn]))
@ -193,36 +193,36 @@
(extend-protocol MapValsTransformProtocol (extend-protocol MapValsTransformProtocol
nil nil
(map-vals-transform [structure next-fn] (map-vals-transform [structure next-fn]
nil nil)
)
#?(:clj clojure.lang.PersistentArrayMap) #?(:clj clojure.lang.PersistentArrayMap)
#?(:clj #?(:clj
(map-vals-transform [structure next-fn] (map-vals-transform [structure next-fn]
(let [k-it (.keyIterator structure) (let [k-it (.keyIterator structure)
v-it (.valIterator structure) v-it (.valIterator structure)
array (i/fast-object-array (* 2 (.count structure)))] array (i/fast-object-array (* 2 (.count structure)))]
(loop [i 0] (loop [i 0]
(if (.hasNext k-it) (if (.hasNext k-it)
(let [k (.next k-it) (let [k (.next k-it)
v (.next v-it) v (.next v-it)
newv (next-fn v)] newv (next-fn v)]
(aset array i k) (aset array i k)
(aset array (inc i) newv) (aset array (inc i) newv)
(recur (+ i 2))))) (recur (+ i 2)))))
(clojure.lang.PersistentArrayMap. array) (clojure.lang.PersistentArrayMap. array))))
)))
#?(:cljs cljs.core/PersistentArrayMap) #?(:cljs cljs.core/PersistentArrayMap)
#?(:cljs #?(:cljs
(map-vals-transform [structure next-fn] (map-vals-transform [structure next-fn]
(map-vals-non-transient-transform structure {} next-fn) (map-vals-non-transient-transform structure {} next-fn)))
))
#?(:clj clojure.lang.PersistentTreeMap :cljs cljs.core/PersistentTreeMap) #?(:clj clojure.lang.PersistentTreeMap :cljs cljs.core/PersistentTreeMap)
(map-vals-transform [structure next-fn] (map-vals-transform [structure next-fn]
(map-vals-non-transient-transform structure (empty structure) next-fn) (map-vals-non-transient-transform structure (empty structure) next-fn))
)
#?(:clj clojure.lang.PersistentHashMap :cljs cljs.core/PersistentHashMap) #?(:clj clojure.lang.PersistentHashMap :cljs cljs.core/PersistentHashMap)
(map-vals-transform [structure next-fn] (map-vals-transform [structure next-fn]
@ -231,10 +231,10 @@
(fn [m k v] (fn [m k v]
(assoc! m k (next-fn v))) (assoc! m k (next-fn v)))
(transient (transient
#?(:clj clojure.lang.PersistentHashMap/EMPTY :cljs cljs.core.PersistentHashMap.EMPTY) #?(:clj clojure.lang.PersistentHashMap/EMPTY :cljs cljs.core.PersistentHashMap.EMPTY))
)
structure structure)))
)))
#?(:clj Object :cljs default) #?(:clj Object :cljs default)
(map-vals-transform [structure next-fn] (map-vals-transform [structure next-fn]
@ -242,8 +242,8 @@
(fn [m k v] (fn [m k v]
(assoc m k (next-fn v))) (assoc m k (next-fn v)))
(empty structure) (empty structure)
structure)) structure)))
)
(defn srange-select [structure start end next-fn] (defn srange-select [structure start end next-fn]
(next-fn (-> structure vec (subvec start end)))) (next-fn (-> structure vec (subvec start end))))
@ -265,11 +265,11 @@
[ranges curr-start i] [ranges curr-start i]
:else :else
[(conj ranges [curr-start (inc curr-last)]) i i] [(conj ranges [curr-start (inc curr-last)]) i i]))
))
[[] nil nil] [[] nil nil]
(concat (matching-indices aseq p) [-1]) (concat (matching-indices aseq p) [-1]))))
)))
(defn extract-basic-filter-fn [path] (defn extract-basic-filter-fn [path]
(cond (fn? path) (cond (fn? path)
@ -280,10 +280,10 @@
(reduce (reduce
(fn [combined afn] (fn [combined afn]
(fn [structure] (fn [structure]
(and (combined structure) (afn structure)) (and (combined structure) (afn structure))))
))
path path)))
)))
@ -299,8 +299,8 @@
idx idx
vals vals
structure structure
next-fn next-fn)))
)))
(defn if-transform [params params-idx vals structure next-fn then-tester then-nav then-params else-nav] (defn if-transform [params params-idx vals structure next-fn then-tester then-nav then-params else-nav]
@ -315,15 +315,15 @@
idx idx
vals vals
structure structure
next-fn next-fn)))
)))
(defn terminal* [params params-idx vals structure] (defn terminal* [params params-idx vals structure]
(let [afn (aget ^objects params params-idx)] (let [afn (aget ^objects params params-idx)]
(if (identical? vals []) (if (identical? vals [])
(afn structure) (afn structure)
(apply afn (conj vals structure))) (apply afn (conj vals structure)))))
))
(defprotocol AddExtremes (defprotocol AddExtremes
@ -345,15 +345,15 @@
(as-> ret <> (as-> ret <>
(reduce conj! <> elements) (reduce conj! <> elements)
(reduce conj! <> structure) (reduce conj! <> structure)
(persistent! <>) (persistent! <>))))
)))
#?(:clj Object :cljs default) #?(:clj Object :cljs default)
(append-all [structure elements] (append-all [structure elements]
(concat structure elements)) (concat structure elements))
(prepend-all [structure elements] (prepend-all [structure elements]
(concat elements structure)) (concat elements structure)))
)
(defprotocol UpdateExtremes (defprotocol UpdateExtremes
@ -384,31 +384,31 @@
(append (butlast l) (afn (last l)))) (append (butlast l) (afn (last l))))
#?( #?(
:clj :clj
(defn vec-count [^clojure.lang.IPersistentVector v] (defn vec-count [^clojure.lang.IPersistentVector v]
(.length v)) (.length v))
:cljs
(defn vec-count [v]
(count v)))
:cljs
(defn vec-count [v]
(count v))
)
#?( #?(
:clj :clj
(defn transient-vec-count [^clojure.lang.ITransientVector v] (defn transient-vec-count [^clojure.lang.ITransientVector v]
(.count v)) (.count v))
:cljs
(defn transient-vec-count [v]
(count v)))
:cljs
(defn transient-vec-count [v]
(count v))
)
(extend-protocol UpdateExtremes (extend-protocol UpdateExtremes
#?(:clj clojure.lang.PersistentVector :cljs cljs.core/PersistentVector) #?(:clj clojure.lang.PersistentVector :cljs cljs.core/PersistentVector)
(update-first [v afn] (update-first [v afn]
(let [val (nth v 0)] (let [val (nth v 0)]
(assoc v 0 (afn val)) (assoc v 0 (afn val))))
))
(update-last [v afn] (update-last [v afn]
;; type-hinting vec-count to ^int caused weird errors with case ;; type-hinting vec-count to ^int caused weird errors with case
(let [c (int (vec-count v))] (let [c (int (vec-count v))]
@ -416,14 +416,14 @@
1 (let [[e] v] [(afn e)]) 1 (let [[e] v] [(afn e)])
2 (let [[e1 e2] v] [e1 (afn e2)]) 2 (let [[e1 e2] v] [e1 (afn e2)])
(let [i (dec c)] (let [i (dec c)]
(assoc v i (afn (nth v i))) (assoc v i (afn (nth v i)))))))
))))
#?(:clj Object :cljs default) #?(:clj Object :cljs default)
(update-first [l val] (update-first [l val]
(update-first-list l val)) (update-first-list l val))
(update-last [l val] (update-last [l val]
(update-last-list l val) (update-last-list l val)))
))
(extend-protocol GetExtremes (extend-protocol GetExtremes
#?(:clj clojure.lang.IPersistentVector :cljs cljs.core/PersistentVector) #?(:clj clojure.lang.IPersistentVector :cljs cljs.core/PersistentVector)
@ -435,8 +435,8 @@
(get-first [s] (get-first [s]
(first s)) (first s))
(get-last [s] (get-last [s]
(last s) (last s)))
))
(extend-protocol FastEmpty (extend-protocol FastEmpty
@ -451,14 +451,14 @@
(= 0 (transient-vec-count v))) (= 0 (transient-vec-count v)))
#?(:clj Object :cljs default) #?(:clj Object :cljs default)
(fast-empty? [s] (fast-empty? [s]
(empty? s)) (empty? s)))
)
(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 codewalk-until [pred on-match-fn structure] (defn codewalk-until [pred on-match-fn structure]
(if (pred structure) (if (pred structure)
@ -466,8 +466,8 @@
(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 (i/fn-invocation? structure) (i/fn-invocation? ret)) (if (and (i/fn-invocation? structure) (i/fn-invocation? ret))
(with-meta ret (meta structure)) (with-meta ret (meta structure))
ret ret))))
))))
(def DISPENSE* (def DISPENSE*
(i/no-params-rich-compiled-path (i/no-params-rich-compiled-path

4
src/clj/com/rpl/specter/protocols.cljc
View file

@ -15,8 +15,8 @@
(transform* [this structure next-fn] (transform* [this structure next-fn]
"An implementation of `transform*` must use `next-fn` to transform "An implementation of `transform*` must use `next-fn` to transform
any subvalues of `structure` and then merge those transformed values any subvalues of `structure` and then merge those transformed values
back into `structure`. Everything else in `structure` must be unchanged." back into `structure`. Everything else in `structure` must be unchanged."))
))
(defprotocol Collector (defprotocol Collector
"Do not use this protocol directly. All navigators must be created using "Do not use this protocol directly. All navigators must be created using

54
src/clj/com/rpl/specter/transients.cljc
View file

@ -1,13 +1,13 @@
(ns com.rpl.specter.transients (ns com.rpl.specter.transients
#?(:cljs #?(:cljs
(:require-macros [com.rpl.specter.macros (:require-macros [com.rpl.specter.macros
:refer :refer
[defnav [defnav
defpathedfn]])) defpathedfn]]))
(:use #?(:clj (:use #?(:clj
[com.rpl.specter.macros :only [com.rpl.specter.macros :only
[defnav [defnav
defpathedfn]])) defpathedfn]]))
(:require [com.rpl.specter.navs :as n] (:require [com.rpl.specter.navs :as n]
[com.rpl.specter :refer [subselect selected?]])) [com.rpl.specter :refer [subselect selected?]]))
@ -60,29 +60,29 @@
(n/PosNavigator t-get-last t-update-last)) (n/PosNavigator t-get-last t-update-last))
#?( #?(
:clj :clj
(defn- select-keys-from-transient-map (defn- select-keys-from-transient-map
"Selects keys from transient map, because built-in select-keys uses "Selects keys from transient map, because built-in select-keys uses
`find` which is unsupported." `find` which is unsupported."
[m m-keys] [m m-keys]
(loop [result {} (loop [result {}
m-keys m-keys] m-keys m-keys]
(if-not (seq m-keys) (if-not (seq m-keys)
result result
(let [k (first m-keys) (let [k (first m-keys)
;; support Clojure 1.6 where contains? is broken on transients ;; support Clojure 1.6 where contains? is broken on transients
item (get m k ::not-found)] item (get m k ::not-found)]
(recur (if-not (identical? item ::not-found) (recur (if-not (identical? item ::not-found)
(assoc result k item) (assoc result k item)
result) result)
(rest m-keys)))))) (rest m-keys))))))
:cljs
(defn- select-keys-from-transient-map
"Uses select-keys on a transient map."
[m m-keys]
(select-keys m m-keys)))
:cljs
(defn- select-keys-from-transient-map
"Uses select-keys on a transient map."
[m m-keys]
(select-keys m m-keys))
)
(defnav (defnav
^{:doc "Navigates to the specified persistent submap of a transient map."} ^{:doc "Navigates to the specified persistent submap of a transient map."}

7
src/clj/com/rpl/specter/util_macros.clj
View file

@ -6,8 +6,7 @@
(let [ret# (do ~@body)] (let [ret# (do ~@body)]
(if (identical? ret# ~backup-res) (if (identical? ret# ~backup-res)
curr# curr#
ret# ret#)))
)))
~backup-res ~backup-res
~aseq ~aseq))
))

55
src/clj/com/rpl/specter/zipper.cljc
View file

@ -3,8 +3,8 @@
[com.rpl.specter.macros [com.rpl.specter.macros
:refer [defnav nav declarepath providepath]])) :refer [defnav nav declarepath providepath]]))
#?(:clj #?(:clj
(:use (:use
[com.rpl.specter.macros :only [defnav nav declarepath providepath]])) [com.rpl.specter.macros :only [defnav nav declarepath providepath]]))
(:require [com.rpl.specter :as s] (:require [com.rpl.specter :as s]
[clojure.zip :as zip])) [clojure.zip :as zip]))
@ -12,8 +12,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (constructor structure))) (next-fn (constructor structure)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(zip/root (next-fn (constructor structure))) (zip/root (next-fn (constructor structure)))))
))
(def VECTOR-ZIP (zipper zip/vector-zip)) (def VECTOR-ZIP (zipper zip/vector-zip))
(def SEQ-ZIP (zipper zip/seq-zip)) (def SEQ-ZIP (zipper zip/seq-zip))
@ -34,12 +34,12 @@
(nav [] (nav []
(select* [this structure next-fn] (select* [this structure next-fn]
(let [ret (znav structure)] (let [ret (znav structure)]
(if ret (next-fn ret)) (if ret (next-fn ret))))
))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(let [ret (znav structure)] (let [ret (znav structure)]
(if ret (next-fn ret) structure) (if ret (next-fn ret) structure)))))
))))
;; (multi-path RIGHT LEFT) will not navigate to the right and left ;; (multi-path RIGHT LEFT) will not navigate to the right and left
;; of the currently navigated element because locations aren't stable ;; of the currently navigated element because locations aren't stable
@ -69,12 +69,12 @@
inserts (reduce inserts (reduce
(fn [z e] (-> z (inserter e) mover)) (fn [z e] (-> z (inserter e) mover))
structure structure
to-insert to-insert)]
)]
(if backer (if backer
(reduce (fn [z _] (backer z)) inserts to-insert) (reduce (fn [z _] (backer z)) inserts to-insert)
inserts) inserts)))
))
(defnav ^{:doc "Navigate to the empty subsequence directly to the (defnav ^{:doc "Navigate to the empty subsequence directly to the
right of this element."} right of this element."}
@ -82,8 +82,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn [])) (next-fn []))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(inner-insert structure next-fn zip/insert-right zip/right zip/left) (inner-insert structure next-fn zip/insert-right zip/right zip/left)))
))
(defnav ^{:doc "Navigate to the empty subsequence directly to the (defnav ^{:doc "Navigate to the empty subsequence directly to the
left of this element."} left of this element."}
@ -91,16 +91,16 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn [])) (next-fn []))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(inner-insert structure next-fn zip/insert-left identity nil) (inner-insert structure next-fn zip/insert-left identity nil)))
))
(defnav NODE [] (defnav NODE []
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (zip/node structure)) (next-fn (zip/node structure)))
)
(transform* [this structure next-fn] (transform* [this structure next-fn]
(zip/edit structure next-fn) (zip/edit structure next-fn)))
))
(defnav ^{:doc "Navigate to the subsequence containing only (defnav ^{:doc "Navigate to the subsequence containing only
the node currently pointed to. This works just the node currently pointed to. This works just
@ -108,13 +108,13 @@
from the structure"} from the structure"}
NODE-SEQ [] NODE-SEQ []
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn [(zip/node structure)]) (next-fn [(zip/node structure)]))
)
(transform* [this structure next-fn] (transform* [this structure next-fn]
(let [to-insert (next-fn [(zip/node structure)]) (let [to-insert (next-fn [(zip/node structure)])
inserted (reduce zip/insert-left structure to-insert)] inserted (reduce zip/insert-left structure to-insert)]
(zip/remove inserted) (zip/remove inserted))))
)))
(declarepath ^{:doc "Navigate the zipper to the first element (declarepath ^{:doc "Navigate the zipper to the first element
in the structure matching predfn. A linear scan in the structure matching predfn. A linear scan
@ -124,8 +124,8 @@
(providepath find-first (providepath find-first
(s/if-path [NODE s/pred] (s/if-path [NODE s/pred]
s/STAY s/STAY
[NEXT (s/params-reset find-first)] [NEXT (s/params-reset find-first)]))
))
(declarepath ^{:doc "Navigate to every element reachable using calls (declarepath ^{:doc "Navigate to every element reachable using calls
to NEXT"} to NEXT"}
@ -134,5 +134,4 @@
(providepath NEXT-WALK (providepath NEXT-WALK
(s/stay-then-continue (s/stay-then-continue
NEXT NEXT
NEXT-WALK NEXT-WALK))
))

2
test/com/rpl/specter/cljs_test_helpers.clj
View file

@ -10,4 +10,4 @@
`(cljs.test.check.generators/return ~vars) `(cljs.test.check.generators/return ~vars)
(reverse parts))] (reverse parts))]
`(cljs.test.check.properties/for-all [~vars ~genned] `(cljs.test.check.properties/for-all [~vars ~genned]
~@body ))) ~@body)))

4
test/com/rpl/specter/cljs_test_runner.cljs
View file

@ -1,8 +1,8 @@
(ns com.rpl.specter.cljs-test-runner (ns com.rpl.specter.cljs-test-runner
(:require [cljs.test :as test :refer-macros [run-tests]] (:require [cljs.test :as test :refer-macros [run-tests]]
[com.rpl.specter.core-test] [com.rpl.specter.core-test]
[com.rpl.specter.zipper-test] [com.rpl.specter.zipper-test]))
))
(run-tests 'com.rpl.specter.core-test) (run-tests 'com.rpl.specter.core-test)
(run-tests 'com.rpl.specter.zipper-test) (run-tests 'com.rpl.specter.zipper-test)

735
test/com/rpl/specter/core_test.cljc
View file

File diff suppressed because it is too large Load diff

19
test/com/rpl/specter/test_helpers.clj
View file

@ -1,9 +1,9 @@
(ns com.rpl.specter.test-helpers (ns com.rpl.specter.test-helpers
(:require [clojure.test.check (:require [clojure.test.check
[generators :as gen] [generators :as gen]
[properties :as prop]] [properties :as prop]]
[clojure.test] [clojure.test])
)
(:use [com.rpl.specter.macros :only [select transform]] (:use [com.rpl.specter.macros :only [select transform]]
[com.rpl.specter :only [select* transform* must-cache-paths!]])) [com.rpl.specter :only [select* transform* must-cache-paths!]]))
@ -19,7 +19,7 @@
`(gen/return ~vars) `(gen/return ~vars)
(reverse parts))] (reverse parts))]
`(prop/for-all [~vars ~genned] `(prop/for-all [~vars ~genned]
~@body ))) ~@body)))
(defmacro ic-test [must-cache? params-decl apath transform-fn data params] (defmacro ic-test [must-cache? params-decl apath transform-fn data params]
@ -29,13 +29,12 @@
icfntran# (fn [~@params-decl] (transform ~apath ~transform-fn ~data)) icfntran# (fn [~@params-decl] (transform ~apath ~transform-fn ~data))
regfnsel# (fn [~@params-decl] (select* ~apath ~data)) regfnsel# (fn [~@params-decl] (select* ~apath ~data))
regfntran# (fn [~@params-decl] (transform* ~apath ~transform-fn ~data)) regfntran# (fn [~@params-decl] (transform* ~apath ~transform-fn ~data))
params# (if (empty? ~params) [[]] ~params) params# (if (empty? ~params) [[]] ~params)]
]
(must-cache-paths! ~must-cache?) (must-cache-paths! ~must-cache?)
(dotimes [_# 3] (dotimes [_# 3]
(doseq [ps# params#] (doseq [ps# params#]
(~is-sym (= (apply icfnsel# ps#) (apply regfnsel# ps#))) (~is-sym (= (apply icfnsel# ps#) (apply regfnsel# ps#)))
(~is-sym (= (apply icfntran# ps#) (apply regfntran# ps#))) (~is-sym (= (apply icfntran# ps#) (apply regfntran# ps#)))))
))
(must-cache-paths! false) (must-cache-paths! false))))
)))

84
test/com/rpl/specter/zipper_test.cljc
View file

@ -1,20 +1,20 @@
(ns com.rpl.specter.zipper-test (ns com.rpl.specter.zipper-test
#?(:cljs (:require-macros #?(:cljs (:require-macros
[cljs.test :refer [is deftest]] [cljs.test :refer [is deftest]]
[cljs.test.check.cljs-test :refer [defspec]] [cljs.test.check.cljs-test :refer [defspec]]
[com.rpl.specter.cljs-test-helpers :refer [for-all+]] [com.rpl.specter.cljs-test-helpers :refer [for-all+]]
[com.rpl.specter.macros [com.rpl.specter.macros
:refer [declarepath providepath select select-one select-one! :refer [declarepath providepath select select-one select-one!
select-first transform setval replace-in]] select-first transform setval replace-in]]))
))
(:use (:use
#?(:clj [clojure.test :only [deftest is]]) #?(:clj [clojure.test :only [deftest is]])
#?(:clj [clojure.test.check.clojure-test :only [defspec]]) #?(:clj [clojure.test.check.clojure-test :only [defspec]])
#?(:clj [com.rpl.specter.test-helpers :only [for-all+]]) #?(:clj [com.rpl.specter.test-helpers :only [for-all+]])
#?(:clj [com.rpl.specter.macros #?(:clj [com.rpl.specter.macros
:only [declarepath providepath select select-one select-one! :only [declarepath providepath select select-one select-one!
select-first transform setval replace-in]]) select-first transform setval replace-in]]))
)
(:require #?(:clj [clojure.test.check.generators :as gen]) (:require #?(:clj [clojure.test.check.generators :as gen])
#?(:clj [clojure.test.check.properties :as prop]) #?(:clj [clojure.test.check.properties :as prop])
#?(:cljs [cljs.test.check :as tc]) #?(:cljs [cljs.test.check :as tc])
@ -28,8 +28,8 @@
[v (gen/not-empty (gen/vector gen/int)) [v (gen/not-empty (gen/vector gen/int))
i (gen/vector gen/int)] i (gen/vector gen/int)]
(= (setval s/END i v) (= (setval s/END i v)
(setval [z/VECTOR-ZIP z/DOWN z/RIGHTMOST z/INNER-RIGHT] i v)) (setval [z/VECTOR-ZIP z/DOWN z/RIGHTMOST z/INNER-RIGHT] i v))))
))
(deftest zipper-multi-insert-test (deftest zipper-multi-insert-test
(is (= [1 2 :a :b 3 :a :b 4] (is (= [1 2 :a :b 3 :a :b 4]
@ -37,22 +37,22 @@
z/DOWN z/DOWN
z/RIGHT z/RIGHT
z/RIGHT z/RIGHT
(s/multi-path z/INNER-RIGHT z/INNER-LEFT) (s/multi-path z/INNER-RIGHT z/INNER-LEFT)]
]
[:a :b] [:a :b]
[1 2 3 4] [1 2 3 4])
)
(setval [z/VECTOR-ZIP (setval [z/VECTOR-ZIP
z/DOWN z/DOWN
z/RIGHT z/RIGHT
z/RIGHT z/RIGHT
(s/multi-path z/INNER-LEFT z/INNER-RIGHT) (s/multi-path z/INNER-LEFT z/INNER-RIGHT)]
]
[:a :b] [:a :b]
[1 2 3 4] [1 2 3 4]))))
)
))
)
(deftest zipper-down-up-test (deftest zipper-down-up-test
(is (= [1 [2 3 5] 6] (is (= [1 [2 3 5] 6]
@ -67,9 +67,9 @@
[z/UP z/RIGHT]) [z/UP z/RIGHT])
z/NODE] z/NODE]
inc inc
[1 [2 3 4] 5] [1 [2 3 4] 5]))))
)))
)
(deftest next-terminate-test (deftest next-terminate-test
@ -83,10 +83,10 @@
(s/selected? z/NODE number? even?) (s/selected? z/NODE number? even?)
z/NODE-SEQ] z/NODE-SEQ]
[] []
[1 2 [3 [[4]] 5] 6] [1 2 [3 [[4]] 5] 6]))))
)
))
)
(deftest zipper-nav-stop-test (deftest zipper-nav-stop-test
(is (= [1] (is (= [1]
@ -96,19 +96,19 @@
(is (= [1] (is (= [1]
(transform [z/VECTOR-ZIP z/DOWN z/RIGHT z/NODE] inc [1]))) (transform [z/VECTOR-ZIP z/DOWN z/RIGHT z/NODE] inc [1])))
(is (= [] (is (= []
(transform [z/VECTOR-ZIP z/DOWN z/NODE] inc []))) (transform [z/VECTOR-ZIP z/DOWN z/NODE] inc []))))
)
(deftest find-first-test (deftest find-first-test
(is (= [1 [3 [[4]] 5] 6] (is (= [1 [3 [[4]] 5] 6]
(setval [z/VECTOR-ZIP (setval [z/VECTOR-ZIP
(z/find-first #(and (number? %) (even? %))) (z/find-first #(and (number? %) (even? %)))
z/NODE-SEQ z/NODE-SEQ]
]
[] []
[1 2 [3 [[4]] 5] 6]) [1 2 [3 [[4]] 5] 6]))))
))
)
(deftest nodeseq-expand-test (deftest nodeseq-expand-test
(is (= [2 [2] [[4 4 4]] 4 4 4 6] (is (= [2 [2] [[4 4 4]] 4 4 4 6]
@ -119,6 +119,4 @@
z/NODE-SEQ] z/NODE-SEQ]
(fn [v _] (fn [v _]
(repeat v (inc v))) (repeat v (inc v)))
[1 [2] [[3]] 3 6] [1 [2] [[3]] 3 6]))))
)))
)