From a983e6e0282a1e9f403446e80e3fb4abdfd085e5 Mon Sep 17 00:00:00 2001 From: Nathan Marz Date: Thu, 10 Sep 2015 20:47:46 -0400 Subject: [PATCH] all higher order selectors now converted to be parameterizable, helpers for making higher order selectors with fixed paths or variable paths complete --- src/com/rpl/specter.cljc | 111 ++++++++++++++++++++--------- src/com/rpl/specter/impl.cljc | 127 ++++++++++------------------------ 2 files changed, 115 insertions(+), 123 deletions(-) diff --git a/src/com/rpl/specter.cljc b/src/com/rpl/specter.cljc index 2863f48..cdb3d26 100644 --- a/src/com/rpl/specter.cljc +++ b/src/com/rpl/specter.cljc @@ -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 + )))) diff --git a/src/com/rpl/specter/impl.cljc b/src/com/rpl/specter/impl.cljc index 101da23..75618c8 100644 --- a/src/com/rpl/specter/impl.cljc +++ b/src/com/rpl/specter/impl.cljc @@ -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)))