refactored interfaces to allow structurepaths to be specified without worrying about vals

This commit is contained in:
Nathan Marz 2015-04-15 13:43:19 -04:00
parent 46d3001217
commit d212140c8b
3 changed files with 114 additions and 88 deletions

View file

@ -13,7 +13,7 @@
(defn select [selector structure] (defn select [selector structure]
(let [sp (comp-structure-paths* selector)] (let [sp (comp-structure-paths* selector)]
(select* sp (select-full* sp
[] []
structure structure
(fn [vals structure] (fn [vals structure]
@ -46,7 +46,7 @@
(defn update [selector update-fn structure] (defn update [selector update-fn structure]
(let [selector (comp-structure-paths* selector)] (let [selector (comp-structure-paths* selector)]
(update* selector (update-full* selector
[] []
structure structure
(fn [vals structure] (fn [vals structure]
@ -104,20 +104,20 @@
(extend-type clojure.lang.Keyword (extend-type clojure.lang.Keyword
StructurePath StructurePath
(select* [kw vals structure next-fn] (select* [kw structure next-fn]
(key-select kw vals structure next-fn)) (key-select kw structure next-fn))
(update* [kw vals structure next-fn] (update* [kw structure next-fn]
(key-update kw vals structure next-fn) (key-update kw structure next-fn)
)) ))
(extend-type clojure.lang.AFn (extend-type clojure.lang.AFn
StructurePath StructurePath
(select* [afn vals structure next-fn] (select* [afn structure next-fn]
(if (afn structure) (if (afn structure)
(next-fn vals structure))) (next-fn structure)))
(update* [afn vals structure next-fn] (update* [afn structure next-fn]
(if (afn structure) (if (afn structure)
(next-fn vals structure) (next-fn structure)
structure))) structure)))
(defn val-selector [& selector] (defn val-selector [& selector]

View file

@ -4,25 +4,53 @@
[clojure.core.reducers :as r]) [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 (extend-protocol StructurePathComposer
Object Object
(comp-structure-paths* [sp] (comp-structure-paths* [sp]
sp) (coerce-path sp))
java.util.List java.util.List
(comp-structure-paths* [structure-paths] (comp-structure-paths* [structure-paths]
(reduce (fn [sp-curr sp] (reduce (fn [sp-curr sp]
(reify StructurePath (reify StructureValsPath
(select* [this vals structure next-fn] (select-full* [this vals structure next-fn]
(select* sp vals structure (select-full* sp vals structure
(fn [vals-next structure-next] (fn [vals-next structure-next]
(select* sp-curr vals-next structure-next next-fn))) (select-full* sp-curr vals-next structure-next next-fn)))
) )
(update* [this vals structure next-fn] (update-full* [this vals structure next-fn]
(update* sp vals structure (update-full* sp vals structure
(fn [vals-next structure-next] (fn [vals-next structure-next]
(update* sp-curr vals-next structure-next next-fn)))) (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 ;; cell implementation idea taken from prismatic schema library
@ -130,70 +158,67 @@
(range (count aseq)) (range (count aseq))
))) )))
(defn key-select [akey vals structure next-fn] (defn key-select [akey structure next-fn]
(next-fn vals (get structure akey))) (next-fn (get structure akey)))
(defn key-update [akey vals structure next-fn] (defn key-update [akey structure next-fn]
(assoc structure akey (next-fn vals (get structure akey)) (assoc structure akey (next-fn (get structure akey))
)) ))
(deftype AllStructurePath [] (deftype AllStructurePath []
StructurePath StructurePath
(select* [this vals structure next-fn] (select* [this structure next-fn]
(into [] (r/mapcat (partial next-fn vals) structure))) (into [] (r/mapcat next-fn structure)))
(update* [this vals structure next-fn] (update* [this structure next-fn]
(let [empty-structure (empty structure) (let [empty-structure (empty structure)]
pfn (partial next-fn vals)]
(if (list? empty-structure) (if (list? empty-structure)
;; this is done to maintain order, otherwise lists get reversed ;; this is done to maintain order, otherwise lists get reversed
(doall (map pfn structure)) (doall (map next-fn structure))
(->> structure (r/map pfn) (into empty-structure)) (->> structure (r/map next-fn) (into empty-structure))
)))) ))))
(deftype ValStructurePath [] (deftype ValStructurePath []
StructurePath ValPath
(select* [this vals structure next-fn] (select-val [this structure]
(next-fn (conj vals structure) structure)) structure))
(update* [this vals structure next-fn]
(next-fn (conj vals structure) structure)))
(deftype LastStructurePath [] (deftype LastStructurePath []
StructurePath StructurePath
(select* [this vals structure next-fn] (select* [this structure next-fn]
(next-fn vals (last structure))) (next-fn (last structure)))
(update* [this vals structure next-fn] (update* [this structure next-fn]
(set-last structure (next-fn vals (last structure))))) (set-last structure (next-fn (last structure)))))
(deftype FirstStructurePath [] (deftype FirstStructurePath []
StructurePath StructurePath
(select* [this vals structure next-fn] (select* [this structure next-fn]
(next-fn vals (first structure))) (next-fn (first structure)))
(update* [this vals structure next-fn] (update* [this structure next-fn]
(set-first structure (next-fn vals (first structure))))) (set-first structure (next-fn (first structure)))))
(deftype WalkerStructurePath [afn] (deftype WalkerStructurePath [afn]
StructurePath StructurePath
(select* [this vals structure next-fn] (select* [this structure next-fn]
(walk-select afn (partial next-fn vals) structure)) (walk-select afn next-fn structure))
(update* [this vals structure next-fn] (update* [this structure next-fn]
(walk-until afn (partial next-fn vals) structure))) (walk-until afn next-fn structure)))
(deftype CodeWalkerStructurePath [afn] (deftype CodeWalkerStructurePath [afn]
StructurePath StructurePath
(select* [this vals structure next-fn] (select* [this structure next-fn]
(walk-select afn (partial next-fn vals) structure)) (walk-select afn next-fn structure))
(update* [this vals structure next-fn] (update* [this structure next-fn]
(codewalk-until afn (partial next-fn vals) structure))) (codewalk-until afn next-fn structure)))
(deftype FilterStructurePath [afn] (deftype FilterStructurePath [afn]
StructurePath StructurePath
(select* [this vals structure next-fn] (select* [this structure next-fn]
(next-fn vals (filter afn structure))) (next-fn (filter afn structure)))
(update* [this vals structure next-fn] (update* [this structure next-fn]
(let [[filtered ancestry] (filter+ancestry afn structure) (let [[filtered ancestry] (filter+ancestry afn structure)
;; the vec is necessary so that we can get by index later ;; the vec is necessary so that we can get by index later
;; (can't get by index for cons'd lists) ;; (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]] (reduce (fn [curr [newi oldi]]
(assoc curr oldi (get next newi))) (assoc curr oldi (get next newi)))
(vec structure) (vec structure)
@ -201,36 +226,30 @@
(deftype KeyPath [akey] (deftype KeyPath [akey]
StructurePath StructurePath
(select* [this vals structure next-fn] (select* [this structure next-fn]
(key-select akey vals structure next-fn)) (key-select akey structure next-fn))
(update* [this vals structure next-fn] (update* [this structure next-fn]
(key-update akey vals 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] (deftype SelectorValsPath [sel-fn selector]
StructurePath ValPath
(select* [this vals structure next-fn] (select-val [this structure]
(selector-vals* sel-fn selector vals structure next-fn)) (sel-fn selector structure)))
(update* [this vals structure next-fn]
(selector-vals* sel-fn selector vals structure next-fn)))
(deftype SRangePath [start-fn end-fn] (deftype SRangePath [start-fn end-fn]
StructurePath StructurePath
(select* [this vals structure next-fn] (select* [this structure next-fn]
(let [start (start-fn structure) (let [start (start-fn structure)
end (end-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) (let [start (start-fn structure)
end (end-fn structure) end (end-fn structure)
structurev (vec 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) res (concat (subvec structurev 0 start)
newpart newpart
(subvec structurev end (count structure)))] (subvec structurev end (count structure)))]

View file

@ -1,9 +1,16 @@
(ns com.rpl.specter.protocols) (ns com.rpl.specter.protocols)
(defprotocol StructureValsPath
(select-full* [this vals structure next-fn])
(update-full* [this vals structure next-fn]))
(defprotocol StructurePath (defprotocol StructurePath
(select* [this vals structure next-fn]) (select* [this structure next-fn])
(update* [this vals structure next-fn]) (update* [this structure next-fn]))
)
(defprotocol ValPath
(select-val [this structure]))
(defprotocol StructurePathComposer (defprotocol StructurePathComposer
(comp-structure-paths* [structure-paths])) (comp-structure-paths* [structure-paths]))