diff --git a/src/clj/com/rpl/specter.clj b/src/clj/com/rpl/specter.clj index a303c0e..f457483 100644 --- a/src/clj/com/rpl/specter.clj +++ b/src/clj/com/rpl/specter.clj @@ -13,11 +13,11 @@ (defn select [selector structure] (let [sp (comp-structure-paths* selector)] - (select* sp - [] - structure - (fn [vals structure] - (if-not (empty? vals) [(conj vals structure)] [structure]))) + (select-full* sp + [] + structure + (fn [vals structure] + (if-not (empty? vals) [(conj vals structure)] [structure]))) )) (defn select-one @@ -46,14 +46,14 @@ (defn update [selector update-fn structure] (let [selector (comp-structure-paths* selector)] - (update* selector - [] - structure - (fn [vals structure] - (if (empty? vals) - (update-fn structure) - (apply update-fn (conj vals structure))) - )))) + (update-full* selector + [] + structure + (fn [vals structure] + (if (empty? vals) + (update-fn structure) + (apply update-fn (conj vals structure))) + )))) (defn setval [selector val structure] (update selector (fn [_] val) structure)) @@ -104,20 +104,20 @@ (extend-type clojure.lang.Keyword StructurePath - (select* [kw vals structure next-fn] - (key-select kw vals structure next-fn)) - (update* [kw vals structure next-fn] - (key-update kw vals structure next-fn) + (select* [kw structure next-fn] + (key-select kw structure next-fn)) + (update* [kw structure next-fn] + (key-update kw structure next-fn) )) (extend-type clojure.lang.AFn StructurePath - (select* [afn vals structure next-fn] + (select* [afn structure next-fn] (if (afn structure) - (next-fn vals structure))) - (update* [afn vals structure next-fn] + (next-fn structure))) + (update* [afn structure next-fn] (if (afn structure) - (next-fn vals structure) + (next-fn structure) structure))) (defn val-selector [& selector] diff --git a/src/clj/com/rpl/specter/impl.clj b/src/clj/com/rpl/specter/impl.clj index 3880901..afa49d9 100644 --- a/src/clj/com/rpl/specter/impl.clj +++ b/src/clj/com/rpl/specter/impl.clj @@ -4,25 +4,53 @@ [clojure.core.reducers :as r]) ) +(defprotocol CoerceStructureValsPath + (coerce-path [this])) + +(extend-protocol CoerceStructureValsPath + + com.rpl.specter.protocols.StructureValsPath + (coerce-path [this] this) + + com.rpl.specter.protocols.ValPath + (coerce-path [valpath] + (reify StructureValsPath + (select-full* [this vals structure next-fn] + (next-fn (conj vals (select-val valpath structure)) structure)) + (update-full* [this vals structure next-fn] + (next-fn (conj vals (select-val valpath structure)) structure)))) + + ;; need to say Object instead of StructurePath so that things like Keyword are properly coerced + Object + (coerce-path [spath] + (reify StructureValsPath + (select-full* [this vals structure next-fn] + (select* spath structure (fn [structure] (next-fn vals structure)))) + (update-full* [this vals structure next-fn] + (update* spath structure (fn [structure] (next-fn vals structure))) + ))) + ) + + (extend-protocol StructurePathComposer Object (comp-structure-paths* [sp] - sp) + (coerce-path sp)) java.util.List (comp-structure-paths* [structure-paths] (reduce (fn [sp-curr sp] - (reify StructurePath - (select* [this vals structure next-fn] - (select* sp vals structure - (fn [vals-next structure-next] - (select* sp-curr vals-next structure-next next-fn))) + (reify StructureValsPath + (select-full* [this vals structure next-fn] + (select-full* sp vals structure + (fn [vals-next structure-next] + (select-full* sp-curr vals-next structure-next next-fn))) ) - (update* [this vals structure next-fn] - (update* sp vals structure - (fn [vals-next structure-next] - (update* sp-curr vals-next structure-next next-fn)))) + (update-full* [this vals structure next-fn] + (update-full* sp vals structure + (fn [vals-next structure-next] + (update-full* sp-curr vals-next structure-next next-fn)))) )) - (-> structure-paths flatten reverse)) + (->> structure-paths flatten (map coerce-path) reverse)) )) ;; cell implementation idea taken from prismatic schema library @@ -130,70 +158,67 @@ (range (count aseq)) ))) -(defn key-select [akey vals structure next-fn] - (next-fn vals (get structure akey))) +(defn key-select [akey structure next-fn] + (next-fn (get structure akey))) -(defn key-update [akey vals structure next-fn] - (assoc structure akey (next-fn vals (get structure akey)) +(defn key-update [akey structure next-fn] + (assoc structure akey (next-fn (get structure akey)) )) (deftype AllStructurePath [] StructurePath - (select* [this vals structure next-fn] - (into [] (r/mapcat (partial next-fn vals) structure))) - (update* [this vals structure next-fn] - (let [empty-structure (empty structure) - pfn (partial next-fn vals)] + (select* [this structure next-fn] + (into [] (r/mapcat next-fn structure))) + (update* [this structure next-fn] + (let [empty-structure (empty structure)] (if (list? empty-structure) ;; this is done to maintain order, otherwise lists get reversed - (doall (map pfn structure)) - (->> structure (r/map pfn) (into empty-structure)) + (doall (map next-fn structure)) + (->> structure (r/map next-fn) (into empty-structure)) )))) (deftype ValStructurePath [] - StructurePath - (select* [this vals structure next-fn] - (next-fn (conj vals structure) structure)) - (update* [this vals structure next-fn] - (next-fn (conj vals structure) structure))) + ValPath + (select-val [this structure] + structure)) (deftype LastStructurePath [] StructurePath - (select* [this vals structure next-fn] - (next-fn vals (last structure))) - (update* [this vals structure next-fn] - (set-last structure (next-fn vals (last structure))))) + (select* [this structure next-fn] + (next-fn (last structure))) + (update* [this structure next-fn] + (set-last structure (next-fn (last structure))))) (deftype FirstStructurePath [] StructurePath - (select* [this vals structure next-fn] - (next-fn vals (first structure))) - (update* [this vals structure next-fn] - (set-first structure (next-fn vals (first structure))))) + (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 vals structure next-fn] - (walk-select afn (partial next-fn vals) structure)) - (update* [this vals structure next-fn] - (walk-until afn (partial next-fn vals) structure))) + (select* [this structure next-fn] + (walk-select afn next-fn structure)) + (update* [this structure next-fn] + (walk-until afn next-fn structure))) (deftype CodeWalkerStructurePath [afn] StructurePath - (select* [this vals structure next-fn] - (walk-select afn (partial next-fn vals) structure)) - (update* [this vals structure next-fn] - (codewalk-until afn (partial next-fn vals) structure))) + (select* [this structure next-fn] + (walk-select afn next-fn structure)) + (update* [this structure next-fn] + (codewalk-until afn next-fn structure))) (deftype FilterStructurePath [afn] StructurePath - (select* [this vals structure next-fn] - (next-fn vals (filter afn structure))) - (update* [this vals structure next-fn] + (select* [this structure next-fn] + (next-fn (filter afn structure))) + (update* [this structure next-fn] (let [[filtered ancestry] (filter+ancestry afn 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 vals filtered))] + next (vec (next-fn filtered))] (reduce (fn [curr [newi oldi]] (assoc curr oldi (get next newi))) (vec structure) @@ -201,36 +226,30 @@ (deftype KeyPath [akey] StructurePath - (select* [this vals structure next-fn] - (key-select akey vals structure next-fn)) - (update* [this vals structure next-fn] - (key-update akey vals structure next-fn) + (select* [this structure next-fn] + (key-select akey structure next-fn)) + (update* [this structure next-fn] + (key-update akey structure next-fn) )) -(defn- selector-vals* [sel-fn selector vals structure next-fn] - (next-fn (vec (concat vals - [(sel-fn selector structure)])) - structure)) (deftype SelectorValsPath [sel-fn selector] - StructurePath - (select* [this vals structure next-fn] - (selector-vals* sel-fn selector vals structure next-fn)) - (update* [this vals structure next-fn] - (selector-vals* sel-fn selector vals structure next-fn))) + ValPath + (select-val [this structure] + (sel-fn selector structure))) (deftype SRangePath [start-fn end-fn] StructurePath - (select* [this vals structure next-fn] + (select* [this structure next-fn] (let [start (start-fn structure) end (end-fn structure)] - (next-fn vals (-> structure vec (subvec start end))) + (next-fn (-> structure vec (subvec start end))) )) - (update* [this vals structure next-fn] + (update* [this structure next-fn] (let [start (start-fn structure) end (end-fn structure) structurev (vec structure) - newpart (next-fn vals (-> structurev (subvec start end))) + newpart (next-fn (-> structurev (subvec start end))) res (concat (subvec structurev 0 start) newpart (subvec structurev end (count structure)))] diff --git a/src/clj/com/rpl/specter/protocols.clj b/src/clj/com/rpl/specter/protocols.clj index 0ea8550..c7cfea9 100644 --- a/src/clj/com/rpl/specter/protocols.clj +++ b/src/clj/com/rpl/specter/protocols.clj @@ -1,9 +1,16 @@ (ns com.rpl.specter.protocols) + +(defprotocol StructureValsPath + (select-full* [this vals structure next-fn]) + (update-full* [this vals structure next-fn])) + (defprotocol StructurePath - (select* [this vals structure next-fn]) - (update* [this vals structure next-fn]) - ) + (select* [this structure next-fn]) + (update* [this structure next-fn])) + +(defprotocol ValPath + (select-val [this structure])) (defprotocol StructurePathComposer (comp-structure-paths* [structure-paths]))