Merge branch 'prot-redesign'
This commit is contained in:
commit
23a501f4ac
9 changed files with 1385 additions and 1342 deletions
|
|
@ -2,8 +2,7 @@
|
||||||
#+cljs (:require-macros
|
#+cljs (:require-macros
|
||||||
[com.rpl.specter.macros
|
[com.rpl.specter.macros
|
||||||
:refer
|
:refer
|
||||||
[pathed-collector
|
[fixed-pathed-collector
|
||||||
variable-pathed-nav
|
|
||||||
fixed-pathed-nav
|
fixed-pathed-nav
|
||||||
defcollector
|
defcollector
|
||||||
defnav
|
defnav
|
||||||
|
|
@ -14,10 +13,9 @@
|
||||||
[com.rpl.specter.util-macros :refer
|
[com.rpl.specter.util-macros :refer
|
||||||
[doseqres]]
|
[doseqres]]
|
||||||
)
|
)
|
||||||
(:use [com.rpl.specter.protocols :only [Navigator]]
|
(:use [com.rpl.specter.protocols :only [ImplicitNav]]
|
||||||
#+clj [com.rpl.specter.macros :only
|
#+clj [com.rpl.specter.macros :only
|
||||||
[pathed-collector
|
[fixed-pathed-collector
|
||||||
variable-pathed-nav
|
|
||||||
fixed-pathed-nav
|
fixed-pathed-nav
|
||||||
defcollector
|
defcollector
|
||||||
defnav
|
defnav
|
||||||
|
|
@ -27,6 +25,7 @@
|
||||||
#+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]
|
||||||
[clojure.set :as set])
|
[clojure.set :as set])
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
@ -172,19 +171,14 @@
|
||||||
|
|
||||||
(defn params-reset [params-path]
|
(defn params-reset [params-path]
|
||||||
;; TODO: error if not paramsneededpath
|
;; TODO: error if not paramsneededpath
|
||||||
(let [s (i/params-needed-selector params-path)
|
(let [nav (i/params-needed-nav params-path)
|
||||||
t (i/params-needed-transformer params-path)
|
|
||||||
needed (i/num-needed-params params-path)]
|
needed (i/num-needed-params params-path)]
|
||||||
(i/->ParamsNeededPath
|
(richnav 0
|
||||||
(i/->TransformFunctions
|
(select* [this params params-idx vals structure next-fn]
|
||||||
i/RichPathExecutor
|
(i/exec-rich-select* nav params (- params-idx needed) vals structure next-fn))
|
||||||
(fn [params params-idx vals structure next-fn]
|
(transform* [this params params-idx vals structure next-fn]
|
||||||
(s params (- params-idx needed) vals structure next-fn)
|
(i/exec-rich-transform* nav 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)))
|
|
||||||
|
|
||||||
;; Built-in pathing and context operations
|
;; Built-in pathing and context operations
|
||||||
|
|
||||||
|
|
@ -199,6 +193,7 @@
|
||||||
structure
|
structure
|
||||||
))
|
))
|
||||||
|
|
||||||
|
|
||||||
(defnav
|
(defnav
|
||||||
^{:doc "Stays navigated at the current point. Essentially a no-op navigator."}
|
^{:doc "Stays navigated at the current point. Essentially a no-op navigator."}
|
||||||
STAY
|
STAY
|
||||||
|
|
@ -208,7 +203,6 @@
|
||||||
(transform* [this structure next-fn]
|
(transform* [this structure next-fn]
|
||||||
(next-fn structure)))
|
(next-fn structure)))
|
||||||
|
|
||||||
|
|
||||||
(def
|
(def
|
||||||
^{:doc "For usage with `multi-transform`, defines an endpoint in the navigation
|
^{:doc "For usage with `multi-transform`, defines an endpoint in the navigation
|
||||||
that will have the parameterized transform function run. The transform
|
that will have the parameterized transform function run. The transform
|
||||||
|
|
@ -216,10 +210,10 @@
|
||||||
given as the first arguments"}
|
given as the first arguments"}
|
||||||
terminal
|
terminal
|
||||||
(richnav 1
|
(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"))
|
(i/throw-illegal "'terminal' should only be used in multi-transform"))
|
||||||
(transform* [params params-idx vals structure next-fn]
|
(transform* [this params params-idx vals structure next-fn]
|
||||||
(i/terminal* params params-idx vals structure)
|
(n/terminal* params params-idx vals structure)
|
||||||
)))
|
)))
|
||||||
|
|
||||||
(defnavconstructor terminal-val
|
(defnavconstructor terminal-val
|
||||||
|
|
@ -229,11 +223,15 @@
|
||||||
[v]
|
[v]
|
||||||
(p (i/fast-constantly v)))
|
(p (i/fast-constantly v)))
|
||||||
|
|
||||||
(def
|
(defnav
|
||||||
^{:doc "Navigate to every element of the collection. For maps navigates to
|
^{:doc "Navigate to every element of the collection. For maps navigates to
|
||||||
a vector of `[key value]`."}
|
a vector of `[key value]`."}
|
||||||
ALL
|
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
|
(defnav
|
||||||
^{:doc "Navigate to each value of the map. This is more efficient than
|
^{:doc "Navigate to each value of the map. This is more efficient than
|
||||||
|
|
@ -245,23 +243,25 @@
|
||||||
(next-fn v)
|
(next-fn v)
|
||||||
))
|
))
|
||||||
(transform* [this structure next-fn]
|
(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
|
(def
|
||||||
^{:doc "Navigate to the last element of the collection. If the collection is
|
^{:doc "Navigate to the last element of the collection. If the collection is
|
||||||
empty navigation is stopped at this point."}
|
empty navigation is stopped at this point."}
|
||||||
LAST
|
LAST
|
||||||
(comp-paths (i/->PosNavigator i/get-last i/update-last)))
|
(n/PosNavigator n/get-last n/update-last))
|
||||||
|
|
||||||
(def
|
(def
|
||||||
^{:doc "Navigate to the first element of the collection. If the collection is
|
^{:doc "Navigate to the first element of the collection. If the collection is
|
||||||
empty navigation is stopped at this point."}
|
empty navigation is stopped at this point."}
|
||||||
FIRST
|
FIRST
|
||||||
(comp-paths (i/->PosNavigator i/get-first i/update-first)))
|
(n/PosNavigator n/get-first n/update-first))
|
||||||
|
|
||||||
(defnav
|
(defnav
|
||||||
^{:doc "Uses start-fn and end-fn to determine the bounds of the subsequence
|
^{:doc "Uses start-fn and end-fn to determine the bounds of the subsequence
|
||||||
|
|
@ -269,9 +269,9 @@
|
||||||
srange-dynamic
|
srange-dynamic
|
||||||
[start-fn end-fn]
|
[start-fn end-fn]
|
||||||
(select* [this structure next-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]
|
(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
|
(defnav
|
||||||
|
|
@ -280,9 +280,9 @@
|
||||||
srange
|
srange
|
||||||
[start end]
|
[start end]
|
||||||
(select* [this structure next-fn]
|
(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]
|
(transform* [this structure next-fn]
|
||||||
(i/srange-transform structure start end next-fn)
|
(n/srange-transform structure start end next-fn)
|
||||||
))
|
))
|
||||||
|
|
||||||
(defnav
|
(defnav
|
||||||
|
|
@ -290,15 +290,15 @@
|
||||||
continuous-subseqs
|
continuous-subseqs
|
||||||
[pred]
|
[pred]
|
||||||
(select* [this structure next-fn]
|
(select* [this structure next-fn]
|
||||||
(doseqres NONE [[s e] (i/matching-ranges structure pred)]
|
(doseqres NONE [[s e] (n/matching-ranges structure pred)]
|
||||||
(i/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]]
|
||||||
(i/srange-transform structure s e next-fn))
|
(n/srange-transform structure s e next-fn))
|
||||||
structure
|
structure
|
||||||
(reverse (i/matching-ranges structure pred))
|
(reverse (n/matching-ranges structure pred))
|
||||||
)))
|
)))
|
||||||
|
|
||||||
(defnav
|
(defnav
|
||||||
|
|
@ -309,7 +309,7 @@
|
||||||
(next-fn []))
|
(next-fn []))
|
||||||
(transform* [this structure next-fn]
|
(transform* [this structure next-fn]
|
||||||
(let [to-prepend (next-fn [])]
|
(let [to-prepend (next-fn [])]
|
||||||
(i/prepend-all structure to-prepend)
|
(n/prepend-all structure to-prepend)
|
||||||
)))
|
)))
|
||||||
|
|
||||||
(defnav
|
(defnav
|
||||||
|
|
@ -320,7 +320,7 @@
|
||||||
(next-fn []))
|
(next-fn []))
|
||||||
(transform* [this structure next-fn]
|
(transform* [this structure next-fn]
|
||||||
(let [to-append (next-fn [])]
|
(let [to-append (next-fn [])]
|
||||||
(i/append-all structure to-append)
|
(n/append-all structure to-append)
|
||||||
)))
|
)))
|
||||||
|
|
||||||
(defnav
|
(defnav
|
||||||
|
|
@ -360,18 +360,18 @@
|
||||||
walker
|
walker
|
||||||
[afn]
|
[afn]
|
||||||
(select* [this structure next-fn]
|
(select* [this structure next-fn]
|
||||||
(i/walk-select afn next-fn structure))
|
(n/walk-select afn next-fn structure))
|
||||||
(transform* [this structure next-fn]
|
(transform* [this structure next-fn]
|
||||||
(i/walk-until afn next-fn structure)))
|
(n/walk-until afn next-fn structure)))
|
||||||
|
|
||||||
(defnav
|
(defnav
|
||||||
^{:doc "Like `walker` but maintains metadata of any forms traversed."}
|
^{:doc "Like `walker` but maintains metadata of any forms traversed."}
|
||||||
codewalker
|
codewalker
|
||||||
[afn]
|
[afn]
|
||||||
(select* [this structure next-fn]
|
(select* [this structure next-fn]
|
||||||
(i/walk-select afn next-fn structure))
|
(n/walk-select afn next-fn structure))
|
||||||
(transform* [this structure next-fn]
|
(transform* [this structure next-fn]
|
||||||
(i/codewalk-until afn next-fn structure)))
|
(n/codewalk-until afn next-fn structure)))
|
||||||
|
|
||||||
(defpathedfn subselect
|
(defpathedfn subselect
|
||||||
"Navigates to a sequence that contains the results of (select ...),
|
"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
|
will be parameterized in the order of which the parameterized navigators
|
||||||
were declared."
|
were declared."
|
||||||
[& path]
|
[& path]
|
||||||
(if-let [afn (i/extract-basic-filter-fn path)]
|
(if-let [afn (n/extract-basic-filter-fn path)]
|
||||||
afn
|
afn
|
||||||
(fixed-pathed-nav [late path]
|
(fixed-pathed-nav [late path]
|
||||||
(select* [this structure next-fn]
|
(select* [this structure next-fn]
|
||||||
(i/filter-select
|
(i/filter-select
|
||||||
#(i/selected?* late %)
|
#(n/selected?* late %)
|
||||||
structure
|
structure
|
||||||
next-fn))
|
next-fn))
|
||||||
(transform* [this structure next-fn]
|
(transform* [this structure next-fn]
|
||||||
(i/filter-transform
|
(i/filter-transform
|
||||||
#(i/selected?* late %)
|
#(n/selected?* late %)
|
||||||
structure
|
structure
|
||||||
next-fn)))))
|
next-fn)))))
|
||||||
|
|
||||||
(defpathedfn not-selected? [& path]
|
(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)))
|
(fn [s] (not (afn s)))
|
||||||
(fixed-pathed-nav [late path]
|
(fixed-pathed-nav [late path]
|
||||||
(select* [this structure next-fn]
|
(select* [this structure next-fn]
|
||||||
(i/filter-select
|
(i/filter-select
|
||||||
#(i/not-selected?* late %)
|
#(n/not-selected?* late %)
|
||||||
structure
|
structure
|
||||||
next-fn))
|
next-fn))
|
||||||
(transform* [this structure next-fn]
|
(transform* [this structure next-fn]
|
||||||
(i/filter-transform
|
(i/filter-transform
|
||||||
#(i/not-selected?* late %)
|
#(n/not-selected?* late %)
|
||||||
structure
|
structure
|
||||||
next-fn)))))
|
next-fn)))))
|
||||||
|
|
||||||
|
|
@ -514,28 +514,6 @@
|
||||||
(transform* [this structure next-fn]
|
(transform* [this structure next-fn]
|
||||||
(next-fn (compiled-transform late update-fn structure)))))
|
(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
|
(def
|
||||||
^{:doc "Keeps the element only if it matches the supplied predicate. This is the
|
^{: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."}
|
late-bound parameterized version of using a function directly in a path."}
|
||||||
|
|
@ -543,6 +521,23 @@
|
||||||
i/pred*
|
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
|
(defnav
|
||||||
^{:doc "Navigates to the provided val if the structure is nil. Otherwise it stays
|
^{:doc "Navigates to the provided val if the structure is nil. Otherwise it stays
|
||||||
navigated at the structure."}
|
navigated at the structure."}
|
||||||
|
|
@ -585,7 +580,7 @@
|
||||||
current value to the collected vals."}
|
current value to the collected vals."}
|
||||||
collect
|
collect
|
||||||
[& path]
|
[& path]
|
||||||
(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)
|
||||||
)))
|
)))
|
||||||
|
|
@ -595,7 +590,7 @@
|
||||||
current value to the collected vals."}
|
current value to the collected vals."}
|
||||||
collect-one
|
collect-one
|
||||||
[& path]
|
[& path]
|
||||||
(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)
|
||||||
)))
|
)))
|
||||||
|
|
@ -615,7 +610,7 @@
|
||||||
|
|
||||||
(def
|
(def
|
||||||
^{:doc "Drops all collected values for subsequent navigation."}
|
^{:doc "Drops all collected values for subsequent navigation."}
|
||||||
DISPENSE i/DISPENSE*)
|
DISPENSE n/DISPENSE*)
|
||||||
|
|
||||||
|
|
||||||
(defpathedfn if-path
|
(defpathedfn if-path
|
||||||
|
|
@ -623,66 +618,66 @@
|
||||||
([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* then-path)
|
(let [then-comp (i/comp-paths-internalized then-path)
|
||||||
else-comp (i/comp-paths* 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-s then-t] (i/extract-rich-tfns then-comp)
|
then-nav (i/extract-rich-nav then-comp)
|
||||||
[else-s else-t] (i/extract-rich-tfns else-comp)]
|
else-nav (i/extract-rich-nav else-comp)]
|
||||||
(if-let [afn (i/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* [params params-idx vals structure next-fn]
|
(select* [this params params-idx vals structure next-fn]
|
||||||
(i/if-select
|
(n/if-select
|
||||||
params
|
params
|
||||||
params-idx
|
params-idx
|
||||||
vals
|
vals
|
||||||
structure
|
structure
|
||||||
next-fn
|
next-fn
|
||||||
afn
|
afn
|
||||||
then-s
|
then-nav
|
||||||
then-needed
|
then-needed
|
||||||
else-s
|
else-nav
|
||||||
))
|
))
|
||||||
(transform* [params params-idx vals structure next-fn]
|
(transform* [this params params-idx vals structure next-fn]
|
||||||
(i/if-transform
|
(n/if-transform
|
||||||
params
|
params
|
||||||
params-idx
|
params-idx
|
||||||
vals
|
vals
|
||||||
structure
|
structure
|
||||||
next-fn
|
next-fn
|
||||||
afn
|
afn
|
||||||
then-t
|
then-nav
|
||||||
then-needed
|
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)]
|
cond-needed (i/num-needed-params cond-comp)]
|
||||||
(richnav (+ then-needed else-needed cond-needed)
|
(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)]
|
(let [late-cond (i/parameterize-path cond-comp params params-idx)]
|
||||||
(i/if-select
|
(n/if-select
|
||||||
params
|
params
|
||||||
(+ params-idx cond-needed)
|
(+ params-idx cond-needed)
|
||||||
vals
|
vals
|
||||||
structure
|
structure
|
||||||
next-fn
|
next-fn
|
||||||
#(i/selected?* late-cond %)
|
#(n/selected?* late-cond %)
|
||||||
then-s
|
then-nav
|
||||||
then-needed
|
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)]
|
(let [late-cond (i/parameterize-path cond-comp params params-idx)]
|
||||||
(i/if-transform
|
(n/if-transform
|
||||||
params
|
params
|
||||||
(+ params-idx cond-needed)
|
(+ params-idx cond-needed)
|
||||||
vals
|
vals
|
||||||
structure
|
structure
|
||||||
next-fn
|
next-fn
|
||||||
#(i/selected?* late-cond %)
|
#(n/selected?* late-cond %)
|
||||||
then-t
|
then-nav
|
||||||
then-needed
|
then-needed
|
||||||
else-t
|
else-nav
|
||||||
))))))))
|
))))))))
|
||||||
|
|
||||||
(defpathedfn cond-path
|
(defpathedfn cond-path
|
||||||
|
|
@ -710,23 +705,23 @@
|
||||||
([] STAY)
|
([] STAY)
|
||||||
([path] (i/comp-paths* path))
|
([path] (i/comp-paths* path))
|
||||||
([path1 path2]
|
([path1 path2]
|
||||||
(let [comp1 (i/comp-paths* path1)
|
(let [comp1 (i/comp-paths-internalized path1)
|
||||||
comp2 (i/comp-paths* path2)
|
comp2 (i/comp-paths-internalized path2)
|
||||||
comp1-needed (i/num-needed-params comp1)
|
comp1-needed (i/num-needed-params comp1)
|
||||||
[s1 t1] (i/extract-rich-tfns comp1)
|
nav1 (i/extract-rich-nav comp1)
|
||||||
[s2 t2] (i/extract-rich-tfns comp2)
|
nav2 (i/extract-rich-nav comp2)
|
||||||
]
|
]
|
||||||
(richnav (+ comp1-needed (i/num-needed-params comp2))
|
(richnav (+ comp1-needed (i/num-needed-params comp2))
|
||||||
(select* [params params-idx vals structure next-fn]
|
(select* [this params params-idx vals structure next-fn]
|
||||||
(let [res1 (s1 params params-idx vals structure next-fn)
|
(let [res1 (i/exec-rich-select* nav1 params params-idx vals structure next-fn)
|
||||||
res2 (s2 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* [params params-idx vals structure next-fn]
|
(transform* [this params params-idx vals structure next-fn]
|
||||||
(let [s1 (t1 params params-idx vals structure next-fn)]
|
(let [s1 (i/exec-rich-transform* nav1 params params-idx vals structure next-fn)]
|
||||||
(t2 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)
|
||||||
|
|
|
||||||
|
|
@ -13,7 +13,7 @@
|
||||||
~@setters
|
~@setters
|
||||||
(com.rpl.specter.impl/bind-params* this# ~a 0)
|
(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
|
~fn-type
|
||||||
~@impls
|
~@impls
|
||||||
~var-arity-impl
|
~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
|
(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]
|
(: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]
|
(defn ^:no-doc gensyms [amt]
|
||||||
|
|
@ -8,122 +11,12 @@
|
||||||
|
|
||||||
(defn ^:no-doc determine-params-impls [[name1 & impl1] [name2 & impl2]]
|
(defn ^:no-doc determine-params-impls [[name1 & impl1] [name2 & impl2]]
|
||||||
(if-not (= #{name1 name2} #{'select* 'transform*})
|
(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))
|
name1 " and " name2))
|
||||||
(if (= name1 'select*)
|
(if (= name1 'select*)
|
||||||
[impl1 impl2]
|
[impl1 impl2]
|
||||||
[impl2 impl1]))
|
[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
|
(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,
|
||||||
and the parameters array index. `next-fn` expects to receive the params array,
|
and the parameters array index. `next-fn` expects to receive the params array,
|
||||||
|
|
@ -134,25 +27,224 @@
|
||||||
[num-params impl1 impl2]
|
[num-params impl1 impl2]
|
||||||
(let [[[s-params & s-body] [t-params & t-body]] (determine-params-impls impl1 impl2)
|
(let [[[s-params & s-body] [t-params & t-body]] (determine-params-impls impl1 impl2)
|
||||||
s-next-fn-sym (last s-params)
|
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-next-fn-sym (last t-params)
|
||||||
t-pidx-sym (second t-params)
|
t-pidx-sym (nth t-params 2)
|
||||||
]
|
]
|
||||||
`(let [num-params# ~num-params
|
`(let [num-params# ~num-params
|
||||||
tfns# (i/->TransformFunctions
|
nav# (reify RichNavigator
|
||||||
i/RichPathExecutor
|
(~'rich-select* ~s-params
|
||||||
(fn ~s-params
|
|
||||||
(let [~s-next-fn-sym (i/mk-jump-next-fn ~s-next-fn-sym ~s-pidx-sym num-params#)]
|
(let [~s-next-fn-sym (i/mk-jump-next-fn ~s-next-fn-sym ~s-pidx-sym num-params#)]
|
||||||
~@s-body))
|
~@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#)]
|
(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-compiled-path tfns#)
|
(i/no-params-rich-compiled-path nav#)
|
||||||
(i/->ParamsNeededPath tfns# num-params#)
|
(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]
|
(defmacro paramsfn [params [structure-sym] & impl]
|
||||||
`(nav ~params
|
`(nav ~params
|
||||||
(~'select* [this# structure# next-fn#]
|
(~'select* [this# structure# next-fn#]
|
||||||
|
|
@ -164,81 +256,17 @@
|
||||||
(i/filter-transform afn# structure# next-fn#)
|
(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]
|
(defmacro defnav [name & body]
|
||||||
`(def ~name (nav ~@body)))
|
`(def ~name (nav ~@body)))
|
||||||
|
|
||||||
(defmacro defcollector [name & 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]
|
(defn- protpath-sym [name]
|
||||||
(-> name (str "-prot") symbol))
|
(-> name (str "-prot") symbol))
|
||||||
|
|
||||||
|
|
||||||
(defmacro defprotocolpath
|
(defmacro defprotocolpath
|
||||||
"Defines a navigator that chooses the path to take based on the type
|
"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
|
of the value at the current point. May be specified with parameters to
|
||||||
|
|
@ -255,7 +283,7 @@
|
||||||
SingleAccount :funds
|
SingleAccount :funds
|
||||||
FamilyAccount [ALL FundsPath]
|
FamilyAccount [ALL FundsPath]
|
||||||
)
|
)
|
||||||
"
|
"
|
||||||
([name]
|
([name]
|
||||||
`(defprotocolpath ~name []))
|
`(defprotocolpath ~name []))
|
||||||
([name params]
|
([name params]
|
||||||
|
|
@ -268,92 +296,67 @@
|
||||||
]
|
]
|
||||||
`(do
|
`(do
|
||||||
(defprotocol ~prot-name (~m [structure#]))
|
(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
|
(def ~name
|
||||||
(if (= ~num-params 0)
|
(if (= ~num-params 0)
|
||||||
(i/no-params-compiled-path
|
(i/no-params-rich-compiled-path nav#)
|
||||||
(i/->TransformFunctions
|
(i/->ParamsNeededPath nav# ~num-params)
|
||||||
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
|
|
||||||
)
|
|
||||||
))))))
|
|
||||||
|
|
||||||
|
|
||||||
(defn ^:no-doc declared-name [name]
|
(defn ^:no-doc declared-name [name]
|
||||||
(vary-meta (symbol (str name "-declared"))
|
(vary-meta (symbol (str name "-declared"))
|
||||||
assoc :no-doc true))
|
assoc :no-doc true))
|
||||||
|
|
||||||
|
|
||||||
(defmacro declarepath
|
(defmacro declarepath
|
||||||
([name]
|
([name]
|
||||||
`(declarepath ~name []))
|
`(declarepath ~name []))
|
||||||
([name params]
|
([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)
|
declared (declared-name name)
|
||||||
rargs [(gensym "params") (gensym "pidx") (gensym "vals")
|
rargs [(gensym "params") (gensym "pidx") (gensym "vals")
|
||||||
(gensym "structure") (gensym "next-fn")]]
|
(gensym "structure") (gensym "next-fn")]]
|
||||||
`(do
|
`(do
|
||||||
(declare ~declared)
|
(declare ~declared)
|
||||||
(def ~name
|
(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)
|
(if (= ~num-params 0)
|
||||||
(i/no-params-compiled-path
|
(i/no-params-rich-compiled-path nav#)
|
||||||
(i/->TransformFunctions
|
(i/->ParamsNeededPath nav# ~num-params)
|
||||||
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
|
|
||||||
)
|
|
||||||
))))))
|
|
||||||
|
|
||||||
(defmacro providepath [name apath]
|
(defmacro providepath [name apath]
|
||||||
`(let [comped# (i/comp-paths* ~apath)
|
`(let [comped# (i/comp-paths-internalized ~apath)
|
||||||
expected-params# (i/num-needed-params ~name)
|
expected-params# (i/num-needed-params ~name)
|
||||||
needed-params# (i/num-needed-params comped#)]
|
needed-params# (i/num-needed-params comped#)]
|
||||||
(if-not (= needed-params# expected-params#)
|
(if-not (= needed-params# expected-params#)
|
||||||
(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)
|
||||||
(update-in comped#
|
(i/extract-rich-nav (i/coerce-compiled->rich-nav comped#))
|
||||||
[:transform-fns]
|
|
||||||
i/coerce-tfns-rich)
|
|
||||||
)))
|
)))
|
||||||
|
|
||||||
(defmacro extend-protocolpath
|
(defmacro extend-protocolpath
|
||||||
|
|
@ -422,7 +425,8 @@
|
||||||
(vary-meta
|
(vary-meta
|
||||||
(let [~csym (i/layered-wrapper ~anav)]
|
(let [~csym (i/layered-wrapper ~anav)]
|
||||||
(fn ~@checked-code))
|
(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)
|
(ns com.rpl.specter.protocols)
|
||||||
|
|
||||||
(defprotocol Navigator
|
(defprotocol Navigator
|
||||||
|
"Do not use this protocol directly. All navigators must be created using
|
||||||
|
com.rpl.specter.macros namespace."
|
||||||
(select* [this structure next-fn]
|
(select* [this structure next-fn]
|
||||||
"An implementation of `select*` must call `next-fn` on each
|
"An implementation of `select*` must call `next-fn` on each
|
||||||
subvalue of `structure`. The result of `select*` is specified
|
subvalue of `structure`. The result of `select*` is specified
|
||||||
|
|
@ -17,4 +19,9 @@
|
||||||
))
|
))
|
||||||
|
|
||||||
(defprotocol Collector
|
(defprotocol Collector
|
||||||
|
"Do not use this protocol directly. All navigators must be created using
|
||||||
|
com.rpl.specter.macros namespace."
|
||||||
(collect-val [this structure]))
|
(collect-val [this structure]))
|
||||||
|
|
||||||
|
(defprotocol ImplicitNav
|
||||||
|
(implicit-nav [obj]))
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@
|
||||||
[com.rpl.specter.macros :only
|
[com.rpl.specter.macros :only
|
||||||
[defnav
|
[defnav
|
||||||
defpathedfn]])
|
defpathedfn]])
|
||||||
(:require [com.rpl.specter.impl :as i]
|
(:require [com.rpl.specter.navs :as n]
|
||||||
[com.rpl.specter :refer [subselect selected?]]))
|
[com.rpl.specter :refer [subselect selected?]]))
|
||||||
|
|
||||||
(defnav
|
(defnav
|
||||||
|
|
@ -21,9 +21,17 @@
|
||||||
(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)))))
|
||||||
|
|
||||||
(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
|
(defn- t-get-first
|
||||||
[tv]
|
[tv]
|
||||||
|
|
@ -31,7 +39,7 @@
|
||||||
|
|
||||||
(defn- t-get-last
|
(defn- t-get-last
|
||||||
[tv]
|
[tv]
|
||||||
(nth tv (dec (i/transient-vec-count tv))))
|
(nth tv (dec (n/transient-vec-count tv))))
|
||||||
|
|
||||||
(defn- t-update-first
|
(defn- t-update-first
|
||||||
[tv next-fn]
|
[tv next-fn]
|
||||||
|
|
@ -39,16 +47,17 @@
|
||||||
|
|
||||||
(defn- t-update-last
|
(defn- t-update-last
|
||||||
[tv next-fn]
|
[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)))))
|
(assoc! tv i (next-fn (nth tv i)))))
|
||||||
|
|
||||||
|
|
||||||
(def FIRST!
|
(def FIRST!
|
||||||
"Navigates to the first element of a transient vector."
|
"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!
|
(def LAST!
|
||||||
"Navigates to the last element of a transient vector."
|
"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
|
#+clj
|
||||||
(defn- select-keys-from-transient-map
|
(defn- select-keys-from-transient-map
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue