diff --git a/src/clj/com/rpl/specter/impl.cljc b/src/clj/com/rpl/specter/impl.cljc index 42d3bc4..bcb4631 100644 --- a/src/clj/com/rpl/specter/impl.cljc +++ b/src/clj/com/rpl/specter/impl.cljc @@ -784,21 +784,3 @@ (defn compiled-multi-transform* [path structure] (compiled-transform* path multi-transform-error-fn structure)) - -;;TODO: need a way to deal with protocol paths... -;;maybe they get extended with a function and produce a `path` -;;but could be recursive -; #?(:clj -; (defn extend-protocolpath* [protpath protpath-prot extensions] -; (let [extensions (partition 2 extensions) -; m (-> protpath-prot :sigs keys first) -; expected-params (num-needed-params protpath)] -; (doseq [[atype apath] extensions] -; (let [p (comp-paths-internalized apath) -; needed-params (num-needed-params p) -; rich-nav (extract-rich-nav p)] -; -; (if-not (= needed-params expected-params) -; (throw-illegal "Invalid number of params in extended protocol path, expected " -; expected-params " but got " needed-params)) -; (extend atype protpath-prot {m (fn [_] rich-nav)})))))) diff --git a/src/clj/com/rpl/specter/macros.clj b/src/clj/com/rpl/specter/macros.clj index 2b8b3bd..e675e51 100644 --- a/src/clj/com/rpl/specter/macros.clj +++ b/src/clj/com/rpl/specter/macros.clj @@ -79,60 +79,6 @@ (defmacro late-bound-richnav [bindings & impls] (late-bound-operation bindings `richnav impls)) -(defn- protpath-sym [name] - (-> name (str "-prot") symbol)) - - -;;TODO: redesign so can still have parameterized protpaths... -;;TODO: mainly need recursion -(defmacro defprotocolpath - "Defines a navigator that chooses the path to take based on the type - of the value at the current point. May be specified with parameters to - specify that all extensions must require that number of parameters. - - Currently not available for ClojureScript. - - Example of usage: - (defrecord SingleAccount [funds]) - (defrecord FamilyAccount [single-accounts]) - - (defprotocolpath FundsPath) - (extend-protocolpath FundsPath - SingleAccount :funds - FamilyAccount [ALL FundsPath] - ) -" - ([name] - `(defprotocolpath ~name [])) - ([name params] - (let [prot-name (protpath-sym name) - m (-> name (str "-retrieve") symbol) - num-params (count params) - ssym (gensym "structure") - rargs [(gensym "vals") ssym (gensym "next-fn")] - retrieve `(~m ~ssym)] - - `(do - (defprotocol ~prot-name (~m [structure#])) - (let [nav# (reify RichNavigator - (~'select* [this# ~@rargs] - (let [inav# ~retrieve] - (i/exec-select* inav# ~@rargs))) - - (~'rich-transform* [this# ~@rargs] - (let [inav# ~retrieve] - (i/exec-transform* inav# ~@rargs))))] - - (def ~name - (if (= ~num-params 0) - (i/no-params-rich-compiled-path nav#) - (i/->ParamsNeededPath nav# ~num-params)))))))) - -(defmacro extend-protocolpath - "Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]." - [protpath & extensions] - `(i/extend-protocolpath* ~protpath ~(protpath-sym protpath) ~(vec extensions))) - (defmacro declarepath [name] `(def ~name (i/local-declarepath))) @@ -427,3 +373,63 @@ to capture all the collected values as a single vector." [params & body] `(i/collected?* (~'fn [~params] ~@body))) + + +(defn- protpath-sym [name] + (-> name (str "-prot") symbol)) + +(defn- protpath-meth-sym [name] + (-> name (str "-retrieve") symbol)) + + +(defmacro defprotocolpath + "Defines a navigator that chooses the path to take based on the type + of the value at the current point. May be specified with parameters to + specify that all extensions must require that number of parameters. + + Currently not available for ClojureScript. + + Example of usage: + (defrecord SingleAccount [funds]) + (defrecord FamilyAccount [single-accounts]) + + (defprotocolpath FundsPath) + (extend-protocolpath FundsPath + SingleAccount :funds + FamilyAccount [ALL FundsPath] + ) +" + ([name] + `(defprotocolpath ~name [])) + ([name params] + (let [prot-name (protpath-sym name) + m (protpath-meth-sym name) + num-params (count params) + ssym (gensym "structure") + rargs [(gensym "vals") ssym (gensym "next-fn")] + retrieve `(~m ~ssym ~@params)] + `(do + (defprotocol ~prot-name (~m [structure# ~@params])) + (defrichnav ~name ~params + (~'select* [this# ~@rargs] + (let [inav# ~retrieve] + (i/exec-select* inav# ~@rargs))) + (~'transform* [this# ~@rargs] + (let [inav# ~retrieve] + (i/exec-transform* inav# ~@rargs)))))))) + +(defn extend-protocolpath* [protpath-prot extensions] + (let [m (-> protpath-prot :sigs keys first) + params (-> protpath-prot :sigs first last :arglists first)] + (doseq [[atype path-code] extensions] + (extend atype protpath-prot + {m (eval `(fn ~params (path ~path-code)))})))) + +(defmacro extend-protocolpath + "Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]." + [protpath & extensions] + (let [extensions (partition 2 extensions) + embed (vec (for [[t p] extensions] [t `(quote ~p)]))] + `(extend-protocolpath* + ~(protpath-sym protpath) + ~embed)))