refactored interfaces to allow structurepaths to be specified without worrying about vals
This commit is contained in:
parent
46d3001217
commit
d212140c8b
3 changed files with 114 additions and 88 deletions
|
|
@ -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]
|
||||||
|
|
|
||||||
|
|
@ -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)))]
|
||||||
|
|
|
||||||
|
|
@ -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]))
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue