all higher order selectors now converted to be parameterizable, helpers for making higher order selectors with fixed paths or variable paths complete

This commit is contained in:
Nathan Marz 2015-09-10 20:47:46 -04:00
parent 3187cdad34
commit a983e6e028
2 changed files with 115 additions and 123 deletions

View file

@ -128,14 +128,28 @@
`(def ~name (paramspath ~@body)))
(defmacro params-paramspath [bindings & impls]
(i/params-paramspath* (partition 2 bindings) impls))
(let [bindings (partition 2 bindings)
paths (mapv second bindings)
names (mapv first bindings)
latefns-sym (gensym "latefns")
latefn-syms (vec (i/gensyms (count paths)))]
(i/params-paramspath*
paths
latefns-sym
[latefn-syms latefns-sym]
(mapcat (fn [n l] [n `(~l ~i/PARAMS-SYM ~i/PARAMS-IDX-SYM)]) names latefn-syms)
impls)))
;;TODO: needs to parameterize if necessary according to its path
;; same for selected?, not-selected?, transformed, collect, collect-one,
;; cond-path, multi-path
;;TODO: figure out how to express srange in terms of srange-dynamic
;; - will need selector and transformer to call into shared functions
;;TODO: get rid of KeyPath
(defmacro params-varparamspath [[latepaths-seq-sym paths-seq] & impls]
(let [latefns-sym (gensym "latefns")]
(i/params-paramspath*
paths-seq
latefns-sym
[]
[latepaths-seq-sym `(map (fn [l#] (l# ~i/PARAMS-SYM ~i/PARAMS-IDX-SYM))
~latefns-sym)]
impls
)))
;; Built-in pathing and context operations
@ -190,26 +204,41 @@
"Filters the current value based on whether a selector finds anything.
e.g. (selected? :vals ALL even?) keeps the current element only if an
even number exists for the :vals key"
[& selectors]
(let [s (i/comp-paths* selectors)]
(fn [structure]
(->> structure
(select s)
empty?
not))))
[& path]
(params-paramspath [late path]
(select* [this structure next-fn]
(i/filter-select
#(i/selected?* late %)
structure
next-fn))
(transform* [this structure next-fn]
(i/filter-transform
#(i/selected?* late %)
structure
next-fn))))
(defn not-selected? [& path]
(complement (selected? (i/comp-paths* path))))
(params-paramspath [late path]
(select* [this structure next-fn]
(i/filter-select
#(i/not-selected?* late %)
structure
next-fn))
(transform* [this structure next-fn]
(i/filter-transform
#(i/not-selected?* late %)
structure
next-fn))))
(defn transformed
"Navigates to a view of the current value by transforming it with the
specified selector and update-fn."
[selector update-fn]
(let [compiled (i/comp-paths* selector)]
(view
(fn [elem]
(compiled-transform compiled update-fn elem)
))))
[path update-fn]
(params-paramspath [late path]
(select* [this structure next-fn]
(next-fn (compiled-transform late update-fn structure)))
(transform* [this structure next-fn]
(next-fn (compiled-transform late update-fn structure)))))
(extend-type #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword)
StructurePath
@ -249,6 +278,8 @@
[val]
(i/->PutValCollector val))
;;TODO: test nothing matches case
(defn cond-path
"Takes in alternating cond-path selector cond-path selector...
Tests the structure if selecting with cond-path returns anything.
@ -256,21 +287,39 @@
Otherwise, it tries the next cond-path. If nothing matches, then the structure
is not selected."
[& conds]
(->> conds
(partition 2)
(map (fn [[c p]] [(i/comp-paths* c) (i/comp-paths* p)]))
doall
i/->ConditionalPath
))
(params-varparamspath [compiled-paths conds]
(select* [this structure next-fn]
(if-let [selector (i/retrieve-cond-selector compiled-paths structure)]
(->> (compiled-select selector structure)
(mapcat next-fn)
doall)))
(transform* [this structure next-fn]
(if-let [selector (i/retrieve-cond-selector compiled-paths structure)]
(compiled-transform selector next-fn structure)
structure
))))
(defn if-path
"Like cond-path, but with if semantics."
([cond-fn if-path] (cond-path cond-fn if-path))
([cond-fn if-path else-path]
(cond-path cond-fn if-path nil else-path)))
([cond-p if-path] (cond-path cond-p if-path))
([cond-p if-path else-path]
(cond-path cond-p if-path nil else-path)))
(defn multi-path
"A path that branches on multiple paths. For updates,
applies updates to the paths in order."
[& paths]
(i/->MultiPath (->> paths (map i/comp-paths*) doall)))
(params-varparamspath [compiled-paths paths]
(select* [this structure next-fn]
(->> compiled-paths
(mapcat #(compiled-select % structure))
(mapcat next-fn)
doall
))
(transform* [this structure next-fn]
(reduce
(fn [structure selector]
(compiled-transform selector next-fn structure))
structure
compiled-paths
))))

View file

@ -9,6 +9,9 @@
[clojure.string :as s])
)
(defn gensyms [amt]
(vec (repeatedly amt gensym)))
(defprotocol PathComposer
(comp-paths* [paths]))
@ -360,58 +363,29 @@
0
(:num-needed-params path)))
(defn params-paramspath* [bindings impls]
(let [bindings (->> bindings
(map (fn [[late-sym path]]
{:late-sym late-sym
:path path
:path-sym (gensym "path")
:offset-sym (gensym "offset")
:latebind-sym (gensym "latebind")}))
(reduce
(fn [bindings binding]
(if (empty? bindings)
[(assoc binding :offset 0)]
(let [last-binding (last bindings)]
(conj bindings
(assoc binding
:offset
`(+ ~(:offset-sym last-binding)
(num-needed-params ~(:path-sym last-binding)))
))
)))
[]))
binding-decls (mapcat (fn [b] [(:path-sym b) `(comp-paths* ~(:path b))]) bindings)
offset-decls (mapcat (fn [b] [(:offset-sym b) (:offset b)]) bindings)
needed-params (map (fn [b] `(num-needed-params ~(:path-sym b))) bindings)
latefn-decls (mapcat
(fn [b]
[(:latebind-sym b)
`(if (instance? CompiledPath ~(:path-sym b))
(fn [params# params-idx#] ~(:path-sym b))
(fn [params# params-idx#]
(bind-params ~(:path-sym b)
params#
(+ params-idx#
~(:offset-sym b)))
))
])
bindings)
num-params-sym (gensym "num-params")
latebindings (mapcat
(fn [b]
[(:late-sym b) `(~(:latebind-sym b) ~PARAMS-SYM ~PARAMS-IDX-SYM)])
bindings)]
`(let [~@binding-decls
~@offset-decls
~num-params-sym (+ ~@needed-params)
~@latefn-decls
ret# ~(paramspath* latebindings num-params-sym impls)]
(if (= 0 ~num-params-sym)
(bind-params ret# nil 0)
ret#
))))
(defn params-paramspath* [paths-seq latefns-sym pre-bindings post-bindings impls]
(let [num-params-sym (gensym "num-params")]
`(let [paths# (map comp-paths* ~paths-seq)
needed-params# (map num-needed-params paths#)
offsets# (cons 0 (reductions + needed-params#))
~num-params-sym (last offsets#)
~latefns-sym (map
(fn [o# p#]
(if (instance? CompiledPath p#)
(fn [params# params-idx#]
p# )
(fn [params# params-idx#]
(bind-params p# params# (+ params-idx# o#))
)))
offsets#
paths#)
~@pre-bindings
ret# ~(paramspath* post-bindings num-params-sym impls)
]
(if (= 0 ~num-params-sym)
(bind-params ret# nil 0)
ret#
))))
;; cell implementation idea taken from prismatic schema library
(defprotocol PMutableCell
@ -502,12 +476,15 @@
((.-transform-executor ex) (.-params path) (.-params-idx path) (.-transformer tfns) transform-fn structure)
))
(defn selected?*
(defn not-selected?*
[compiled-path structure]
(->> structure
(compiled-select* compiled-path)
empty?
not))
empty?))
(defn selected?*
[compiled-path structure]
(not (not-selected?* compiled-path structure)))
;; returns vector of all results
(defn- walk-select [pred continue-fn structure]
@ -648,11 +625,9 @@
(next-fn structure)
))
(deftype ConditionalPath [cond-pairs])
(defn- retrieve-selector [cond-pairs structure]
(->> cond-pairs
(defn retrieve-cond-selector [cond-paths structure]
(->> cond-paths
(partition 2)
(drop-while (fn [[c-selector _]]
(->> structure
(compiled-select* c-selector)
@ -661,38 +636,6 @@
second
))
;;TODO: test nothing matches case
(extend-protocol p/StructurePath
ConditionalPath
(select* [this structure next-fn]
(if-let [selector (retrieve-selector (.-cond-pairs this) structure)]
(->> (compiled-select* selector structure)
(mapcat next-fn)
doall)))
(transform* [this structure next-fn]
(if-let [selector (retrieve-selector (.-cond-pairs this) structure)]
(compiled-transform* selector next-fn structure)
structure
)))
(deftype MultiPath [paths])
(extend-protocol p/StructurePath
MultiPath
(select* [this structure next-fn]
(->> (.-paths this)
(mapcat #(compiled-select* % structure))
(mapcat next-fn)
doall
))
(transform* [this structure next-fn]
(reduce
(fn [structure selector]
(compiled-transform* selector next-fn structure))
structure
(.-paths this))
))
(defn filter-select [afn structure next-fn]
(if (afn structure)
(next-fn structure)))