re-implemented declarepath and providepath, added local-declarepath for making recursive/mutually-recursive navigators locally
This commit is contained in:
parent
4c570e5de4
commit
479cb7d023
3 changed files with 60 additions and 79 deletions
|
|
@ -156,6 +156,11 @@
|
||||||
|
|
||||||
(def late-path i/late-path)
|
(def late-path i/late-path)
|
||||||
|
|
||||||
|
|
||||||
|
;; Helpers for making recursive or mutually recursive navs
|
||||||
|
|
||||||
|
(def local-declarepath i/local-declarepath)
|
||||||
|
|
||||||
;; Built-in pathing and context operations
|
;; Built-in pathing and context operations
|
||||||
|
|
||||||
(defnav
|
(defnav
|
||||||
|
|
|
||||||
|
|
@ -139,6 +139,7 @@
|
||||||
|
|
||||||
(defn- coerce-object [this]
|
(defn- coerce-object [this]
|
||||||
(cond (satisfies? p/ImplicitNav this) (p/implicit-nav this)
|
(cond (satisfies? p/ImplicitNav this) (p/implicit-nav this)
|
||||||
|
(rich-nav? this) this
|
||||||
:else (throw-illegal "Not a navigator: " this)))
|
:else (throw-illegal "Not a navigator: " this)))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -192,7 +193,7 @@
|
||||||
(coerce-path o))
|
(coerce-path o))
|
||||||
#?(:clj java.util.List :cljs cljs.core/PersistentVector)
|
#?(:clj java.util.List :cljs cljs.core/PersistentVector)
|
||||||
(do-comp-paths [navigators]
|
(do-comp-paths [navigators]
|
||||||
(reduce combine-two-navs navigators)))
|
(reduce combine-two-navs (map coerce-path navigators))))
|
||||||
|
|
||||||
;; cell implementation idea taken from prismatic schema library
|
;; cell implementation idea taken from prismatic schema library
|
||||||
#?(:cljs
|
#?(:cljs
|
||||||
|
|
@ -441,7 +442,7 @@
|
||||||
(next-fn structure)
|
(next-fn structure)
|
||||||
structure))
|
structure))
|
||||||
|
|
||||||
(defn pred* [afn]
|
(defn ^:direct-nav pred* [afn]
|
||||||
(reify RichNavigator
|
(reify RichNavigator
|
||||||
(select* [this vals structure next-fn]
|
(select* [this vals structure next-fn]
|
||||||
(if (afn structure)
|
(if (afn structure)
|
||||||
|
|
@ -459,6 +460,34 @@
|
||||||
(transform* [this vals structure next-fn]
|
(transform* [this vals structure next-fn]
|
||||||
(next-fn vals structure))))
|
(next-fn vals structure))))
|
||||||
|
|
||||||
|
(defn ^:direct-nav collected?* [afn]
|
||||||
|
(reify RichNavigator
|
||||||
|
(select* [this vals structure next-fn]
|
||||||
|
(if (afn vals)
|
||||||
|
(next-fn vals structure)
|
||||||
|
NONE))
|
||||||
|
(transform* [this vals structure next-fn]
|
||||||
|
(if (afn vals)
|
||||||
|
(next-fn vals structure)
|
||||||
|
structure))))
|
||||||
|
|
||||||
|
(defn ^:direct-nav cell-nav [cell]
|
||||||
|
(reify RichNavigator
|
||||||
|
(select* [this vals structure next-fn]
|
||||||
|
(exec-select* (get-cell cell) vals structure next-fn))
|
||||||
|
(transform* [this vals structure next-fn]
|
||||||
|
(exec-transform* (get-cell cell) vals structure next-fn))))
|
||||||
|
|
||||||
|
(defn local-declarepath []
|
||||||
|
(let [cell (mutable-cell nil)]
|
||||||
|
(vary-meta (cell-nav cell) assoc ::cell cell)))
|
||||||
|
|
||||||
|
(defn providepath* [declared compiled-path]
|
||||||
|
(let [cell (-> declared meta ::cell)]
|
||||||
|
(set-cell! cell compiled-path)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(defn gensyms [amt]
|
(defn gensyms [amt]
|
||||||
(vec (repeatedly amt gensym)))
|
(vec (repeatedly amt gensym)))
|
||||||
|
|
||||||
|
|
@ -479,17 +508,6 @@
|
||||||
|
|
||||||
(mk-comp-navs)
|
(mk-comp-navs)
|
||||||
|
|
||||||
(defn collected?* [afn]
|
|
||||||
(reify RichNavigator
|
|
||||||
(select* [this vals structure next-fn]
|
|
||||||
(if (afn vals)
|
|
||||||
(next-fn vals structure)
|
|
||||||
NONE))
|
|
||||||
(transform* [this vals structure next-fn]
|
|
||||||
(if (afn vals)
|
|
||||||
(next-fn vals structure)
|
|
||||||
structure))))
|
|
||||||
|
|
||||||
(defn srange-transform* [structure start end next-fn]
|
(defn srange-transform* [structure start end next-fn]
|
||||||
(let [structurev (vec structure)
|
(let [structurev (vec structure)
|
||||||
newpart (next-fn (-> structurev (subvec start end)))
|
newpart (next-fn (-> structurev (subvec start end)))
|
||||||
|
|
|
||||||
|
|
@ -127,60 +127,18 @@
|
||||||
(i/no-params-rich-compiled-path nav#)
|
(i/no-params-rich-compiled-path nav#)
|
||||||
(i/->ParamsNeededPath nav# ~num-params))))))))
|
(i/->ParamsNeededPath nav# ~num-params))))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(defn ^:no-doc declared-name [name]
|
|
||||||
(vary-meta (symbol (str name "-declared"))
|
|
||||||
assoc :no-doc true))
|
|
||||||
|
|
||||||
;;TODO: redesign so can be recursive
|
|
||||||
(defmacro declarepath
|
|
||||||
([name]
|
|
||||||
`(declarepath ~name []))
|
|
||||||
([name 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-rich-compiled-path nav#)
|
|
||||||
(i/->ParamsNeededPath nav# ~num-params))))))))
|
|
||||||
|
|
||||||
|
|
||||||
(defmacro providepath [name 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)
|
|
||||||
(i/extract-rich-nav (i/coerce-compiled->rich-nav comped#)))))
|
|
||||||
|
|
||||||
|
|
||||||
(defmacro extend-protocolpath
|
(defmacro extend-protocolpath
|
||||||
"Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]."
|
"Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]."
|
||||||
[protpath & extensions]
|
[protpath & extensions]
|
||||||
`(i/extend-protocolpath* ~protpath ~(protpath-sym protpath) ~(vec extensions)))
|
`(i/extend-protocolpath* ~protpath ~(protpath-sym protpath) ~(vec extensions)))
|
||||||
|
|
||||||
|
|
||||||
|
(defmacro declarepath [name]
|
||||||
|
`(def ~name (i/local-declarepath)))
|
||||||
|
|
||||||
|
(defmacro providepath [name apath]
|
||||||
|
`(i/providepath* ~name (path ~apath)))
|
||||||
|
|
||||||
;; copied from tools.macro to avoid the dependency
|
;; copied from tools.macro to avoid the dependency
|
||||||
(defn ^:no-doc name-with-attributes
|
(defn ^:no-doc name-with-attributes
|
||||||
"To be used in macro definitions.
|
"To be used in macro definitions.
|
||||||
|
|
@ -261,23 +219,23 @@
|
||||||
`(com.rpl.specter.impl/->DynamicVal ~path (quote ~path)))))
|
`(com.rpl.specter.impl/->DynamicVal ~path (quote ~path)))))
|
||||||
|
|
||||||
|
|
||||||
(defn ^:no-doc ic-possible-params [path]
|
; (defn ^:no-doc ic-possible-params [path]
|
||||||
(do
|
; (do
|
||||||
(mapcat
|
; (mapcat
|
||||||
(fn [e]
|
; (fn [e]
|
||||||
(cond (or (set? e)
|
; (cond (or (set? e)
|
||||||
(map? e) ; in case inline maps are ever extended
|
; (map? e) ; in case inline maps are ever extended
|
||||||
(and (i/fn-invocation? e) (contains? #{'fn* 'fn} (first e))))
|
; (and (i/fn-invocation? e) (contains? #{'fn* 'fn} (first e))))
|
||||||
[e]
|
; [e]
|
||||||
|
;
|
||||||
(i/fn-invocation? e)
|
; (i/fn-invocation? e)
|
||||||
;; the [e] here handles nav constructors
|
; ;; the [e] here handles nav constructors
|
||||||
(concat [e] (rest e) (ic-possible-params e))
|
; (concat [e] (rest e) (ic-possible-params e))
|
||||||
|
;
|
||||||
(vector? e)
|
; (vector? e)
|
||||||
(ic-possible-params e)))
|
; (ic-possible-params e)))
|
||||||
|
;
|
||||||
path)))
|
; path)))
|
||||||
|
|
||||||
|
|
||||||
(defn cljs-macroexpand [env form]
|
(defn cljs-macroexpand [env form]
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue