diff --git a/src/clj/com/rpl/specter.clj b/src/clj/com/rpl/specter.clj index d04ea50..6b2239d 100644 --- a/src/clj/com/rpl/specter.clj +++ b/src/clj/com/rpl/specter.clj @@ -11,84 +11,89 @@ ;; Selector functions -(defn select - "Navigates to and returns a sequence of all the elements specified by the selector." - [selector structure] - (let [sp (comp-paths* selector)] - (select-full* sp - [] - structure - (fn [vals structure] - (if-not (empty? vals) [(conj vals structure)] [structure]))) - )) - -(defn select-fast +(defn compiled-select + "Version of select that takes in a selector pre-compiled with comp-paths" [^com.rpl.specter.impl.StructureValsPathFunctions selfns structure] ((.selector selfns) [] structure (fn [vals structure] - (if-not (empty? vals) [(conj vals structure)] [structure]))) - ) + (if-not (empty? vals) [(conj vals structure)] [structure])))) -(defn select-one - "Like select, but returns either one element or nil. Throws exception if multiple elements found" +(defn select + "Navigates to and returns a sequence of all the elements specified by the selector." [selector structure] - (let [res (select selector structure)] + (compiled-select (comp-paths* selector) + structure)) + +(defn compiled-select-one + "Version of select-one that takes in a selector pre-compiled with comp-paths" + [selector structure] + (let [res (compiled-select selector structure)] (when (> (count res) 1) (throw-illegal "More than one element found for params: " selector structure)) (first res) )) -(defn select-one! - "Returns exactly one element, throws exception if zero or multiple elements found" +(defn select-one + "Like select, but returns either one element or nil. Throws exception if multiple elements found" [selector structure] - (let [res (select-one selector structure)] + (compiled-select-one (comp-paths* selector) structure)) + +(defn compiled-select-one! + "Version of select-one! that takes in a selector pre-compiled with comp-paths" + [selector structure] + (let [res (compiled-select-one selector structure)] (when (nil? res) (throw-illegal "No elements found for params: " selector structure)) res )) +(defn select-one! + "Returns exactly one element, throws exception if zero or multiple elements found" + [selector structure] + (compiled-select-one! (comp-paths* selector) structure)) + +(defn compiled-select-first + "Version of select-first that takes in a selector pre-compiled with comp-paths" + [selector structure] + (first (compiled-select selector structure))) + (defn select-first "Returns first element found. Not any more efficient than select, just a convenience" [selector structure] - (first (select selector structure))) + (compiled-select-first (comp-paths* selector) structure)) ;; Update functions -(defn update - "Navigates to each value specified by the selector and replaces it by the result of running - the update-fn on it" - [selector update-fn structure] - (let [selector (comp-paths* selector)] - (update-full* selector - [] - structure - (fn [vals structure] - (if (empty? vals) - (update-fn structure) - (apply update-fn (conj vals structure))) - )))) - -(defn update-fast [^com.rpl.specter.impl.StructureValsPathFunctions selfns update-fn structure] +(defn compiled-update + "Version of update that takes in a selector pre-compiled with comp-paths" + [^com.rpl.specter.impl.StructureValsPathFunctions selfns update-fn structure] ((.updater selfns) [] structure (fn [vals structure] (if (empty? vals) (update-fn structure) (apply update-fn (conj vals structure))) - )) - ) + ))) + +(defn update + "Navigates to each value specified by the selector and replaces it by the result of running + the update-fn on it" + [selector update-fn structure] + (compiled-update (comp-paths* selector) update-fn structure)) + +(defn compiled-setval + "Version of setval that takes in a selector pre-compiled with comp-paths" + [selector val structure] + (compiled-update selector (fn [_] val) structure)) (defn setval "Navigates to each value specified by the selector and replaces it by val" [selector val structure] - (update selector (fn [_] val) structure)) + (compiled-setval (comp-paths* selector) val structure)) -(defn replace-in [selector update-fn structure & {:keys [merge-fn] :or {merge-fn concat}}] - "Similar to update, except returns a pair of [updated-structure sequence-of-user-ret]. - The update-fn in this case is expected to return [ret user-ret]. ret is - what's used to update the data structure, while user-ret will be added to the user-ret sequence - in the final return. replace-in is useful for situations where you need to know the specific values - of what was updated in the data structure." +(defn compiled-replace-in + "Version of replace-in that takes in a selector pre-compiled with comp-paths" + [selector update-fn structure & {:keys [merge-fn] :or {merge-fn concat}}] (let [state (mutable-cell nil)] - [(update selector + [(compiled-update selector (fn [e] (let [res (update-fn e)] (if res @@ -103,6 +108,15 @@ (get-cell state)] )) +(defn replace-in + "Similar to update, except returns a pair of [updated-structure sequence-of-user-ret]. + The update-fn in this case is expected to return [ret user-ret]. ret is + what's used to update the data structure, while user-ret will be added to the user-ret sequence + in the final return. replace-in is useful for situations where you need to know the specific values + of what was updated in the data structure." + [selector update-fn structure & {:keys [merge-fn] :or {merge-fn concat}}] + (compiled-replace-in (comp-paths* selector) update-fn structure :merge-fn merge-fn)) + ;; Built-in pathing and context operations (def ALL (->AllStructurePath)) diff --git a/src/clj/com/rpl/specter/impl.clj b/src/clj/com/rpl/specter/impl.clj index d5423d5..92383fe 100644 --- a/src/clj/com/rpl/specter/impl.clj +++ b/src/clj/com/rpl/specter/impl.clj @@ -4,61 +4,84 @@ [clojure.core.reducers :as r]) ) +(defmacro throw* [etype & args] + `(throw (new ~etype (pr-str ~@args)))) + +(defmacro throw-illegal [& args] + `(throw* IllegalArgumentException ~@args)) + (defn benchmark [iters afn] (time (dotimes [_ iters] (afn)))) -(deftype StructureValsPathFunctions [selector updater] - StructureValsPath - (select-full* [this vals structure next-fn] - (selector vals structure next-fn)) - (update-full* [this vals structure next-fn] - (updater vals structure next-fn))) +(deftype StructureValsPathFunctions [selector updater]) (defprotocol CoerceStructureValsPathFunctions (coerce-path [this])) +(defn no-prot-error-str [obj] + (str "Protocol implementation cannot be found for object. + Extending Specter protocols should not be done inline in a deftype definition + because that prevents Specter from finding the protocol implementations for + optimized performance. Instead, you should extend the protocols via an + explicit extend-protocol call. \n" obj)) + +(defn find-protocol-impl! [prot obj] + (let [ret (find-protocol-impl prot obj)] + (if (= ret obj) + (throw-illegal (no-prot-error-str obj)) + ret + ))) + +(defn coerce-structure-vals-path [this] + (let [pimpl (find-protocol-impl! StructureValsPath this) + selector (:select-full* pimpl) + updater (:update-full* pimpl)] + (->StructureValsPathFunctions + (fn [vals structure next-fn] + (selector this vals structure next-fn)) + (fn [vals structure next-fn] + (updater this vals structure next-fn))) + )) + +(defn coerce-collector [this] + (let [cfn (->> this + (find-protocol-impl! Collector) + :collect-val + ) + afn (fn [vals structure next-fn] + (next-fn (conj vals (cfn this structure)) structure) + )] + (->StructureValsPathFunctions afn afn))) + +(defn coerce-structure-path [this] + (let [pimpl (find-protocol-impl! StructurePath this) + selector (:select* pimpl) + updater (:update* pimpl)] + (->StructureValsPathFunctions + (fn [vals structure next-fn] + (selector this structure (fn [structure] (next-fn vals structure)))) + (fn [vals structure next-fn] + (updater this structure (fn [structure] (next-fn vals structure)))) + ))) + +(defn obj-extends? [prot obj] + (->> obj (find-protocol-impl prot) nil? not)) + (extend-protocol CoerceStructureValsPathFunctions - com.rpl.specter.protocols.StructureValsPath + StructureValsPathFunctions (coerce-path [this] - (let [pimpl (->> this - (find-protocol-impl StructureValsPath)) - selector (:select-full* pimpl) - updater (:update-full* pimpl)] - (->StructureValsPathFunctions - (fn [vals structure next-fn] - (selector this vals structure next-fn)) - (fn [vals structure next-fn] - (updater this vals structure next-fn))) - )) + this) - com.rpl.specter.protocols.Collector - (coerce-path [collector] - (let [pimpl (->> collector - (find-protocol-impl Collector) - :collect-val - ) - afn (fn [vals structure next-fn] - (next-fn (conj vals (pimpl collector structure)) structure) - )] - (->StructureValsPathFunctions afn afn))) - - ;; need to say Object instead of StructurePath so that things like Keyword are properly coerced Object (coerce-path [this] - (let [pimpl (->> this - (find-protocol-impl StructurePath)) - selector (:select* pimpl) - updater (:update* pimpl)] - (->StructureValsPathFunctions - (fn [vals structure next-fn] - (selector this structure (fn [structure] (next-fn vals structure)))) - (fn [vals structure next-fn] - (updater this structure (fn [structure] (next-fn vals structure)))) + (cond (obj-extends? StructurePath this) (coerce-structure-path this) + (obj-extends? Collector this) (coerce-collector this) + (obj-extends? StructureValsPath this) (coerce-structure-vals-path this) + :else (throw-illegal (no-prot-error-str this)) ))) - ) (extend-protocol StructureValsPathComposer @@ -67,9 +90,6 @@ (coerce-path sp)) java.util.List (comp-paths* [structure-paths] - ;;TODO: don't reify any protocols... instead coerce to a "StructureValsPathFunctions" record - ;; and compose functions directly - (reduce (fn [^StructureValsPathFunctions sp-curr ^StructureValsPathFunctions sp] (let [curr-selector (.selector sp-curr) selector (.selector sp) @@ -110,12 +130,6 @@ (defn get-cell [^PMutableCell cell] (.get_cell cell)) -(defmacro throw* [etype & args] - `(throw (new ~etype (pr-str ~@args)))) - -(defmacro throw-illegal [& args] - `(throw* IllegalArgumentException ~@args)) - (defn update-cell! [cell afn] (let [ret (afn (get-cell cell))] (set-cell! cell ret) @@ -202,8 +216,10 @@ (assoc structure akey (next-fn (get structure akey)) )) -(deftype AllStructurePath [] - StructurePath +(deftype AllStructurePath []) + +(extend-protocol StructurePath + AllStructurePath (select* [this structure next-fn] (into [] (r/mapcat next-fn structure))) (update* [this structure next-fn] @@ -214,45 +230,58 @@ (->> structure (r/map next-fn) (into empty-structure)) )))) -(deftype ValCollect [] - Collector +(deftype ValCollect []) + +(extend-protocol Collector + ValCollect (collect-val [this structure] structure)) -(deftype LastStructurePath [] - StructurePath +(deftype LastStructurePath []) + +(extend-protocol StructurePath + LastStructurePath (select* [this structure next-fn] (next-fn (last structure))) (update* [this structure next-fn] (set-last structure (next-fn (last structure))))) -(deftype FirstStructurePath [] - StructurePath +(deftype FirstStructurePath []) + +(extend-protocol StructurePath + FirstStructurePath (select* [this structure next-fn] (next-fn (first structure))) (update* [this structure next-fn] (set-first structure (next-fn (first structure))))) -(deftype WalkerStructurePath [afn] - StructurePath - (select* [this structure next-fn] - (walk-select afn next-fn structure)) - (update* [this structure next-fn] - (walk-until afn next-fn structure))) +(deftype WalkerStructurePath [afn]) -(deftype CodeWalkerStructurePath [afn] - StructurePath - (select* [this structure next-fn] - (walk-select afn next-fn structure)) - (update* [this structure next-fn] - (codewalk-until afn next-fn structure))) +(extend-protocol StructurePath + WalkerStructurePath + (select* [^WalkerStructurePath this structure next-fn] + (walk-select (.afn this) next-fn structure)) + (update* [^WalkerStructurePath this structure next-fn] + (walk-until (.afn this) next-fn structure))) -(deftype FilterStructurePath [afn] - StructurePath - (select* [this structure next-fn] - (->> structure (filter afn) doall next-fn)) - (update* [this structure next-fn] - (let [[filtered ancestry] (filter+ancestry afn structure) +(deftype CodeWalkerStructurePath [afn]) + +(extend-protocol StructurePath + CodeWalkerStructurePath + (select* [^CodeWalkerStructurePath this structure next-fn] + (walk-select (.afn this) next-fn structure)) + (update* [^CodeWalkerStructurePath this structure next-fn] + (codewalk-until (.afn this) next-fn structure))) + + +(deftype FilterStructurePath [afn]) + +(extend-protocol StructurePath + FilterStructurePath + (select* [^FilterStructurePath this structure next-fn] + (->> structure (filter (.afn this)) doall next-fn)) + (update* [^FilterStructurePath this structure next-fn] + (let [[filtered ancestry] (filter+ancestry (.afn this) structure) ;; the vec is necessary so that we can get by index later ;; (can't get by index for cons'd lists) next (vec (next-fn filtered))] @@ -261,29 +290,36 @@ (vec structure) ancestry)))) -(deftype KeyPath [akey] - StructurePath - (select* [this structure next-fn] - (key-select akey structure next-fn)) - (update* [this structure next-fn] - (key-update akey structure next-fn) +(deftype KeyPath [akey]) + + +(extend-protocol StructurePath + KeyPath + (select* [^KeyPath this structure next-fn] + (key-select (.akey this) structure next-fn)) + (update* [^KeyPath this structure next-fn] + (key-update (.akey this) structure next-fn) )) -(deftype SelectCollector [sel-fn selector] - Collector - (collect-val [this structure] - (sel-fn selector structure))) +(deftype SelectCollector [sel-fn selector]) + +(extend-protocol Collector + SelectCollector + (collect-val [^SelectCollector this structure] + ((.sel-fn this) (.selector this) structure))) -(deftype SRangePath [start-fn end-fn] - StructurePath - (select* [this structure next-fn] - (let [start (start-fn structure) - end (end-fn structure)] +(deftype SRangePath [start-fn end-fn]) + +(extend-protocol StructurePath + SRangePath + (select* [^SRangePath this structure next-fn] + (let [start ((.start-fn this) structure) + end ((.end-fn this) structure)] (next-fn (-> structure vec (subvec start end))) )) - (update* [this structure next-fn] - (let [start (start-fn structure) - end (end-fn structure) + (update* [^SRangePath this structure next-fn] + (let [start ((.start-fn this) structure) + end ((.end-fn this) structure) structurev (vec structure) newpart (next-fn (-> structurev (subvec start end))) res (concat (subvec structurev 0 start) @@ -294,12 +330,14 @@ res )))) -(deftype ViewPath [view-fn] - StructurePath - (select* [this structure next-fn] - (-> structure view-fn next-fn)) - (update* [this structure next-fn] - (-> structure view-fn next-fn) +(deftype ViewPath [view-fn]) + +(extend-protocol StructurePath + ViewPath + (select* [^ViewPath this structure next-fn] + (->> structure ((.view-fn this)) next-fn)) + (update* [^ViewPath this structure next-fn] + (->> structure ((.view-fn this)) next-fn) )) diff --git a/src/clj/com/rpl/specter/protocols.clj b/src/clj/com/rpl/specter/protocols.clj index cd357e3..2a4912e 100644 --- a/src/clj/com/rpl/specter/protocols.clj +++ b/src/clj/com/rpl/specter/protocols.clj @@ -1,7 +1,5 @@ (ns com.rpl.specter.protocols) - -;;TODO: can use find-protocol-impl function to avoid all the protocol calls (defprotocol StructureValsPath (select-full* [this vals structure next-fn]) (update-full* [this vals structure next-fn]))