Merge branch 'prot-redesign'
This commit is contained in:
Nathan Marz
commit
23a501f4ac
9 changed files with 1385 additions and 1342 deletions
|
|
@ -2,8 +2,7 @@
|
|||
#+cljs (:require-macros
|
||||
[com.rpl.specter.macros
|
||||
:refer
|
||||
[pathed-collector
|
||||
variable-pathed-nav
|
||||
[fixed-pathed-collector
|
||||
fixed-pathed-nav
|
||||
defcollector
|
||||
defnav
|
||||
|
|
@ -14,10 +13,9 @@
|
|||
[com.rpl.specter.util-macros :refer
|
||||
[doseqres]]
|
||||
)
|
||||
(:use [com.rpl.specter.protocols :only [Navigator]]
|
||||
(:use [com.rpl.specter.protocols :only [ImplicitNav]]
|
||||
#+clj [com.rpl.specter.macros :only
|
||||
[pathed-collector
|
||||
variable-pathed-nav
|
||||
[fixed-pathed-collector
|
||||
fixed-pathed-nav
|
||||
defcollector
|
||||
defnav
|
||||
|
|
@ -27,6 +25,7 @@
|
|||
#+clj [com.rpl.specter.util-macros :only [doseqres]]
|
||||
)
|
||||
(:require [com.rpl.specter.impl :as i]
|
||||
[com.rpl.specter.navs :as n]
|
||||
[clojure.set :as set])
|
||||
)
|
||||
|
||||
|
|
@ -172,19 +171,14 @@
|
|||
|
||||
(defn params-reset [params-path]
|
||||
;; TODO: error if not paramsneededpath
|
||||
(let [s (i/params-needed-selector params-path)
|
||||
t (i/params-needed-transformer params-path)
|
||||
(let [nav (i/params-needed-nav params-path)
|
||||
needed (i/num-needed-params params-path)]
|
||||
(i/->ParamsNeededPath
|
||||
(i/->TransformFunctions
|
||||
i/RichPathExecutor
|
||||
(fn [params params-idx vals structure next-fn]
|
||||
(s params (- params-idx needed) vals structure next-fn)
|
||||
)
|
||||
(fn [params params-idx vals structure next-fn]
|
||||
(t params (- params-idx needed) vals structure next-fn)
|
||||
))
|
||||
0)))
|
||||
(richnav 0
|
||||
(select* [this params params-idx 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]
|
||||
(i/exec-rich-transform* nav params (- params-idx needed) vals structure next-fn)
|
||||
))))
|
||||
|
||||
;; Built-in pathing and context operations
|
||||
|
||||
|
|
@ -199,6 +193,7 @@
|
|||
structure
|
||||
))
|
||||
|
||||
|
||||
(defnav
|
||||
^{:doc "Stays navigated at the current point. Essentially a no-op navigator."}
|
||||
STAY
|
||||
|
|
@ -208,7 +203,6 @@
|
|||
(transform* [this structure next-fn]
|
||||
(next-fn structure)))
|
||||
|
||||
|
||||
(def
|
||||
^{:doc "For usage with `multi-transform`, defines an endpoint in the navigation
|
||||
that will have the parameterized transform function run. The transform
|
||||
|
|
@ -216,10 +210,10 @@
|
|||
given as the first arguments"}
|
||||
terminal
|
||||
(richnav 1
|
||||
(select* [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"))
|
||||
(transform* [params params-idx vals structure next-fn]
|
||||
(i/terminal* params params-idx vals structure)
|
||||
(transform* [this params params-idx vals structure next-fn]
|
||||
(n/terminal* params params-idx vals structure)
|
||||
)))
|
||||
|
||||
(defnavconstructor terminal-val
|
||||
|
|
@ -229,11 +223,15 @@
|
|||
[v]
|
||||
(p (i/fast-constantly v)))
|
||||
|
||||
(def
|
||||
(defnav
|
||||
^{:doc "Navigate to every element of the collection. For maps navigates to
|
||||
a vector of `[key value]`."}
|
||||
ALL
|
||||
(comp-paths (i/->AllNavigator)))
|
||||
[]
|
||||
(select* [this structure next-fn]
|
||||
(n/all-select structure next-fn))
|
||||
(transform* [this structure next-fn]
|
||||
(n/all-transform structure next-fn)))
|
||||
|
||||
(defnav
|
||||
^{:doc "Navigate to each value of the map. This is more efficient than
|
||||
|
|
@ -245,23 +243,25 @@
|
|||
(next-fn v)
|
||||
))
|
||||
(transform* [this structure next-fn]
|
||||
(i/map-vals-transform structure next-fn)
|
||||
(n/map-vals-transform structure next-fn)
|
||||
))
|
||||
|
||||
|
||||
(def VAL (i/->ValCollect))
|
||||
(defcollector VAL []
|
||||
(collect-val [this structure]
|
||||
structure))
|
||||
|
||||
(def
|
||||
^{:doc "Navigate to the last element of the collection. If the collection is
|
||||
empty navigation is stopped at this point."}
|
||||
LAST
|
||||
(comp-paths (i/->PosNavigator i/get-last i/update-last)))
|
||||
(n/PosNavigator n/get-last n/update-last))
|
||||
|
||||
(def
|
||||
^{:doc "Navigate to the first element of the collection. If the collection is
|
||||
empty navigation is stopped at this point."}
|
||||
FIRST
|
||||
(comp-paths (i/->PosNavigator i/get-first i/update-first)))
|
||||
(n/PosNavigator n/get-first n/update-first))
|
||||
|
||||
(defnav
|
||||
^{:doc "Uses start-fn and end-fn to determine the bounds of the subsequence
|
||||
|
|
@ -269,9 +269,9 @@
|
|||
srange-dynamic
|
||||
[start-fn end-fn]
|
||||
(select* [this structure next-fn]
|
||||
(i/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]
|
||||
(i/srange-transform structure (start-fn structure) (end-fn structure) next-fn)
|
||||
(n/srange-transform structure (start-fn structure) (end-fn structure) next-fn)
|
||||
))
|
||||
|
||||
(defnav
|
||||
|
|
@ -280,9 +280,9 @@
|
|||
srange
|
||||
[start end]
|
||||
(select* [this structure next-fn]
|
||||
(i/srange-select structure start end next-fn))
|
||||
(n/srange-select structure start end next-fn))
|
||||
(transform* [this structure next-fn]
|
||||
(i/srange-transform structure start end next-fn)
|
||||
(n/srange-transform structure start end next-fn)
|
||||
))
|
||||
|
||||
(defnav
|
||||
|
|
@ -290,15 +290,15 @@
|
|||
continuous-subseqs
|
||||
[pred]
|
||||
(select* [this structure next-fn]
|
||||
(doseqres NONE [[s e] (i/matching-ranges structure pred)]
|
||||
(i/srange-select structure s e next-fn)
|
||||
(doseqres NONE [[s e] (n/matching-ranges structure pred)]
|
||||
(n/srange-select structure s e next-fn)
|
||||
))
|
||||
(transform* [this structure next-fn]
|
||||
(reduce
|
||||
(fn [structure [s e]]
|
||||
(i/srange-transform structure s e next-fn))
|
||||
(n/srange-transform structure s e next-fn))
|
||||
structure
|
||||
(reverse (i/matching-ranges structure pred))
|
||||
(reverse (n/matching-ranges structure pred))
|
||||
)))
|
||||
|
||||
(defnav
|
||||
|
|
@ -309,7 +309,7 @@
|
|||
(next-fn []))
|
||||
(transform* [this structure next-fn]
|
||||
(let [to-prepend (next-fn [])]
|
||||
(i/prepend-all structure to-prepend)
|
||||
(n/prepend-all structure to-prepend)
|
||||
)))
|
||||
|
||||
(defnav
|
||||
|
|
@ -320,7 +320,7 @@
|
|||
(next-fn []))
|
||||
(transform* [this structure next-fn]
|
||||
(let [to-append (next-fn [])]
|
||||
(i/append-all structure to-append)
|
||||
(n/append-all structure to-append)
|
||||
)))
|
||||
|
||||
(defnav
|
||||
|
|
@ -360,18 +360,18 @@
|
|||
walker
|
||||
[afn]
|
||||
(select* [this structure next-fn]
|
||||
(i/walk-select afn next-fn structure))
|
||||
(n/walk-select afn next-fn structure))
|
||||
(transform* [this structure next-fn]
|
||||
(i/walk-until afn next-fn structure)))
|
||||
(n/walk-until afn next-fn structure)))
|
||||
|
||||
(defnav
|
||||
^{:doc "Like `walker` but maintains metadata of any forms traversed."}
|
||||
codewalker
|
||||
[afn]
|
||||
(select* [this structure next-fn]
|
||||
(i/walk-select afn next-fn structure))
|
||||
(n/walk-select afn next-fn structure))
|
||||
(transform* [this structure next-fn]
|
||||
(i/codewalk-until afn next-fn structure)))
|
||||
(n/codewalk-until afn next-fn structure)))
|
||||
|
||||
(defpathedfn subselect
|
||||
"Navigates to a sequence that contains the results of (select ...),
|
||||
|
|
@ -460,32 +460,32 @@
|
|||
will be parameterized in the order of which the parameterized navigators
|
||||
were declared."
|
||||
[& path]
|
||||
(if-let [afn (i/extract-basic-filter-fn path)]
|
||||
(if-let [afn (n/extract-basic-filter-fn path)]
|
||||
afn
|
||||
(fixed-pathed-nav [late path]
|
||||
(select* [this structure next-fn]
|
||||
(i/filter-select
|
||||
#(i/selected?* late %)
|
||||
#(n/selected?* late %)
|
||||
structure
|
||||
next-fn))
|
||||
(transform* [this structure next-fn]
|
||||
(i/filter-transform
|
||||
#(i/selected?* late %)
|
||||
#(n/selected?* late %)
|
||||
structure
|
||||
next-fn)))))
|
||||
|
||||
(defpathedfn not-selected? [& path]
|
||||
(if-let [afn (i/extract-basic-filter-fn path)]
|
||||
(if-let [afn (n/extract-basic-filter-fn path)]
|
||||
(fn [s] (not (afn s)))
|
||||
(fixed-pathed-nav [late path]
|
||||
(select* [this structure next-fn]
|
||||
(i/filter-select
|
||||
#(i/not-selected?* late %)
|
||||
#(n/not-selected?* late %)
|
||||
structure
|
||||
next-fn))
|
||||
(transform* [this structure next-fn]
|
||||
(i/filter-transform
|
||||
#(i/not-selected?* late %)
|
||||
#(n/not-selected?* late %)
|
||||
structure
|
||||
next-fn)))))
|
||||
|
||||
|
|
@ -514,28 +514,6 @@
|
|||
(transform* [this structure next-fn]
|
||||
(next-fn (compiled-transform late update-fn structure)))))
|
||||
|
||||
(extend-type #+clj clojure.lang.Keyword #+cljs cljs.core/Keyword
|
||||
Navigator
|
||||
(select* [kw structure next-fn]
|
||||
(next-fn (get structure kw)))
|
||||
(transform* [kw structure next-fn]
|
||||
(assoc structure kw (next-fn (get structure kw)))
|
||||
))
|
||||
|
||||
(extend-type #+clj clojure.lang.AFn #+cljs function
|
||||
Navigator
|
||||
(select* [afn structure next-fn]
|
||||
(i/filter-select afn structure next-fn))
|
||||
(transform* [afn structure next-fn]
|
||||
(i/filter-transform afn structure next-fn)))
|
||||
|
||||
(extend-type #+clj clojure.lang.PersistentHashSet #+cljs cljs.core/PersistentHashSet
|
||||
Navigator
|
||||
(select* [aset structure next-fn]
|
||||
(i/filter-select aset structure next-fn))
|
||||
(transform* [aset structure next-fn]
|
||||
(i/filter-transform aset structure next-fn)))
|
||||
|
||||
(def
|
||||
^{:doc "Keeps the element only if it matches the supplied predicate. This is the
|
||||
late-bound parameterized version of using a function directly in a path."}
|
||||
|
|
@ -543,6 +521,23 @@
|
|||
i/pred*
|
||||
)
|
||||
|
||||
(extend-type nil
|
||||
ImplicitNav
|
||||
(implicit-nav [this] STAY))
|
||||
|
||||
(extend-type #+clj clojure.lang.Keyword #+cljs cljs.core/Keyword
|
||||
ImplicitNav
|
||||
(implicit-nav [this] (keypath this))
|
||||
)
|
||||
|
||||
(extend-type #+clj clojure.lang.AFn #+cljs function
|
||||
ImplicitNav
|
||||
(implicit-nav [this] (pred this)))
|
||||
|
||||
(extend-type #+clj clojure.lang.PersistentHashSet #+cljs cljs.core/PersistentHashSet
|
||||
ImplicitNav
|
||||
(implicit-nav [this] (pred this)))
|
||||
|
||||
(defnav
|
||||
^{:doc "Navigates to the provided val if the structure is nil. Otherwise it stays
|
||||
navigated at the structure."}
|
||||
|
|
@ -585,7 +580,7 @@
|
|||
current value to the collected vals."}
|
||||
collect
|
||||
[& path]
|
||||
(pathed-collector [late path]
|
||||
(fixed-pathed-collector [late path]
|
||||
(collect-val [this structure]
|
||||
(compiled-select late structure)
|
||||
)))
|
||||
|
|
@ -595,7 +590,7 @@
|
|||
current value to the collected vals."}
|
||||
collect-one
|
||||
[& path]
|
||||
(pathed-collector [late path]
|
||||
(fixed-pathed-collector [late path]
|
||||
(collect-val [this structure]
|
||||
(compiled-select-one late structure)
|
||||
)))
|
||||
|
|
@ -615,7 +610,7 @@
|
|||
|
||||
(def
|
||||
^{:doc "Drops all collected values for subsequent navigation."}
|
||||
DISPENSE i/DISPENSE*)
|
||||
DISPENSE n/DISPENSE*)
|
||||
|
||||
|
||||
(defpathedfn if-path
|
||||
|
|
@ -623,66 +618,66 @@
|
|||
([cond-p then-path]
|
||||
(if-path cond-p then-path STOP))
|
||||
([cond-p then-path else-path]
|
||||
(let [then-comp (i/comp-paths* then-path)
|
||||
else-comp (i/comp-paths* else-path)
|
||||
(let [then-comp (i/comp-paths-internalized then-path)
|
||||
else-comp (i/comp-paths-internalized else-path)
|
||||
then-needed (i/num-needed-params then-comp)
|
||||
else-needed (i/num-needed-params else-comp)
|
||||
[then-s then-t] (i/extract-rich-tfns then-comp)
|
||||
[else-s else-t] (i/extract-rich-tfns else-comp)]
|
||||
(if-let [afn (i/extract-basic-filter-fn cond-p)]
|
||||
then-nav (i/extract-rich-nav then-comp)
|
||||
else-nav (i/extract-rich-nav else-comp)]
|
||||
(if-let [afn (n/extract-basic-filter-fn cond-p)]
|
||||
(richnav (+ then-needed else-needed)
|
||||
(select* [params params-idx vals structure next-fn]
|
||||
(i/if-select
|
||||
(select* [this params params-idx vals structure next-fn]
|
||||
(n/if-select
|
||||
params
|
||||
params-idx
|
||||
vals
|
||||
structure
|
||||
next-fn
|
||||
afn
|
||||
then-s
|
||||
then-nav
|
||||
then-needed
|
||||
else-s
|
||||
else-nav
|
||||
))
|
||||
(transform* [params params-idx vals structure next-fn]
|
||||
(i/if-transform
|
||||
(transform* [this params params-idx vals structure next-fn]
|
||||
(n/if-transform
|
||||
params
|
||||
params-idx
|
||||
vals
|
||||
structure
|
||||
next-fn
|
||||
afn
|
||||
then-t
|
||||
then-nav
|
||||
then-needed
|
||||
else-t
|
||||
else-nav
|
||||
))))
|
||||
(let [cond-comp (i/comp-paths* cond-p)
|
||||
(let [cond-comp (i/comp-paths-internalized cond-p)
|
||||
cond-needed (i/num-needed-params cond-comp)]
|
||||
(richnav (+ then-needed else-needed cond-needed)
|
||||
(select* [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)]
|
||||
(i/if-select
|
||||
(n/if-select
|
||||
params
|
||||
(+ params-idx cond-needed)
|
||||
vals
|
||||
structure
|
||||
next-fn
|
||||
#(i/selected?* late-cond %)
|
||||
then-s
|
||||
#(n/selected?* late-cond %)
|
||||
then-nav
|
||||
then-needed
|
||||
else-s
|
||||
else-nav
|
||||
)))
|
||||
(transform* [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)]
|
||||
(i/if-transform
|
||||
(n/if-transform
|
||||
params
|
||||
(+ params-idx cond-needed)
|
||||
vals
|
||||
structure
|
||||
next-fn
|
||||
#(i/selected?* late-cond %)
|
||||
then-t
|
||||
#(n/selected?* late-cond %)
|
||||
then-nav
|
||||
then-needed
|
||||
else-t
|
||||
else-nav
|
||||
))))))))
|
||||
|
||||
(defpathedfn cond-path
|
||||
|
|
@ -710,23 +705,23 @@
|
|||
([] STAY)
|
||||
([path] (i/comp-paths* path))
|
||||
([path1 path2]
|
||||
(let [comp1 (i/comp-paths* path1)
|
||||
comp2 (i/comp-paths* path2)
|
||||
(let [comp1 (i/comp-paths-internalized path1)
|
||||
comp2 (i/comp-paths-internalized path2)
|
||||
comp1-needed (i/num-needed-params comp1)
|
||||
[s1 t1] (i/extract-rich-tfns comp1)
|
||||
[s2 t2] (i/extract-rich-tfns comp2)
|
||||
nav1 (i/extract-rich-nav comp1)
|
||||
nav2 (i/extract-rich-nav comp2)
|
||||
]
|
||||
(richnav (+ comp1-needed (i/num-needed-params comp2))
|
||||
(select* [params params-idx vals structure next-fn]
|
||||
(let [res1 (s1 params params-idx vals structure next-fn)
|
||||
res2 (s2 params (+ params-idx comp1-needed) 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)
|
||||
res2 (i/exec-rich-select* nav2 params (+ params-idx comp1-needed) vals structure next-fn)]
|
||||
(if (identical? NONE res2)
|
||||
res1
|
||||
res2
|
||||
)))
|
||||
(transform* [params params-idx vals structure next-fn]
|
||||
(let [s1 (t1 params params-idx vals structure next-fn)]
|
||||
(t2 params (+ params-idx comp1-needed) vals s1 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)]
|
||||
(i/exec-rich-transform* nav2 params (+ params-idx comp1-needed) vals s1 next-fn)
|
||||
)))))
|
||||
([path1 path2 & paths]
|
||||
(reduce multi-path (multi-path path1 path2) paths)
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@
|
|||
~@setters
|
||||
(com.rpl.specter.impl/bind-params* this# ~a 0)
|
||||
)))]
|
||||
`(defrecord ~'ParamsNeededPath [~'transform-fns ~'num-needed-params]
|
||||
`(defrecord ~'ParamsNeededPath [~'rich-nav ~'num-needed-params]
|
||||
~fn-type
|
||||
~@impls
|
||||
~var-arity-impl
|
||||
|
|
|
|||
14
src/clj/com/rpl/specter/defnavhelpers.cljx
Normal file
14
src/clj/com/rpl/specter/defnavhelpers.cljx
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
(ns com.rpl.specter.defnavhelpers
|
||||
(:require [com.rpl.specter.impl :as i]))
|
||||
|
||||
(defn param-delta [i]
|
||||
(fn [^objects params params-idx]
|
||||
(aget params (+ params-idx i))
|
||||
))
|
||||
|
||||
(defn bound-params [path start-delta]
|
||||
(fn [^objects params params-idx]
|
||||
(if (i/params-needed-path? path)
|
||||
(i/bind-params* path params (+ params-idx start-delta))
|
||||
path
|
||||
)))
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,6 +1,9 @@
|
|||
(ns com.rpl.specter.macros
|
||||
(:use [com.rpl.specter.protocols :only [Navigator]]
|
||||
[com.rpl.specter.impl :only [RichNavigator]])
|
||||
(:require [com.rpl.specter.impl :as i]
|
||||
[clojure.walk :as cljwalk])
|
||||
[clojure.walk :as cljwalk]
|
||||
[com.rpl.specter.defnavhelpers :as dnh])
|
||||
)
|
||||
|
||||
(defn ^:no-doc gensyms [amt]
|
||||
|
|
@ -8,122 +11,12 @@
|
|||
|
||||
(defn ^:no-doc determine-params-impls [[name1 & impl1] [name2 & impl2]]
|
||||
(if-not (= #{name1 name2} #{'select* 'transform*})
|
||||
(i/throw-illegal "defpath must implement select* and transform*, instead got "
|
||||
(i/throw-illegal "defnav must implement select* and transform*, instead got "
|
||||
name1 " and " name2))
|
||||
(if (= name1 'select*)
|
||||
[impl1 impl2]
|
||||
[impl2 impl1]))
|
||||
|
||||
|
||||
(def ^:no-doc PARAMS-SYM (vary-meta (gensym "params") assoc :tag 'objects))
|
||||
(def ^:no-doc PARAMS-IDX-SYM (gensym "params-idx"))
|
||||
|
||||
(defn ^:no-doc paramsnav* [bindings num-params [impl1 impl2]]
|
||||
(let [[[[_ s-structure-sym s-next-fn-sym] & select-body]
|
||||
[[_ t-structure-sym t-next-fn-sym] & transform-body]]
|
||||
(determine-params-impls impl1 impl2)]
|
||||
(if (= 0 num-params)
|
||||
`(i/no-params-compiled-path
|
||||
(i/->TransformFunctions
|
||||
i/LeanPathExecutor
|
||||
(fn [~s-structure-sym ~s-next-fn-sym]
|
||||
~@select-body)
|
||||
(fn [~t-structure-sym ~t-next-fn-sym]
|
||||
~@transform-body)
|
||||
))
|
||||
`(i/->ParamsNeededPath
|
||||
(i/->TransformFunctions
|
||||
i/RichPathExecutor
|
||||
(fn [~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~s-structure-sym next-fn#]
|
||||
(let [~s-next-fn-sym (fn [structure#]
|
||||
(next-fn#
|
||||
~PARAMS-SYM
|
||||
(+ ~PARAMS-IDX-SYM ~num-params)
|
||||
vals#
|
||||
structure#))
|
||||
~@bindings]
|
||||
~@select-body
|
||||
))
|
||||
(fn [~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~t-structure-sym next-fn#]
|
||||
(let [~t-next-fn-sym (fn [structure#]
|
||||
(next-fn#
|
||||
~PARAMS-SYM
|
||||
(+ ~PARAMS-IDX-SYM ~num-params)
|
||||
vals#
|
||||
structure#))
|
||||
~@bindings]
|
||||
~@transform-body
|
||||
)))
|
||||
~num-params
|
||||
))))
|
||||
|
||||
(defn ^:no-doc paramscollector* [post-bindings num-params [_ [_ structure-sym] & body]]
|
||||
`(let [collector# (fn [~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~structure-sym next-fn#]
|
||||
(let [~@post-bindings ~@[] ; to avoid syntax highlighting issues
|
||||
c# (do ~@body)]
|
||||
(next-fn#
|
||||
~PARAMS-SYM
|
||||
(+ ~PARAMS-IDX-SYM ~num-params)
|
||||
(conj vals# c#)
|
||||
~structure-sym)
|
||||
))]
|
||||
(i/->ParamsNeededPath
|
||||
(i/->TransformFunctions
|
||||
i/RichPathExecutor
|
||||
collector#
|
||||
collector# )
|
||||
~num-params
|
||||
)))
|
||||
|
||||
(defn ^:no-doc pathed-nav* [builder paths-seq latefns-sym pre-bindings post-bindings impls]
|
||||
(let [num-params-sym (gensym "num-params")]
|
||||
`(let [paths# (map i/comp-paths* ~paths-seq)
|
||||
needed-params# (map i/num-needed-params paths#)
|
||||
offsets# (cons 0 (reductions + needed-params#))
|
||||
any-params-needed?# (->> paths#
|
||||
(filter i/params-needed-path?)
|
||||
empty?
|
||||
not)
|
||||
~num-params-sym (last offsets#)
|
||||
~latefns-sym (map
|
||||
(fn [o# p#]
|
||||
(if (i/compiled-path? p#)
|
||||
(fn [params# params-idx#]
|
||||
p# )
|
||||
(fn [params# params-idx#]
|
||||
(i/bind-params* p# params# (+ params-idx# o#))
|
||||
)))
|
||||
offsets#
|
||||
paths#)
|
||||
~@pre-bindings
|
||||
ret# ~(builder post-bindings num-params-sym impls)
|
||||
]
|
||||
(if (not any-params-needed?#)
|
||||
(i/bind-params* ret# nil 0)
|
||||
ret#
|
||||
))))
|
||||
|
||||
(defn ^:no-doc make-param-retrievers [params]
|
||||
(->> params
|
||||
(map-indexed
|
||||
(fn [i p]
|
||||
[p `(aget ~PARAMS-SYM
|
||||
(+ ~PARAMS-IDX-SYM ~i))]
|
||||
))
|
||||
(apply concat)))
|
||||
|
||||
|
||||
(defmacro nav
|
||||
"Defines a navigator with late bound parameters. This navigator can be precompiled
|
||||
with other navigators without knowing the parameters. When precompiled with other
|
||||
navigators, the resulting path takes in parameters for all navigators in the path
|
||||
that needed parameters (in the order in which they were declared)."
|
||||
[params impl1 impl2]
|
||||
(let [num-params (count params)
|
||||
retrieve-params (make-param-retrievers params)]
|
||||
(paramsnav* retrieve-params num-params [impl1 impl2])
|
||||
))
|
||||
|
||||
(defmacro richnav
|
||||
"Defines a navigator with full access to collected vals, the parameters array,
|
||||
and the parameters array index. `next-fn` expects to receive the params array,
|
||||
|
|
@ -134,25 +27,224 @@
|
|||
[num-params impl1 impl2]
|
||||
(let [[[s-params & s-body] [t-params & t-body]] (determine-params-impls impl1 impl2)
|
||||
s-next-fn-sym (last s-params)
|
||||
s-pidx-sym (second s-params)
|
||||
s-pidx-sym (nth s-params 2)
|
||||
t-next-fn-sym (last t-params)
|
||||
t-pidx-sym (second t-params)
|
||||
t-pidx-sym (nth t-params 2)
|
||||
]
|
||||
`(let [num-params# ~num-params
|
||||
tfns# (i/->TransformFunctions
|
||||
i/RichPathExecutor
|
||||
(fn ~s-params
|
||||
nav# (reify RichNavigator
|
||||
(~'rich-select* ~s-params
|
||||
(let [~s-next-fn-sym (i/mk-jump-next-fn ~s-next-fn-sym ~s-pidx-sym num-params#)]
|
||||
~@s-body))
|
||||
(fn ~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#)]
|
||||
~@t-body))
|
||||
)]
|
||||
(if (zero? num-params#)
|
||||
(i/no-params-compiled-path tfns#)
|
||||
(i/->ParamsNeededPath tfns# num-params#)
|
||||
(i/no-params-rich-compiled-path nav#)
|
||||
(i/->ParamsNeededPath nav# num-params#)
|
||||
))))
|
||||
|
||||
(defmacro ^:no-doc lean-nav* [& impls]
|
||||
`(reify Navigator ~@impls))
|
||||
|
||||
(defn ^:no-doc operation-with-bindings [bindings params-sym params-idx-sym op-maker]
|
||||
(let [bindings (partition 2 bindings)
|
||||
binding-fn-syms (gensyms (count bindings))
|
||||
binding-syms (map first bindings)
|
||||
fn-exprs (map second bindings)
|
||||
binding-fn-declarations (vec (mapcat vector binding-fn-syms fn-exprs))
|
||||
binding-declarations (vec (mapcat (fn [s f] [s `(~f ~params-sym ~params-idx-sym)])
|
||||
binding-syms
|
||||
binding-fn-syms))
|
||||
body (op-maker binding-declarations)]
|
||||
`(let [~@binding-fn-declarations]
|
||||
~body
|
||||
)))
|
||||
|
||||
(defmacro ^:no-doc rich-nav-with-bindings [num-params-code bindings & impls]
|
||||
(let [[[[_ s-structure-sym s-next-fn-sym] & s-body]
|
||||
[[_ t-structure-sym t-next-fn-sym] & t-body]]
|
||||
(apply determine-params-impls impls)
|
||||
params-sym (gensym "params")
|
||||
params-idx-sym (gensym "params-idx")
|
||||
]
|
||||
(operation-with-bindings
|
||||
bindings
|
||||
params-sym
|
||||
params-idx-sym
|
||||
(fn [binding-declarations]
|
||||
`(reify RichNavigator
|
||||
(~'rich-select* [this# ~params-sym ~params-idx-sym vals# ~s-structure-sym next-fn#]
|
||||
(let [~@binding-declarations
|
||||
next-params-idx# (+ ~params-idx-sym ~num-params-code)
|
||||
~s-next-fn-sym (fn [structure#]
|
||||
(next-fn# ~params-sym
|
||||
next-params-idx#
|
||||
vals#
|
||||
structure#))]
|
||||
~@s-body
|
||||
))
|
||||
(~'rich-transform* [this# ~params-sym ~params-idx-sym vals# ~t-structure-sym next-fn#]
|
||||
(let [~@binding-declarations
|
||||
next-params-idx# (+ ~params-idx-sym ~num-params-code)
|
||||
~t-next-fn-sym (fn [structure#]
|
||||
(next-fn# ~params-sym
|
||||
next-params-idx#
|
||||
vals#
|
||||
structure#))]
|
||||
~@t-body
|
||||
))
|
||||
)))))
|
||||
|
||||
(defmacro ^:no-doc collector-with-bindings [num-params-code bindings impl]
|
||||
(let [[_ [_ structure-sym] & body] impl
|
||||
params-sym (gensym "params")
|
||||
params-idx-sym (gensym "params")]
|
||||
(operation-with-bindings
|
||||
bindings
|
||||
params-sym
|
||||
params-idx-sym
|
||||
(fn [binding-declarations]
|
||||
`(let [num-params# ~num-params-code
|
||||
cfn# (fn [~params-sym ~params-idx-sym vals# ~structure-sym next-fn#]
|
||||
(let [~@binding-declarations]
|
||||
(next-fn# ~params-sym (+ ~params-idx-sym num-params#) (conj vals# (do ~@body)) ~structure-sym)
|
||||
))]
|
||||
(reify RichNavigator
|
||||
(~'rich-select* [this# 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#]
|
||||
(cfn# params# params-idx# vals# structure# next-fn#))
|
||||
))))))
|
||||
|
||||
(defn- delta-param-bindings [params]
|
||||
(->> params
|
||||
(map-indexed (fn [i p] [p `(dnh/param-delta ~i)]))
|
||||
(apply concat)
|
||||
vec
|
||||
))
|
||||
|
||||
(defmacro nav
|
||||
"Defines a navigator with late bound parameters. This navigator can be precompiled
|
||||
with other navigators without knowing the parameters. When precompiled with other
|
||||
navigators, the resulting path takes in parameters for all navigators in the path
|
||||
that needed parameters (in the order in which they were declared)."
|
||||
[params & impls]
|
||||
(if (empty? params)
|
||||
`(i/lean-compiled-path (lean-nav* ~@impls))
|
||||
`(vary-meta
|
||||
(fn ~params (i/lean-compiled-path (lean-nav* ~@impls)))
|
||||
assoc
|
||||
:highernav
|
||||
{:type :lean
|
||||
:params-needed-path
|
||||
(i/->ParamsNeededPath
|
||||
(rich-nav-with-bindings ~(count params)
|
||||
~(delta-param-bindings params)
|
||||
~@impls
|
||||
)
|
||||
~(count params))}
|
||||
)))
|
||||
|
||||
(defmacro collector
|
||||
"Defines a Collector with late bound parameters. This collector can be precompiled
|
||||
with other selectors without knowing the parameters. When precompiled with other
|
||||
selectors, the resulting selector takes in parameters for all selectors in the path
|
||||
that needed parameters (in the order in which they were declared).
|
||||
"
|
||||
[params body]
|
||||
`(let [rich-nav# (collector-with-bindings ~(count params)
|
||||
~(delta-param-bindings params)
|
||||
~body
|
||||
)]
|
||||
(if ~(empty? params)
|
||||
(i/no-params-rich-compiled-path rich-nav#)
|
||||
(vary-meta
|
||||
(fn ~params
|
||||
(i/no-params-rich-compiled-path
|
||||
(collector-with-bindings 0 []
|
||||
~body)))
|
||||
assoc
|
||||
:highernav
|
||||
{:type :rich
|
||||
:params-needed-path
|
||||
(i/->ParamsNeededPath
|
||||
rich-nav#
|
||||
~(count params)
|
||||
)}
|
||||
))))
|
||||
|
||||
(defn ^:no-doc fixed-pathed-operation [bindings op-maker]
|
||||
(let [bindings (partition 2 bindings)
|
||||
late-path-syms (map first bindings)
|
||||
paths-code (vec (map second bindings))
|
||||
delta-syms (vec (gensyms (count bindings)))
|
||||
compiled-syms (vec (gensyms (count bindings)))
|
||||
runtime-bindings (vec (mapcat
|
||||
(fn [l c d]
|
||||
`[~l (dnh/bound-params ~c ~d)]
|
||||
)
|
||||
late-path-syms
|
||||
compiled-syms
|
||||
delta-syms))
|
||||
total-params-sym (gensym "total-params")
|
||||
body (op-maker runtime-bindings compiled-syms total-params-sym)]
|
||||
`(let [compiled# (doall (map i/comp-paths* ~paths-code))
|
||||
~compiled-syms compiled#
|
||||
deltas# (cons 0 (reductions + (map i/num-needed-params compiled#)))
|
||||
~delta-syms deltas#
|
||||
~total-params-sym (last deltas#)
|
||||
]
|
||||
~body
|
||||
)))
|
||||
|
||||
(defmacro fixed-pathed-nav
|
||||
"This helper is used to define navigators that take in a fixed number of other
|
||||
paths as input. Those paths may require late-bound params, so this helper
|
||||
will create a parameterized navigator if that is the case. If no late-bound params
|
||||
are required, then the result is executable."
|
||||
[bindings & impls]
|
||||
(fixed-pathed-operation bindings
|
||||
(fn [runtime-bindings compiled-syms total-params-sym]
|
||||
(let [late-syms (map first (partition 2 bindings))
|
||||
lean-bindings (mapcat vector late-syms compiled-syms)]
|
||||
`(if (zero? ~total-params-sym)
|
||||
(let [~@lean-bindings]
|
||||
(i/lean-compiled-path (lean-nav* ~@impls))
|
||||
)
|
||||
(i/->ParamsNeededPath
|
||||
(rich-nav-with-bindings ~total-params-sym
|
||||
~runtime-bindings
|
||||
~@impls
|
||||
)
|
||||
~total-params-sym
|
||||
)))
|
||||
)))
|
||||
|
||||
|
||||
(defmacro fixed-pathed-collector
|
||||
"This helper is used to define collectors that take in a fixed number of
|
||||
paths as input. That path may require late-bound params, so this helper
|
||||
will create a parameterized navigator if that is the case. If no late-bound params
|
||||
are required, then the result is executable."
|
||||
[bindings & body]
|
||||
(fixed-pathed-operation bindings
|
||||
(fn [runtime-bindings compiled-syms total-params-sym]
|
||||
(let [late-syms (map first (partition 2 bindings))
|
||||
lean-bindings (mapcat vector late-syms compiled-syms)]
|
||||
`(if (zero? ~total-params-sym)
|
||||
(let [~@lean-bindings]
|
||||
(i/no-params-rich-compiled-path
|
||||
(collector-with-bindings 0 [] ~@body)))
|
||||
(i/->ParamsNeededPath
|
||||
(collector-with-bindings ~total-params-sym
|
||||
~runtime-bindings
|
||||
~@body
|
||||
)
|
||||
~total-params-sym
|
||||
))))))
|
||||
|
||||
(defmacro paramsfn [params [structure-sym] & impl]
|
||||
`(nav ~params
|
||||
(~'select* [this# structure# next-fn#]
|
||||
|
|
@ -164,81 +256,17 @@
|
|||
(i/filter-transform afn# structure# next-fn#)
|
||||
))))
|
||||
|
||||
(defmacro paramscollector
|
||||
"Defines a Collector with late bound parameters. This collector can be precompiled
|
||||
with other selectors without knowing the parameters. When precompiled with other
|
||||
selectors, the resulting selector takes in parameters for all selectors in the path
|
||||
that needed parameters (in the order in which they were declared).
|
||||
"
|
||||
[params impl]
|
||||
(let [num-params (count params)
|
||||
retrieve-params (make-param-retrievers params)]
|
||||
(paramscollector* retrieve-params num-params impl)
|
||||
))
|
||||
|
||||
(defmacro defnav [name & body]
|
||||
`(def ~name (nav ~@body)))
|
||||
|
||||
(defmacro defcollector [name & body]
|
||||
`(def ~name (paramscollector ~@body)))
|
||||
`(def ~name (collector ~@body)))
|
||||
|
||||
(defmacro fixed-pathed-nav
|
||||
"This helper is used to define navigators that take in a fixed number of other
|
||||
paths as input. Those paths may require late-bound params, so this helper
|
||||
will create a parameterized navigator if that is the case. If no late-bound params
|
||||
are required, then the result is executable."
|
||||
[bindings impl1 impl2]
|
||||
(let [bindings (partition 2 bindings)
|
||||
paths (mapv second bindings)
|
||||
names (mapv first bindings)
|
||||
latefns-sym (gensym "latefns")
|
||||
latefn-syms (vec (gensyms (count paths)))]
|
||||
(pathed-nav*
|
||||
paramsnav*
|
||||
paths
|
||||
latefns-sym
|
||||
[latefn-syms latefns-sym]
|
||||
(mapcat (fn [n l] [n `(~l ~PARAMS-SYM ~PARAMS-IDX-SYM)]) names latefn-syms)
|
||||
[impl1 impl2])))
|
||||
|
||||
(defmacro variable-pathed-nav
|
||||
"This helper is used to define navigators that take in a variable number of other
|
||||
paths as input. Those paths may require late-bound params, so this helper
|
||||
will create a parameterized navigator if that is the case. If no late-bound params
|
||||
are required, then the result is executable."
|
||||
[[latepaths-seq-sym paths-seq] impl1 impl2]
|
||||
(let [latefns-sym (gensym "latefns")]
|
||||
(pathed-nav*
|
||||
paramsnav*
|
||||
paths-seq
|
||||
latefns-sym
|
||||
[]
|
||||
[latepaths-seq-sym `(map (fn [l#] (l# ~PARAMS-SYM ~PARAMS-IDX-SYM))
|
||||
~latefns-sym)]
|
||||
[impl1 impl2]
|
||||
)))
|
||||
|
||||
(defmacro pathed-collector
|
||||
"This helper is used to define collectors that take in a single selector
|
||||
paths as input. That path may require late-bound params, so this helper
|
||||
will create a parameterized selector if that is the case. If no late-bound params
|
||||
are required, then the result is executable."
|
||||
[[name path] impl]
|
||||
(let [latefns-sym (gensym "latefns")
|
||||
latefn (gensym "latefn")]
|
||||
(pathed-nav*
|
||||
paramscollector*
|
||||
[path]
|
||||
latefns-sym
|
||||
[[latefn] latefns-sym]
|
||||
[name `(~latefn ~PARAMS-SYM ~PARAMS-IDX-SYM)]
|
||||
impl
|
||||
)
|
||||
))
|
||||
|
||||
(defn- protpath-sym [name]
|
||||
(-> name (str "-prot") symbol))
|
||||
|
||||
|
||||
(defmacro defprotocolpath
|
||||
"Defines a navigator that chooses the path to take based on the type
|
||||
of the value at the current point. May be specified with parameters to
|
||||
|
|
@ -268,92 +296,67 @@
|
|||
]
|
||||
`(do
|
||||
(defprotocol ~prot-name (~m [structure#]))
|
||||
(let [nav# (reify RichNavigator
|
||||
(~'rich-select* [this# ~@rargs]
|
||||
(let [inav# ~retrieve]
|
||||
(i/exec-rich-select* inav# ~@rargs)
|
||||
))
|
||||
(~'rich-transform* [this# ~@rargs]
|
||||
(let [inav# ~retrieve]
|
||||
(i/exec-rich-transform* inav# ~@rargs)
|
||||
)))]
|
||||
(def ~name
|
||||
(if (= ~num-params 0)
|
||||
(i/no-params-compiled-path
|
||||
(i/->TransformFunctions
|
||||
i/RichPathExecutor
|
||||
(fn ~rargs
|
||||
(let [path# ~retrieve
|
||||
selector# (i/compiled-selector path#)]
|
||||
(selector# ~@rargs)
|
||||
))
|
||||
(fn ~rargs
|
||||
(let [path# ~retrieve
|
||||
transformer# (i/compiled-transformer path#)]
|
||||
(transformer# ~@rargs)
|
||||
))))
|
||||
(i/->ParamsNeededPath
|
||||
(i/->TransformFunctions
|
||||
i/RichPathExecutor
|
||||
(fn ~rargs
|
||||
(let [path# ~retrieve
|
||||
selector# (i/params-needed-selector path#)]
|
||||
(selector# ~@rargs)
|
||||
))
|
||||
(fn ~rargs
|
||||
(let [path# ~retrieve
|
||||
transformer# (i/params-needed-transformer path#)]
|
||||
(transformer# ~@rargs)
|
||||
)))
|
||||
~num-params
|
||||
)
|
||||
))))))
|
||||
(i/no-params-rich-compiled-path nav#)
|
||||
(i/->ParamsNeededPath nav# ~num-params)
|
||||
)))))))
|
||||
|
||||
|
||||
|
||||
|
||||
(defn ^:no-doc declared-name [name]
|
||||
(vary-meta (symbol (str name "-declared"))
|
||||
assoc :no-doc true))
|
||||
|
||||
|
||||
(defmacro declarepath
|
||||
([name]
|
||||
`(declarepath ~name []))
|
||||
([name params]
|
||||
(let [num-params (count params)
|
||||
(let [platform (if (contains? &env :locals) :cljs :clj)
|
||||
select-exec (if (= platform :clj)
|
||||
`i/exec-rich-select*
|
||||
`i/rich-select*)
|
||||
transform-exec (if (= platform :clj)
|
||||
`i/exec-rich-transform*
|
||||
`i/rich-transform*)
|
||||
num-params (count params)
|
||||
declared (declared-name name)
|
||||
rargs [(gensym "params") (gensym "pidx") (gensym "vals")
|
||||
(gensym "structure") (gensym "next-fn")]]
|
||||
`(do
|
||||
(declare ~declared)
|
||||
(def ~name
|
||||
(let [nav# (reify RichNavigator
|
||||
(~'rich-select* [this# ~@rargs]
|
||||
(~select-exec ~declared ~@rargs))
|
||||
(~'rich-transform* [this# ~@rargs]
|
||||
(~transform-exec ~declared ~@rargs)
|
||||
))]
|
||||
(if (= ~num-params 0)
|
||||
(i/no-params-compiled-path
|
||||
(i/->TransformFunctions
|
||||
i/RichPathExecutor
|
||||
(fn ~rargs
|
||||
(let [selector# (i/compiled-selector ~declared)]
|
||||
(selector# ~@rargs)
|
||||
))
|
||||
(fn ~rargs
|
||||
(let [transformer# (i/compiled-transformer ~declared)]
|
||||
(transformer# ~@rargs)
|
||||
))))
|
||||
(i/->ParamsNeededPath
|
||||
(i/->TransformFunctions
|
||||
i/RichPathExecutor
|
||||
(fn ~rargs
|
||||
(let [selector# (i/params-needed-selector ~declared)]
|
||||
(selector# ~@rargs)
|
||||
))
|
||||
(fn ~rargs
|
||||
(let [transformer# (i/params-needed-transformer ~declared)]
|
||||
(transformer# ~@rargs)
|
||||
)))
|
||||
~num-params
|
||||
)
|
||||
))))))
|
||||
(i/no-params-rich-compiled-path nav#)
|
||||
(i/->ParamsNeededPath nav# ~num-params)
|
||||
)))))))
|
||||
|
||||
(defmacro providepath [name apath]
|
||||
`(let [comped# (i/comp-paths* ~apath)
|
||||
`(let [comped# (i/comp-paths-internalized ~apath)
|
||||
expected-params# (i/num-needed-params ~name)
|
||||
needed-params# (i/num-needed-params comped#)]
|
||||
(if-not (= needed-params# expected-params#)
|
||||
(i/throw-illegal "Invalid number of params in provided path, expected "
|
||||
expected-params# " but got " needed-params#))
|
||||
(def ~(declared-name name)
|
||||
(update-in comped#
|
||||
[:transform-fns]
|
||||
i/coerce-tfns-rich)
|
||||
(i/extract-rich-nav (i/coerce-compiled->rich-nav comped#))
|
||||
)))
|
||||
|
||||
(defmacro extend-protocolpath
|
||||
|
|
@ -422,7 +425,8 @@
|
|||
(vary-meta
|
||||
(let [~csym (i/layered-wrapper ~anav)]
|
||||
(fn ~@checked-code))
|
||||
assoc :layerednav true))
|
||||
assoc :layerednav (or (-> ~anav meta :highernav :type) :rich)
|
||||
))
|
||||
))
|
||||
|
||||
|
||||
|
|
|
|||
471
src/clj/com/rpl/specter/navs.cljx
Normal file
471
src/clj/com/rpl/specter/navs.cljx
Normal file
|
|
@ -0,0 +1,471 @@
|
|||
(ns com.rpl.specter.navs
|
||||
#+cljs (:require-macros
|
||||
[com.rpl.specter.macros
|
||||
:refer
|
||||
[fixed-pathed-collector
|
||||
fixed-pathed-nav
|
||||
defcollector
|
||||
defnav
|
||||
defpathedfn
|
||||
richnav
|
||||
defnavconstructor
|
||||
]]
|
||||
[com.rpl.specter.util-macros :refer
|
||||
[doseqres]]
|
||||
)
|
||||
(:use #+clj [com.rpl.specter macros]
|
||||
#+clj [com.rpl.specter.util-macros :only [doseqres]])
|
||||
(:require [com.rpl.specter.impl :as i]
|
||||
[clojure.walk :as walk]
|
||||
#+clj [clojure.core.reducers :as r]
|
||||
[com.rpl.specter.defnavhelpers] ; so that for cljs it's loaded as macros expand to this
|
||||
)
|
||||
)
|
||||
|
||||
(defn- append [coll elem]
|
||||
(-> coll vec (conj elem)))
|
||||
|
||||
(defn not-selected?*
|
||||
[compiled-path structure]
|
||||
(->> structure
|
||||
(i/compiled-select-any* compiled-path)
|
||||
(identical? i/NONE)))
|
||||
|
||||
(defn selected?*
|
||||
[compiled-path structure]
|
||||
(not (not-selected?* compiled-path structure)))
|
||||
|
||||
(defn walk-select [pred continue-fn structure]
|
||||
(let [ret (i/mutable-cell i/NONE)
|
||||
walker (fn this [structure]
|
||||
(if (pred structure)
|
||||
(let [r (continue-fn structure)]
|
||||
(if-not (identical? r i/NONE)
|
||||
(i/set-cell! ret r))
|
||||
r
|
||||
)
|
||||
(walk/walk this identity structure)
|
||||
))]
|
||||
(walker structure)
|
||||
(i/get-cell ret)
|
||||
))
|
||||
|
||||
(defn key-select [akey structure next-fn]
|
||||
(next-fn (get structure akey)))
|
||||
|
||||
(defn key-transform [akey structure next-fn]
|
||||
(assoc structure akey (next-fn (get structure akey))
|
||||
))
|
||||
|
||||
(defn all-select [structure next-fn]
|
||||
(doseqres i/NONE [e structure]
|
||||
(next-fn e)))
|
||||
|
||||
#+cljs
|
||||
(defn queue? [coll]
|
||||
(= (type coll) (type #queue [])))
|
||||
|
||||
#+clj
|
||||
(defn queue? [coll]
|
||||
(instance? clojure.lang.PersistentQueue coll))
|
||||
|
||||
(defprotocol AllTransformProtocol
|
||||
(all-transform [structure next-fn]))
|
||||
|
||||
(defn- non-transient-map-all-transform [structure next-fn empty-map]
|
||||
(reduce-kv
|
||||
(fn [m k v]
|
||||
(let [[newk newv] (next-fn [k v])]
|
||||
(assoc m newk newv)
|
||||
))
|
||||
empty-map
|
||||
structure
|
||||
))
|
||||
|
||||
(extend-protocol AllTransformProtocol
|
||||
nil
|
||||
(all-transform [structure next-fn]
|
||||
nil
|
||||
)
|
||||
|
||||
;; in cljs they're PersistentVector so don't need a special case
|
||||
#+clj clojure.lang.MapEntry
|
||||
#+clj
|
||||
(all-transform [structure next-fn]
|
||||
(let [newk (next-fn (key structure))
|
||||
newv (next-fn (val structure))]
|
||||
(clojure.lang.MapEntry. newk newv)
|
||||
))
|
||||
|
||||
#+clj clojure.lang.PersistentVector #+cljs cljs.core/PersistentVector
|
||||
(all-transform [structure next-fn]
|
||||
(mapv next-fn structure))
|
||||
|
||||
#+clj
|
||||
clojure.lang.PersistentArrayMap
|
||||
#+clj
|
||||
(all-transform [structure next-fn]
|
||||
(let [k-it (.keyIterator structure)
|
||||
v-it (.valIterator structure)]
|
||||
(loop [ret {}]
|
||||
(if (.hasNext k-it)
|
||||
(let [k (.next k-it)
|
||||
v (.next v-it)
|
||||
[newk newv] (next-fn [k v])]
|
||||
(recur (assoc ret newk newv)))
|
||||
ret
|
||||
))))
|
||||
|
||||
#+cljs
|
||||
cljs.core/PersistentArrayMap
|
||||
#+cljs
|
||||
(all-transform [structure next-fn]
|
||||
(non-transient-map-all-transform structure next-fn {})
|
||||
)
|
||||
|
||||
#+clj clojure.lang.PersistentTreeMap #+cljs cljs.core/PersistentTreeMap
|
||||
(all-transform [structure next-fn]
|
||||
(non-transient-map-all-transform structure next-fn (empty structure))
|
||||
)
|
||||
|
||||
#+clj clojure.lang.PersistentHashMap #+cljs cljs.core/PersistentHashMap
|
||||
(all-transform [structure next-fn]
|
||||
(persistent!
|
||||
(reduce-kv
|
||||
(fn [m k v]
|
||||
(let [[newk newv] (next-fn [k v])]
|
||||
(assoc! m newk newv)
|
||||
))
|
||||
(transient
|
||||
#+clj clojure.lang.PersistentHashMap/EMPTY #+cljs cljs.core.PersistentHashMap.EMPTY
|
||||
)
|
||||
structure
|
||||
)))
|
||||
|
||||
|
||||
#+clj
|
||||
Object
|
||||
#+clj
|
||||
(all-transform [structure next-fn]
|
||||
(let [empty-structure (empty structure)]
|
||||
(cond (and (list? empty-structure) (not (queue? empty-structure)))
|
||||
;; this is done to maintain order, otherwise lists get reversed
|
||||
(doall (map next-fn structure))
|
||||
|
||||
(map? structure)
|
||||
;; reduce-kv is much faster than doing r/map through call to (into ...)
|
||||
(reduce-kv
|
||||
(fn [m k v]
|
||||
(let [[newk newv] (next-fn [k v])]
|
||||
(assoc m newk newv)
|
||||
))
|
||||
empty-structure
|
||||
structure
|
||||
)
|
||||
|
||||
:else
|
||||
(->> structure (r/map next-fn) (into empty-structure))
|
||||
)))
|
||||
|
||||
#+cljs
|
||||
default
|
||||
#+cljs
|
||||
(all-transform [structure next-fn]
|
||||
(let [empty-structure (empty structure)]
|
||||
(if (and (list? empty-structure) (not (queue? empty-structure)))
|
||||
;; this is done to maintain order, otherwise lists get reversed
|
||||
(doall (map next-fn structure))
|
||||
(into empty-structure (map #(next-fn %)) structure)
|
||||
)))
|
||||
)
|
||||
|
||||
(defprotocol MapValsTransformProtocol
|
||||
(map-vals-transform [structure next-fn]))
|
||||
|
||||
(defn map-vals-non-transient-transform [structure empty-map next-fn]
|
||||
(reduce-kv
|
||||
(fn [m k v]
|
||||
(assoc m k (next-fn v)))
|
||||
empty-map
|
||||
structure))
|
||||
|
||||
(extend-protocol MapValsTransformProtocol
|
||||
nil
|
||||
(map-vals-transform [structure next-fn]
|
||||
nil
|
||||
)
|
||||
|
||||
#+clj
|
||||
clojure.lang.PersistentArrayMap
|
||||
#+clj
|
||||
(map-vals-transform [structure next-fn]
|
||||
(let [k-it (.keyIterator structure)
|
||||
v-it (.valIterator structure)]
|
||||
(loop [ret {}]
|
||||
(if (.hasNext k-it)
|
||||
(let [k (.next k-it)
|
||||
v (.next v-it)]
|
||||
(recur (assoc ret k (next-fn v))))
|
||||
ret
|
||||
))))
|
||||
|
||||
#+cljs
|
||||
cljs.core/PersistentArrayMap
|
||||
#+cljs
|
||||
(map-vals-transform [structure next-fn]
|
||||
(map-vals-non-transient-transform structure {} next-fn)
|
||||
)
|
||||
|
||||
#+clj clojure.lang.PersistentTreeMap #+cljs cljs.core/PersistentTreeMap
|
||||
(map-vals-transform [structure next-fn]
|
||||
(map-vals-non-transient-transform structure (empty structure) next-fn)
|
||||
)
|
||||
|
||||
#+clj clojure.lang.PersistentHashMap #+cljs cljs.core/PersistentHashMap
|
||||
(map-vals-transform [structure next-fn]
|
||||
(persistent!
|
||||
(reduce-kv
|
||||
(fn [m k v]
|
||||
(assoc! m k (next-fn v)))
|
||||
(transient
|
||||
#+clj clojure.lang.PersistentHashMap/EMPTY #+cljs cljs.core.PersistentHashMap.EMPTY
|
||||
)
|
||||
structure
|
||||
)))
|
||||
|
||||
#+clj Object #+cljs default
|
||||
(map-vals-transform [structure next-fn]
|
||||
(reduce-kv
|
||||
(fn [m k v]
|
||||
(assoc m k (next-fn v)))
|
||||
(empty structure)
|
||||
structure))
|
||||
)
|
||||
|
||||
(defn srange-select [structure start end next-fn]
|
||||
(next-fn (-> structure vec (subvec start end))))
|
||||
|
||||
(def srange-transform i/srange-transform*)
|
||||
|
||||
(defn- matching-indices [aseq p]
|
||||
(keep-indexed (fn [i e] (if (p e) i)) aseq))
|
||||
|
||||
(defn matching-ranges [aseq p]
|
||||
(first
|
||||
(reduce
|
||||
(fn [[ranges curr-start curr-last :as curr] i]
|
||||
(cond
|
||||
(nil? curr-start)
|
||||
[ranges i i]
|
||||
|
||||
(= i (inc curr-last))
|
||||
[ranges curr-start i]
|
||||
|
||||
:else
|
||||
[(conj ranges [curr-start (inc curr-last)]) i i]
|
||||
))
|
||||
[[] nil nil]
|
||||
(concat (matching-indices aseq p) [-1])
|
||||
)))
|
||||
|
||||
(defn extract-basic-filter-fn [path]
|
||||
(cond (fn? path)
|
||||
path
|
||||
|
||||
(and (coll? path)
|
||||
(every? fn? path))
|
||||
(reduce
|
||||
(fn [combined afn]
|
||||
(fn [structure]
|
||||
(and (combined structure) (afn structure))
|
||||
))
|
||||
path
|
||||
)))
|
||||
|
||||
|
||||
|
||||
(defn if-select [params params-idx vals structure next-fn then-tester then-nav then-params else-nav]
|
||||
(let [test? (then-tester structure)
|
||||
sel (if test?
|
||||
then-nav
|
||||
else-nav)
|
||||
idx (if test? params-idx (+ params-idx then-params))]
|
||||
(i/exec-rich-select*
|
||||
sel
|
||||
params
|
||||
idx
|
||||
vals
|
||||
structure
|
||||
next-fn
|
||||
)))
|
||||
|
||||
|
||||
(defn if-transform [params params-idx vals structure next-fn then-tester then-nav then-params else-nav]
|
||||
(let [test? (then-tester structure)
|
||||
tran (if test?
|
||||
then-nav
|
||||
else-nav)
|
||||
idx (if test? params-idx (+ params-idx then-params))]
|
||||
(i/exec-rich-transform*
|
||||
tran
|
||||
params
|
||||
idx
|
||||
vals
|
||||
structure
|
||||
next-fn
|
||||
)))
|
||||
|
||||
(defn terminal* [params params-idx vals structure]
|
||||
(let [afn (aget ^objects params params-idx)]
|
||||
(if (identical? vals [])
|
||||
(afn structure)
|
||||
(apply afn (conj vals structure)))
|
||||
))
|
||||
|
||||
|
||||
(defprotocol AddExtremes
|
||||
(append-all [structure elements])
|
||||
(prepend-all [structure elements]))
|
||||
|
||||
(extend-protocol AddExtremes
|
||||
nil
|
||||
(append-all [_ elements]
|
||||
elements)
|
||||
(prepend-all [_ elements]
|
||||
elements)
|
||||
|
||||
#+clj clojure.lang.PersistentVector #+cljs cljs.core/PersistentVector
|
||||
(append-all [structure elements]
|
||||
(reduce conj structure elements))
|
||||
(prepend-all [structure elements]
|
||||
(let [ret (transient [])]
|
||||
(as-> ret <>
|
||||
(reduce conj! <> elements)
|
||||
(reduce conj! <> structure)
|
||||
(persistent! <>)
|
||||
)))
|
||||
|
||||
#+clj Object #+cljs default
|
||||
(append-all [structure elements]
|
||||
(concat structure elements))
|
||||
(prepend-all [structure elements]
|
||||
(concat elements structure))
|
||||
)
|
||||
|
||||
|
||||
(defprotocol UpdateExtremes
|
||||
(update-first [s afn])
|
||||
(update-last [s afn]))
|
||||
|
||||
(defprotocol GetExtremes
|
||||
(get-first [s])
|
||||
(get-last [s]))
|
||||
|
||||
(defprotocol FastEmpty
|
||||
(fast-empty? [s]))
|
||||
|
||||
(defnav PosNavigator [getter updater]
|
||||
(select* [this structure next-fn]
|
||||
(if-not (fast-empty? structure)
|
||||
(next-fn (getter structure))
|
||||
i/NONE))
|
||||
(transform* [this structure next-fn]
|
||||
(if (fast-empty? structure)
|
||||
structure
|
||||
(updater structure next-fn))))
|
||||
|
||||
(defn- update-first-list [l afn]
|
||||
(cons (afn (first l)) (rest l)))
|
||||
|
||||
(defn- update-last-list [l afn]
|
||||
(append (butlast l) (afn (last l))))
|
||||
|
||||
#+clj
|
||||
(defn vec-count [^clojure.lang.IPersistentVector v]
|
||||
(.length v))
|
||||
|
||||
#+cljs
|
||||
(defn vec-count [v]
|
||||
(count v))
|
||||
|
||||
#+clj
|
||||
(defn transient-vec-count [^clojure.lang.ITransientVector v]
|
||||
(.count v))
|
||||
|
||||
#+cljs
|
||||
(defn transient-vec-count [v]
|
||||
(count v))
|
||||
|
||||
(extend-protocol UpdateExtremes
|
||||
#+clj clojure.lang.PersistentVector #+cljs cljs.core/PersistentVector
|
||||
(update-first [v afn]
|
||||
(let [val (nth v 0)]
|
||||
(assoc v 0 (afn val))
|
||||
))
|
||||
(update-last [v afn]
|
||||
;; type-hinting vec-count to ^int caused weird errors with case
|
||||
(let [c (int (vec-count v))]
|
||||
(case c
|
||||
1 (let [[e] v] [(afn e)])
|
||||
2 (let [[e1 e2] v] [e1 (afn e2)])
|
||||
(let [i (dec c)]
|
||||
(assoc v i (afn (nth v i)))
|
||||
))))
|
||||
#+clj Object #+cljs default
|
||||
(update-first [l val]
|
||||
(update-first-list l val))
|
||||
(update-last [l val]
|
||||
(update-last-list l val)
|
||||
))
|
||||
|
||||
(extend-protocol GetExtremes
|
||||
#+clj clojure.lang.IPersistentVector #+cljs cljs.core/PersistentVector
|
||||
(get-first [v]
|
||||
(nth v 0))
|
||||
(get-last [v]
|
||||
(peek v))
|
||||
#+clj Object #+cljs default
|
||||
(get-first [s]
|
||||
(first s))
|
||||
(get-last [s]
|
||||
(last s)
|
||||
))
|
||||
|
||||
|
||||
(extend-protocol FastEmpty
|
||||
nil
|
||||
(fast-empty? [_] true)
|
||||
|
||||
#+clj clojure.lang.IPersistentVector #+cljs cljs.core/PersistentVector
|
||||
(fast-empty? [v]
|
||||
(= 0 (vec-count v)))
|
||||
#+clj clojure.lang.ITransientVector #+cljs cljs.core/TransientVector
|
||||
(fast-empty? [v]
|
||||
(= 0 (transient-vec-count v)))
|
||||
#+clj Object #+cljs default
|
||||
(fast-empty? [s]
|
||||
(empty? s))
|
||||
)
|
||||
|
||||
(defn walk-until [pred on-match-fn structure]
|
||||
(if (pred structure)
|
||||
(on-match-fn structure)
|
||||
(walk/walk (partial walk-until pred on-match-fn) identity structure)
|
||||
))
|
||||
|
||||
(defn codewalk-until [pred on-match-fn structure]
|
||||
(if (pred structure)
|
||||
(on-match-fn structure)
|
||||
(let [ret (walk/walk (partial codewalk-until pred on-match-fn) identity structure)]
|
||||
(if (and (i/fn-invocation? structure) (i/fn-invocation? ret))
|
||||
(with-meta ret (meta structure))
|
||||
ret
|
||||
))))
|
||||
|
||||
(def DISPENSE*
|
||||
(i/no-params-rich-compiled-path
|
||||
(reify i/RichNavigator
|
||||
(rich-select* [this params params-idx vals structure next-fn]
|
||||
(next-fn params params-idx [] structure))
|
||||
(rich-transform* [this params params-idx vals structure next-fn]
|
||||
(next-fn params params-idx [] structure)))))
|
||||
|
|
@ -1,6 +1,8 @@
|
|||
(ns com.rpl.specter.protocols)
|
||||
|
||||
(defprotocol Navigator
|
||||
"Do not use this protocol directly. All navigators must be created using
|
||||
com.rpl.specter.macros namespace."
|
||||
(select* [this structure next-fn]
|
||||
"An implementation of `select*` must call `next-fn` on each
|
||||
subvalue of `structure`. The result of `select*` is specified
|
||||
|
|
@ -17,4 +19,9 @@
|
|||
))
|
||||
|
||||
(defprotocol Collector
|
||||
"Do not use this protocol directly. All navigators must be created using
|
||||
com.rpl.specter.macros namespace."
|
||||
(collect-val [this structure]))
|
||||
|
||||
(defprotocol ImplicitNav
|
||||
(implicit-nav [obj]))
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
[com.rpl.specter.macros :only
|
||||
[defnav
|
||||
defpathedfn]])
|
||||
(:require [com.rpl.specter.impl :as i]
|
||||
(:require [com.rpl.specter.navs :as n]
|
||||
[com.rpl.specter :refer [subselect selected?]]))
|
||||
|
||||
(defnav
|
||||
|
|
@ -21,9 +21,17 @@
|
|||
(transform* [this structure next-fn]
|
||||
(assoc! structure key (next-fn (get structure key)))))
|
||||
|
||||
(def END!
|
||||
"Navigates to an empty (persistent) vector at the end of a transient vector."
|
||||
(i/comp-paths* (i/->TransientEndNavigator)))
|
||||
|
||||
|
||||
(defnav
|
||||
^{:doc "Navigates to an empty (persistent) vector at the end of a transient vector."}
|
||||
END!
|
||||
[]
|
||||
(select* [this structure next-fn]
|
||||
(next-fn []))
|
||||
(transform* [this structure next-fn]
|
||||
(let [res (next-fn [])]
|
||||
(reduce conj! structure res))))
|
||||
|
||||
(defn- t-get-first
|
||||
[tv]
|
||||
|
|
@ -31,7 +39,7 @@
|
|||
|
||||
(defn- t-get-last
|
||||
[tv]
|
||||
(nth tv (dec (i/transient-vec-count tv))))
|
||||
(nth tv (dec (n/transient-vec-count tv))))
|
||||
|
||||
(defn- t-update-first
|
||||
[tv next-fn]
|
||||
|
|
@ -39,16 +47,17 @@
|
|||
|
||||
(defn- t-update-last
|
||||
[tv next-fn]
|
||||
(let [i (dec (i/transient-vec-count tv))]
|
||||
(let [i (dec (n/transient-vec-count tv))]
|
||||
(assoc! tv i (next-fn (nth tv i)))))
|
||||
|
||||
|
||||
(def FIRST!
|
||||
"Navigates to the first element of a transient vector."
|
||||
(i/->PosNavigator t-get-first t-update-first))
|
||||
(n/PosNavigator t-get-first t-update-first))
|
||||
|
||||
(def LAST!
|
||||
"Navigates to the last element of a transient vector."
|
||||
(i/->PosNavigator t-get-last t-update-last))
|
||||
(n/PosNavigator t-get-last t-update-last))
|
||||
|
||||
#+clj
|
||||
(defn- select-keys-from-transient-map
|
||||
|
|
|
|||
Loading…
Reference in a new issue