luciano/specter
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'cljs'

Browse source
This commit is contained in:
Nathan Marz 2015-06-30 20:04:20 -04:00
commit 2137159311
11 changed files with 396 additions and 258 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -9,3 +9,4 @@ pom.xml.asc
.lein-repl-history
.lein-plugins/
.lein-failures
out/

12
DEVELOPER.md Normal file
View file

@ -0,0 +1,12 @@
# Running Clojure tests
```
lein test com.rpl.specter.core-test
```
# Running ClojureScript tests
```
$ rlwrap java -cp `lein classpath`:cljs.jar clojure.main repl.clj
cljs.user=> (require 'com.rpl.specter.cljs-test-runner)
```

23
project.clj
View file

@ -1,11 +1,24 @@
(def VERSION (.trim (slurp "VERSION")))
(defproject com.rpl/specter VERSION
:dependencies [[org.clojure/clojure "1.6.0"]
:dependencies [[org.clojure/clojure "1.7.0"]
;;TODO: how to make this a dep of only the cljs version?
[org.clojure/clojurescript "0.0-3308"]
]
:jvm-opts ["-XX:-OmitStackTraceInFastThrow"] ; this prevents JVM from doing optimizations which can remove stack traces from NPE and other exceptions
:source-paths ["src/clj"]
:test-paths ["test/clj"]
:plugins [[lein-cljsbuild "1.0.6"]]
:source-paths ["src"]
:test-paths ["test"]
:profiles {:dev {:dependencies
[[org.clojure/test.check "0.5.9"]]}
})
[[org.clojure/test.check "0.7.0"]]}
}
:cljsbuild {
:builds {:dev
{:source-paths ["src"]
:compiler {
:output-to "target/main.js"
:optimizations :whitespace
:pretty-print true
}}
}
})

11
repl.clj Normal file
View file

@ -0,0 +1,11 @@
(require 'cljs.repl)
(require 'cljs.build.api)
(require 'cljs.repl.node)
(cljs.build.api/build "src"
{:output-to "out/main.js"
:verbose true})
(cljs.repl/repl (cljs.repl.node/repl-env)
:watch "src"
:output-dir "out")

84
src/clj/com/rpl/specter.clj → src/com/rpl/specter.cljc
View file

@ -1,5 +1,6 @@
(ns com.rpl.specter
(:use [com.rpl.specter impl protocols])
(:use [com.rpl.specter.protocols :only [StructurePath comp-paths*]])
(:require [com.rpl.specter.impl :as i])
)
;;TODO: can make usage of vals much more efficient by determining during composition how many vals
@ -12,12 +13,12 @@
;; Selector functions
(def ^{:doc "Version of select that takes in a selector pre-compiled with comp-paths"}
compiled-select compiled-select*)
compiled-select i/compiled-select*)
(defn select
"Navigates to and returns a sequence of all the elements specified by the selector."
[selector structure]
(compiled-select (comp-unoptimal selector)
(compiled-select (i/comp-unoptimal selector)
structure))
(defn compiled-select-one
@ -25,27 +26,27 @@
[selector structure]
(let [res (compiled-select selector structure)]
(when (> (count res) 1)
(throw-illegal "More than one element found for params: " selector structure))
(i/throw-illegal "More than one element found for params: " selector structure))
(first res)
))
(defn select-one
"Like select, but returns either one element or nil. Throws exception if multiple elements found"
[selector structure]
(compiled-select-one (comp-unoptimal selector) structure))
(compiled-select-one (i/comp-unoptimal 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 (not= 1 (count res)) (throw-illegal "Expected exactly one element for params: " selector structure))
(when (not= 1 (count res)) (i/throw-illegal "Expected exactly one element for params: " selector structure))
(first res)
))
(defn select-one!
"Returns exactly one element, throws exception if zero or multiple elements found"
[selector structure]
(compiled-select-one! (comp-unoptimal selector) structure))
(compiled-select-one! (i/comp-unoptimal selector) structure))
(defn compiled-select-first
"Version of select-first that takes in a selector pre-compiled with comp-paths"
@ -55,19 +56,19 @@
(defn select-first
"Returns first element found. Not any more efficient than select, just a convenience"
[selector structure]
(compiled-select-first (comp-unoptimal selector) structure))
(compiled-select-first (i/comp-unoptimal selector) structure))
;; Transformfunctions
(def ^{:doc "Version of transform that takes in a selector pre-compiled with comp-paths"}
compiled-transform compiled-transform*)
compiled-transform i/compiled-transform*)
(defn transform
"Navigates to each value specified by the selector and replaces it by the result of running
the transform-fn on it"
[selector transform-fn structure]
(compiled-transform (comp-unoptimal selector) transform-fn structure))
(compiled-transform (i/comp-unoptimal selector) transform-fn structure))
(defn compiled-setval
"Version of setval that takes in a selector pre-compiled with comp-paths"
@ -77,25 +78,25 @@
(defn setval
"Navigates to each value specified by the selector and replaces it by val"
[selector val structure]
(compiled-setval (comp-unoptimal selector) val structure))
(compiled-setval (i/comp-unoptimal selector) val structure))
(defn compiled-replace-in
"Version of replace-in that takes in a selector pre-compiled with comp-paths"
[selector transform-fn structure & {:keys [merge-fn] :or {merge-fn concat}}]
(let [state (mutable-cell nil)]
(let [state (i/mutable-cell nil)]
[(compiled-transform selector
(fn [e]
(let [res (transform-fn e)]
(if res
(let [[ret user-ret] res]
(->> user-ret
(merge-fn (get-cell state))
(set-cell! state))
(merge-fn (i/get-cell state))
(i/set-cell! state))
ret)
e
)))
structure)
(get-cell state)]
(i/get-cell state)]
))
(defn replace-in
@ -105,38 +106,35 @@
in the final return. replace-in is useful for situations where you need to know the specific values
of what was transformd in the data structure."
[selector transform-fn structure & {:keys [merge-fn] :or {merge-fn concat}}]
(compiled-replace-in (comp-unoptimal selector) transform-fn structure :merge-fn merge-fn))
(compiled-replace-in (i/comp-unoptimal selector) transform-fn structure :merge-fn merge-fn))
;; Built-in pathing and context operations
(def ALL (->AllStructurePath))
(def ALL (i/->AllStructurePath))
(def VAL (->ValCollect))
(def VAL (i/->ValCollect))
(def LAST (->PosStructurePath last set-last))
(def LAST (i/->PosStructurePath last i/set-last))
(def FIRST (->PosStructurePath first set-first))
(def FIRST (i/->PosStructurePath first i/set-first))
(defn srange-dynamic [start-fn end-fn] (->SRangePath start-fn end-fn))
(defn srange-dynamic [start-fn end-fn] (i/->SRangePath start-fn end-fn))
(defn srange [start end] (srange-dynamic (fn [_] start) (fn [_] end)))
(def START (srange 0 0))
(def BEGINNING (srange 0 0))
(def END (srange-dynamic count count))
(defn walker [afn] (->WalkerStructurePath afn))
(defn walker [afn] (i/->WalkerStructurePath afn))
(defn codewalker [afn] (->CodeWalkerStructurePath afn))
(defn codewalker [afn] (i/->CodeWalkerStructurePath afn))
(defn filterer [& path] (->FilterStructurePath (comp-paths* path)))
(defn filterer [& path] (i/->FilterStructurePath (comp-paths* path)))
(defn keypath [akey] (->KeyPath akey))
(defn keypath [akey] (i/->KeyPath akey))
(defn view [afn] (->ViewPath afn))
(defmacro viewfn [& args]
`(view (fn ~@args)))
(defn view [afn] (i/->ViewPath afn))
(defn selected?
"Filters the current value based on whether a selector finds anything.
@ -150,7 +148,7 @@
empty?
not))))
(extend-type clojure.lang.Keyword
(extend-type #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword)
StructurePath
(select* [kw structure next-fn]
(next-fn (get structure kw)))
@ -158,25 +156,25 @@
(assoc structure kw (next-fn (get structure kw)))
))
(extend-type clojure.lang.AFn
(extend-type #?(:clj clojure.lang.AFn :cljs js/Function)
StructurePath
(select* [afn structure next-fn]
(filter-select afn structure next-fn))
(i/filter-select afn structure next-fn))
(transform* [afn structure next-fn]
(filter-transform afn structure next-fn)))
(i/filter-transform afn structure next-fn)))
(extend-protocol StructurePath
clojure.lang.PersistentHashSet
(extend-type #?(:clj clojure.lang.PersistentHashSet :cljs cljs.core/PersistentHashSet)
StructurePath
(select* [aset structure next-fn]
(filter-select aset structure next-fn))
(i/filter-select aset structure next-fn))
(transform* [aset structure next-fn]
(filter-transform aset structure next-fn)))
(i/filter-transform aset structure next-fn)))
(defn collect [& selector]
(->SelectCollector select (comp-paths* selector)))
(i/->SelectCollector select (comp-paths* selector)))
(defn collect-one [& selector]
(->SelectCollector select-one (comp-paths* selector)))
(i/->SelectCollector select-one (comp-paths* selector)))
(defn putval
"Adds an external value to the collected vals. Useful when additional arguments
@ -186,7 +184,7 @@
e.g., incrementing val at path [:a :b] by 3:
(transform [:a :b (putval 3)] + some-map)"
[val]
(->PutValCollector val))
(i/->PutValCollector val))
(defn cond-path
"Takes in alternating cond-path selector cond-path selector...
@ -199,7 +197,7 @@
(partition 2)
(map (fn [[c p]] [(comp-paths* c) (comp-paths* p)]))
doall
->ConditionalPath
i/->ConditionalPath
))
(defn if-path
@ -212,4 +210,4 @@
"A path that branches on multiple paths. For updates,
applies updates to the paths in order."
[& paths]
(->MultiPath (->> paths (map comp-paths*) doall)))
(i/->MultiPath (->> paths (map comp-paths*) doall)))

260
src/clj/com/rpl/specter/impl.clj → src/com/rpl/specter/impl.cljc
View file

@ -1,14 +1,38 @@
(ns com.rpl.specter.impl
(:use [com.rpl.specter protocols])
(:require [clojure.walk :as walk]
[clojure.core.reducers :as r])
(:use [com.rpl.specter.protocols :only
[comp-paths*
select* transform* collect-val select-full* transform-full*]])
(:require [com.rpl.specter.protocols :as p]
[clojure.walk :as walk]
[clojure.core.reducers :as r]
[clojure.string :as s])
)
#?(
:clj
(defmacro field [obj quoted-field]
`(. ~obj ~(second quoted-field)))
:cljs
(defn field [obj field]
(aget obj (s/replace (str field) "-" "_")))
)
#?(
:clj
(do
(defmacro throw* [etype & args]
`(throw (new ~etype (pr-str ~@args))))
(defmacro throw-illegal [& args]
`(throw* IllegalArgumentException ~@args))
`(throw* IllegalArgumentException ~@args)))
:cljs
(defn throw-illegal [& args]
(throw (js/Error. (apply str args)))
)
)
(defn benchmark [iters afn]
(time
@ -47,6 +71,11 @@
(defprotocol CoerceTransformFunctions
(coerce-path [this]))
(defn- seq-contains? [aseq val]
(->> aseq
(filter (partial = val))
empty?
not))
(defn no-prot-error-str [obj]
(str "Protocol implementation cannot be found for object.
@ -55,15 +84,69 @@
optimized performance. Instead, you should extend the protocols via an
explicit extend-protocol call. \n" obj))
#?(
:clj
(defn find-protocol-impl! [prot obj]
(let [ret (find-protocol-impl prot obj)]
(if (= ret obj)
(throw-illegal (no-prot-error-str obj))
ret
)))
)
#?(
:clj
(defmacro obj-extends? [quoted-prot-sym obj]
`(->> ~obj (find-protocol-impl ~(second quoted-prot-sym)) nil? not))
:cljs
(defn obj-extends? [prot-sym obj]
(if (nil? obj)
(= prot-sym `p/StructurePath)
;; this requires that prot-sym be fully qualified
(let [props (->> obj type .-prototype (.getOwnPropertyNames js/Object) seq)
ns (namespace prot-sym)
n (name prot-sym)
lookup (str (s/replace ns "." "$") "$" n "$")]
(seq-contains? props lookup)
)))
)
#?(:clj
(do
(defn structure-path-impl [this]
(if (fn? this)
;;TODO: this isn't kosher, it uses knowledge of internals of protocols
(-> p/StructurePath :impls (get clojure.lang.AFn))
(find-protocol-impl! p/StructurePath this)))
(defn collector-impl [this]
(find-protocol-impl! p/Collector this))
(defn structure-vals-path-impl [this]
(find-protocol-impl! p/StructureValsPath this))
))
#?(:cljs
(do
(defn structure-path-impl [_]
{:select* (fn [this structure next-fn] (select* this structure next-fn))
:transform* (fn [this structure next-fn] (transform* this structure next-fn))
})
(defn collector-impl [_]
{:collect-val (fn [this structure] (collect-val this structure))
})
(defn structure-vals-path-impl [_]
{:select-full* (fn [this structure next-fn] (select-full* this structure next-fn))
:transform-full* (fn [this structure next-fn] (transform-full* this structure next-fn))
})
))
(defn coerce-structure-vals-path [this]
(let [pimpl (find-protocol-impl! StructureValsPath this)
(let [pimpl (structure-vals-path-impl this)
selector (:select-full* pimpl)
transformer (:transform-full* pimpl)]
(->TransformFunctions
@ -76,7 +159,7 @@
(defn coerce-collector [this]
(let [cfn (->> this
(find-protocol-impl! Collector)
collector-impl
:collect-val
)
afn (fn [vals structure next-fn]
@ -85,12 +168,6 @@
(->TransformFunctions StructureValsPathExecutor afn afn)))
(defn structure-path-impl [this]
(if (fn? this)
;;TODO: this isn't kosher, it uses knowledge of internals of protocols
(-> StructurePath :impls (get clojure.lang.AFn))
(find-protocol-impl! StructurePath this)))
(defn coerce-structure-path [this]
(let [pimpl (structure-path-impl this)
selector (:select* pimpl)
@ -115,11 +192,8 @@
(transformer this structure (fn [structure] (next-fn vals structure))))
)))
(defn obj-extends? [prot obj]
(->> obj (find-protocol-impl prot) nil? not))
(defn structure-path? [obj]
(or (fn? obj) (obj-extends? StructurePath obj)))
(or (fn? obj) (obj-extends? `p/StructurePath obj)))
(extend-protocol CoerceTransformFunctions
nil ; needs its own path because it doesn't count as an Object
@ -130,30 +204,43 @@
(coerce-path [this]
this)
java.util.List
#?(:clj java.util.List :cljs cljs.core/PersistentVector)
(coerce-path [this]
(comp-paths* this))
Object
#?@(:cljs [
cljs.core/IndexedSeq
(coerce-path [this]
(coerce-path (vec this)))
cljs.core/EmptyList
(coerce-path [this]
(coerce-path (vec this)))
cljs.core/List
(coerce-path [this]
(coerce-path (vec this)))
])
#?(:clj Object :cljs js/Object)
(coerce-path [this]
(cond (structure-path? this) (coerce-structure-path this)
(obj-extends? Collector this) (coerce-collector this)
(obj-extends? StructureValsPath this) (coerce-structure-vals-path this)
(obj-extends? `p/Collector this) (coerce-collector this)
(obj-extends? `p/StructureValsPath this) (coerce-structure-vals-path this)
:else (throw-illegal (no-prot-error-str this))
)))
(defn extype [^TransformFunctions f]
(let [^ExecutorFunctions exs (.executors f)]
(.type exs)
(let [^ExecutorFunctions exs (field f 'executors)]
(field exs 'type)
))
(defn- combine-same-types [[^TransformFunctions f & _ :as all]]
(if (empty? all)
(coerce-path nil)
(let [^ExecutorFunctions exs (.executors f)
(let [^ExecutorFunctions exs (field f 'executors)
t (.type exs)
t (field exs 'type)
combiner
(if (= t :svalspath)
@ -171,16 +258,16 @@
(reduce (fn [^TransformFunctions curr ^TransformFunctions next]
(->TransformFunctions
exs
(combiner (.selector curr) (.selector next))
(combiner (.transformer curr) (.transformer next))
(combiner (field curr 'selector) (field next 'selector))
(combiner (field curr 'transformer) (field next 'transformer))
))
all))))
(defn coerce-structure-vals [^TransformFunctions tfns]
(if (= (extype tfns) :svalspath)
tfns
(let [selector (.selector tfns)
transformer (.transformer tfns)]
(let [selector (field tfns 'selector)
transformer (field tfns 'transformer)]
(->TransformFunctions
StructureValsPathExecutor
(fn [vals structure next-fn]
@ -189,14 +276,14 @@
(transformer structure (fn [structure] (next-fn vals structure))))
))))
(extend-protocol StructureValsPathComposer
(extend-protocol p/StructureValsPathComposer
nil
(comp-paths* [sp]
(coerce-path sp))
Object
#?(:clj Object :cljs js/Object)
(comp-paths* [sp]
(coerce-path sp))
java.util.List
#?(:clj java.util.List :cljs cljs.core/PersistentVector)
(comp-paths* [structure-paths]
(let [combined (->> structure-paths
(map coerce-path)
@ -212,8 +299,8 @@
(defn coerce-structure-vals-direct [this]
(cond (structure-path? this) (coerce-structure-path-direct this)
(obj-extends? Collector this) (coerce-collector this)
(obj-extends? StructureValsPath this) (coerce-structure-vals-path this)
(obj-extends? `p/Collector this) (coerce-collector this)
(obj-extends? `p/StructureValsPath this) (coerce-structure-vals-path this)
(instance? TransformFunctions this) (coerce-structure-vals this)
:else (throw-illegal (no-prot-error-str this))
))
@ -222,31 +309,32 @@
;;won't execute as fast. Useful for when select/transform are used without pre-compiled paths
;;(where cost of compiling dominates execution time)
(defn comp-unoptimal [sp]
(if (instance? java.util.List sp)
(if (instance? #?(:clj java.util.List :cljs cljs.core/PersistentVector) sp)
(->> sp
(map coerce-structure-vals-direct)
combine-same-types)
(coerce-path sp)))
;; cell implementation idea taken from prismatic schema library
(definterface PMutableCell
(get_cell ^Object [])
(set_cell [^Object x]))
(defprotocol PMutableCell
#?(:clj (get_cell [cell]))
(set_cell [cell x]))
(deftype MutableCell [^:volatile-mutable ^Object q]
(deftype MutableCell [^:volatile-mutable q]
PMutableCell
(get_cell [this] q)
#?(:clj (get_cell [cell] q))
(set_cell [this x] (set! q x)))
(defn mutable-cell ^PMutableCell
(defn mutable-cell
([] (mutable-cell nil))
([init] (MutableCell. init)))
(defn set-cell! [^PMutableCell cell val]
(.set_cell cell val))
(defn set-cell! [cell val]
(set_cell cell val))
(defn get-cell [^PMutableCell cell]
(.get_cell cell))
(defn get-cell [cell]
#?(:clj (get_cell cell) :cljs (field cell 'q))
)
(defn update-cell! [cell afn]
(let [ret (afn (get-cell cell))]
@ -267,12 +355,12 @@
(append (butlast l) v))
(extend-protocol SetExtremes
clojure.lang.PersistentVector
#?(:clj clojure.lang.PersistentVector :cljs cljs.core/PersistentVector)
(set-first [v val]
(assoc v 0 val))
(set-last [v val]
(assoc v (-> v count dec) val))
Object
#?(:clj Object :cljs js/Object)
(set-first [l val]
(set-first-list l val))
(set-last [l val]
@ -304,14 +392,14 @@
(defn compiled-select*
[^com.rpl.specter.impl.TransformFunctions tfns structure]
(let [^com.rpl.specter.impl.ExecutorFunctions ex (.executors tfns)]
((.select-executor ex) (.selector tfns) structure)
(let [^com.rpl.specter.impl.ExecutorFunctions ex (field tfns 'executors)]
((field ex 'select-executor) (field tfns 'selector) structure)
))
(defn compiled-transform*
[^com.rpl.specter.impl.TransformFunctions tfns transform-fn structure]
(let [^com.rpl.specter.impl.ExecutorFunctions ex (.executors tfns)]
((.transform-executor ex) (.transformer tfns) transform-fn structure)
(let [^com.rpl.specter.impl.ExecutorFunctions ex (field tfns 'executors)]
((field ex 'transform-executor) (field tfns 'transformer) transform-fn structure)
))
(defn selected?*
@ -355,7 +443,7 @@
(deftype AllStructurePath [])
(extend-protocol StructurePath
(extend-protocol p/StructurePath
AllStructurePath
(select* [this structure next-fn]
(into [] (r/mapcat next-fn structure)))
@ -369,50 +457,50 @@
(deftype ValCollect [])
(extend-protocol Collector
(extend-protocol p/Collector
ValCollect
(collect-val [this structure]
structure))
(deftype PosStructurePath [getter setter])
(extend-protocol StructurePath
(extend-protocol p/StructurePath
PosStructurePath
(select* [this structure next-fn]
(if-not (empty? structure)
(next-fn ((.getter this) structure))))
(next-fn ((field this 'getter) structure))))
(transform* [this structure next-fn]
(if (empty? structure)
structure
((.setter this) structure (next-fn ((.getter this) structure))))))
((field this 'setter) structure (next-fn ((field this 'getter) structure))))))
(deftype WalkerStructurePath [afn])
(extend-protocol StructurePath
(extend-protocol p/StructurePath
WalkerStructurePath
(select* [^WalkerStructurePath this structure next-fn]
(walk-select (.afn this) next-fn structure))
(walk-select (field this 'afn) next-fn structure))
(transform* [^WalkerStructurePath this structure next-fn]
(walk-until (.afn this) next-fn structure)))
(walk-until (field this 'afn) next-fn structure)))
(deftype CodeWalkerStructurePath [afn])
(extend-protocol StructurePath
(extend-protocol p/StructurePath
CodeWalkerStructurePath
(select* [^CodeWalkerStructurePath this structure next-fn]
(walk-select (.afn this) next-fn structure))
(walk-select (field this 'afn) next-fn structure))
(transform* [^CodeWalkerStructurePath this structure next-fn]
(codewalk-until (.afn this) next-fn structure)))
(codewalk-until (field this 'afn) next-fn structure)))
(deftype FilterStructurePath [path])
(extend-protocol StructurePath
(extend-protocol p/StructurePath
FilterStructurePath
(select* [^FilterStructurePath this structure next-fn]
(->> structure (filter #(selected?* (.path this) %)) doall next-fn))
(->> structure (filter #(selected?* (field this 'path) %)) doall next-fn))
(transform* [^FilterStructurePath this structure next-fn]
(let [[filtered ancestry] (filter+ancestry (.path this) structure)
(let [[filtered ancestry] (filter+ancestry (field this 'path) 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))]
@ -423,33 +511,33 @@
(deftype KeyPath [akey])
(extend-protocol StructurePath
(extend-protocol p/StructurePath
KeyPath
(select* [^KeyPath this structure next-fn]
(key-select (.akey this) structure next-fn))
(key-select (field this 'akey) structure next-fn))
(transform* [^KeyPath this structure next-fn]
(key-transform (.akey this) structure next-fn)
(key-transform (field this 'akey) structure next-fn)
))
(deftype SelectCollector [sel-fn selector])
(extend-protocol Collector
(extend-protocol p/Collector
SelectCollector
(collect-val [^SelectCollector this structure]
((.sel-fn this) (.selector this) structure)))
((field this 'sel-fn) (field this 'selector) structure)))
(deftype SRangePath [start-fn end-fn])
(extend-protocol StructurePath
(extend-protocol p/StructurePath
SRangePath
(select* [^SRangePath this structure next-fn]
(let [start ((.start-fn this) structure)
end ((.end-fn this) structure)]
(let [start ((field this 'start-fn) structure)
end ((field this 'end-fn) structure)]
(next-fn (-> structure vec (subvec start end)))
))
(transform* [^SRangePath this structure next-fn]
(let [start ((.start-fn this) structure)
end ((.end-fn this) structure)
(let [start ((field this 'start-fn) structure)
end ((field this 'end-fn) structure)
structurev (vec structure)
newpart (next-fn (-> structurev (subvec start end)))
res (concat (subvec structurev 0 start)
@ -462,24 +550,24 @@
(deftype ViewPath [view-fn])
(extend-protocol StructurePath
(extend-protocol p/StructurePath
ViewPath
(select* [^ViewPath this structure next-fn]
(->> structure ((.view-fn this)) next-fn))
(->> structure ((field this 'view-fn)) next-fn))
(transform* [^ViewPath this structure next-fn]
(->> structure ((.view-fn this)) next-fn)
(->> structure ((field this 'view-fn)) next-fn)
))
(deftype PutValCollector [val])
(extend-protocol Collector
(extend-protocol p/Collector
PutValCollector
(collect-val [^PutValCollector this structure]
(.val this)
(field this 'val)
))
(extend-protocol StructurePath
(extend-protocol p/StructurePath
nil
(select* [this structure next-fn]
(next-fn structure))
@ -501,25 +589,25 @@
))
;;TODO: test nothing matches case
(extend-protocol StructurePath
(extend-protocol p/StructurePath
ConditionalPath
(select* [this structure next-fn]
(if-let [selector (retrieve-selector (.cond-pairs this) structure)]
(if-let [selector (retrieve-selector (field this 'cond-pairs) structure)]
(->> (compiled-select* selector structure)
(mapcat next-fn)
doall)))
(transform* [this structure next-fn]
(if-let [selector (retrieve-selector (.cond-pairs this) structure)]
(if-let [selector (retrieve-selector (field this 'cond-pairs) structure)]
(compiled-transform* selector next-fn structure)
structure
)))
(deftype MultiPath [paths])
(extend-protocol StructurePath
(extend-protocol p/StructurePath
MultiPath
(select* [this structure next-fn]
(->> (.paths this)
(->> (field this 'paths)
(mapcat #(compiled-select* % structure))
(mapcat next-fn)
doall
@ -529,7 +617,7 @@
(fn [structure selector]
(compiled-transform* selector next-fn structure))
structure
(.paths this))
(field this 'paths))
))
(defn filter-select [afn structure next-fn]

0
src/clj/com/rpl/specter/protocols.clj → src/com/rpl/specter/protocols.cljc
View file

13
test/com/rpl/specter/cljs_test_helpers.clj Normal file
View file

@ -0,0 +1,13 @@
(ns com.rpl.specter.cljs-test-helpers)
;; it seems like gen/bind and gen/return are a monad (hence the names)
(defmacro for-all+ [bindings & body]
(let [parts (partition 2 bindings)
vars (vec (map first parts))
genned (reduce
(fn [curr [v code]]
`(cljs.test.check.generators/bind ~code (fn [~v] ~curr)))
`(cljs.test.check.generators/return ~vars)
(reverse parts))]
`(cljs.test.check.properties/for-all [~vars ~genned]
~@body )))

5
test/com/rpl/specter/cljs_test_runner.cljs Normal file
View file

@ -0,0 +1,5 @@
(ns com.rpl.specter.cljs-test-runner
(:require [cljs.test :as test :refer-macros [run-tests]]
[com.rpl.specter.core-test]))
(run-tests 'com.rpl.specter.core-test)

226
test/clj/com/rpl/specter/core_test.clj → test/com/rpl/specter/core_test.cljc
View file

@ -1,19 +1,32 @@
(ns com.rpl.specter.core-test
(:use [clojure.test]
[clojure.test.check.clojure-test]
[com.rpl specter]
[com.rpl.specter protocols]
[com.rpl.specter test-helpers])
(:require [clojure.test.check
[generators :as gen]
[properties :as prop]]
[clojure.test.check :as qc]))
#?(:cljs (:require-macros
[cljs.test :refer [is deftest]]
[cljs.test.check.cljs-test :refer [defspec]]
[com.rpl.specter.cljs-test-helpers :refer [for-all+]]))
(:use
#?(:clj [clojure.test :only [deftest is]])
#?(:clj [clojure.test.check.clojure-test :only [defspec]])
#?(:clj [com.rpl.specter.test-helpers :only [for-all+]])
[com.rpl.specter.protocols :only [comp-paths*]])
(:require #?@(:clj [[clojure.test.check.generators :as gen]
[clojure.test.check.properties :as prop]]
:cljs [[cljs.test.check :as tc]
[cljs.test.check.generators :as gen]
[cljs.test.check.properties :as prop :include-macros true]]
)
[com.rpl.specter :as s]))
;;TODO:
;; test walk, codewalk
;; test keypath
;; test comp-structure-paths
(defn limit-size [n {gen :gen}]
(gen/->Generator
(fn [rnd _size]
(gen rnd (if (< _size n) _size n)))))
(defn gen-map-with-keys [key-gen val-gen & keys]
(gen/bind (gen/map key-gen val-gen)
(fn [m]
@ -25,10 +38,10 @@
(defspec select-all-keyword-filter
(for-all+
[kw gen/keyword
v (gen/vector (max-size 5
v (gen/vector (limit-size 5
(gen-map-with-keys gen/keyword gen/int kw)))
pred (gen/elements [odd? even?])]
(= (select [ALL kw pred] v)
(= (s/select [s/ALL kw pred] v)
(->> v (map kw) (filter pred))
)))
@ -36,46 +49,46 @@
(for-all+
[v (gen/vector gen/int)
pred (gen/elements [odd? even?])
pos (gen/elements [[FIRST first] [LAST last]])]
(= (select-one [(filterer pred) (first pos)] v)
pos (gen/elements [[s/FIRST first] [s/LAST last]])]
(= (s/select-one [(s/filterer pred) (first pos)] v)
(->> v (filter pred) ((last pos)))
)))
(defspec select-all-on-map
(for-all+
[m (max-size 5 (gen/map gen/keyword gen/int))]
(= (select [ALL LAST] m)
[m (limit-size 5 (gen/map gen/keyword gen/int))]
(= (s/select [s/ALL s/LAST] m)
(for [[k v] m] v))
))
(deftest select-one-test
(is (thrown? Exception (select-one [ALL even?] [1 2 3 4])))
(is (= 1 (select-one [ALL odd?] [2 4 1 6])))
(is (thrown? #?(:clj Exception :cljs js/Error) (s/select-one [s/ALL even?] [1 2 3 4])))
(is (= 1 (s/select-one [s/ALL odd?] [2 4 1 6])))
)
(deftest select-first-test
(is (= 7 (select-first [(filterer odd?) ALL #(> % 4)] [3 4 2 3 7 5 9 8])))
(is (nil? (select-first [ALL even?] [1 3 5 9])))
(is (= 7 (s/select-first [(s/filterer odd?) s/ALL #(> % 4)] [3 4 2 3 7 5 9 8])))
(is (nil? (s/select-first [s/ALL even?] [1 3 5 9])))
)
(defspec transform-all-on-map
(for-all+
[m (max-size 5 (gen/map gen/keyword gen/int))]
(= (transform [ALL LAST] inc m)
[m (limit-size 5 (gen/map gen/keyword gen/int))]
(= (s/transform [s/ALL s/LAST] inc m)
(into {} (for [[k v] m] [k (inc v)]))
)))
(defspec transform-all
(for-all+
[v (gen/vector gen/int)]
(let [v2 (transform [ALL] inc v)]
(let [v2 (s/transform [s/ALL] inc v)]
(and (vector? v2) (= v2 (map inc v)))
)))
(defspec transform-all-list
(for-all+
[v (gen/list gen/int)]
(let [v2 (transform [ALL] inc v)]
(let [v2 (s/transform [s/ALL] inc v)]
(and (seq? v2) (= v2 (map inc v)))
)))
@ -84,7 +97,7 @@
[v (gen/vector gen/int)
pred (gen/elements [odd? even?])
action (gen/elements [inc dec])]
(let [v2 (transform [ALL pred] action v)]
(let [v2 (s/transform [s/ALL pred] action v)]
(= v2 (map (fn [v] (if (pred v) (action v) v)) v))
)))
@ -92,7 +105,7 @@
(for-all+
[v (gen/not-empty (gen/vector gen/int))
pred (gen/elements [inc dec])]
(let [v2 (transform [LAST] pred v)]
(let [v2 (s/transform [s/LAST] pred v)]
(= v2 (concat (butlast v) [(pred (last v))]))
)))
@ -100,7 +113,7 @@
(for-all+
[v (gen/not-empty (gen/vector gen/int))
pred (gen/elements [inc dec])]
(let [v2 (transform [FIRST] pred v)]
(let [v2 (s/transform [s/FIRST] pred v)]
(= v2 (concat [(pred (first v))] (rest v) ))
)))
@ -109,8 +122,8 @@
[v (gen/vector gen/int)
pred (gen/elements [even? odd?])
updater (gen/elements [inc dec])]
(let [v2 (transform [(filterer pred) ALL] updater v)
v3 (transform [ALL pred] updater v)]
(let [v2 (s/transform [(s/filterer pred) s/ALL] updater v)
v3 (s/transform [s/ALL pred] updater v)]
(= v2 v3))
))
@ -118,9 +131,9 @@
(for-all+
[kw1 gen/keyword
kw2 gen/keyword
m (max-size 10 (gen-map-with-keys gen/keyword gen/int kw1 kw2))
m (limit-size 10 (gen-map-with-keys gen/keyword gen/int kw1 kw2))
pred (gen/elements [odd? even?])]
(= (transform [(collect-one kw2) kw1 pred] + m)
(= (s/transform [(s/collect-one kw2) kw1 pred] + m)
(if (pred (kw1 m))
(assoc m kw1 (+ (kw1 m) (kw2 m)))
m
@ -137,7 +150,7 @@
(for-all+
[pred (gen/elements [odd? even?])
v (gen/such-that #(some pred %) (gen/vector gen/int))]
(let [v2 (transform [(filterer pred) LAST] inc v)
(let [v2 (s/transform [(s/filterer pred) s/LAST] inc v)
differing-elems (differing-elements v v2)]
(and (= (count v2) (count v))
(= (count differing-elems) 1)
@ -147,15 +160,15 @@
;; max sizes prevent too much data from being generated and keeps test from taking forever
(defspec transform-keyword
(for-all+
[k1 (max-size 3 gen/keyword)
k2 (max-size 3 gen/keyword)
m1 (max-size 5
[k1 (limit-size 3 gen/keyword)
k2 (limit-size 3 gen/keyword)
m1 (limit-size 5
(gen-map-with-keys
gen/keyword
(gen-map-with-keys gen/keyword gen/int k2)
k1))
pred (gen/elements [inc dec])]
(let [m2 (transform [k1 k2] pred m1)]
(let [m2 (s/transform [k1 k2] pred m1)]
(= (assoc-in m1 [k1 k2] nil) (assoc-in m2 [k1 k2] nil))
(= (pred (get-in m1 [k1 k2])) (get-in m2 [k1 k2]))
)))
@ -169,7 +182,7 @@
(map (fn [v] [v v]))
(apply concat))
user-ret (if (empty? user-ret) nil user-ret)]
(= (replace-in [ALL even?] (fn [v] [(inc v) [v v]]) v)
(= (s/replace-in [s/ALL even?] (fn [v] [(inc v) [v v]]) v)
[res user-ret]
))))
@ -179,8 +192,8 @@
(let [res (->> v (map (fn [v] (if (even? v) (inc v) v))))
last-even (->> v (filter even?) last)
user-ret (if last-even {:a last-even})]
(= (replace-in [ALL even?] (fn [v] [(inc v) v]) v :merge-fn (fn [curr new]
(assoc curr :a new)))
(= (s/replace-in [s/ALL even?] (fn [v] [(inc v) v]) v :merge-fn (fn [curr new]
(assoc curr :a new)))
[res user-ret]
))))
@ -188,8 +201,8 @@
(for-all+
[v (gen/vector gen/int)
v2 (gen/vector gen/int)]
(let [b (setval START v2 v)
e (setval END v2 v)]
(let [b (s/setval s/BEGINNING v2 v)
e (s/setval s/END v2 v)]
(and (= b (concat v2 v))
(= e (concat v v2)))
)))
@ -204,30 +217,29 @@
predcount (fn [pred v] (->> v (filter pred) count))
even-count (partial predcount even?)
odd-count (partial predcount odd?)
b (transform (srange b e) (fn [r] (filter odd? r)) v)]
b (s/transform (s/srange b e) (fn [r] (filter odd? r)) v)]
(and (= (odd-count v) (odd-count b))
(= (+ (even-count b) (even-count sv))
(even-count v)))
)))
(deftest structure-path-directly-test
(is (= 3 (select-one :b {:a 1 :b 3})))
(is (= 5 (select-one (comp-paths :a :b) {:a {:b 5}})))
(is (= 3 (s/select-one :b {:a 1 :b 3})))
(is (= 5 (s/select-one (s/comp-paths :a :b) {:a {:b 5}})))
)
(defspec view-test
(for-all+
[i gen/int
afn (gen/elements [inc dec])]
(= (first (select (view afn) i))
(first (select (viewfn [i] (afn i)) i))
(= (first (s/select (s/view afn) i))
(afn i)
(transform (view afn) identity i)
(s/transform (s/view afn) identity i)
)))
(deftest selected?-test
(is (= [[1 3 5] [2 :a] [7 11 4 2 :a] [10 1 :a] []]
(setval [ALL (selected? ALL even?) END]
(s/setval [s/ALL (s/selected? s/ALL even?) s/END]
[:a]
[[1 3 5] [2] [7 11 4 2] [10 1] []]
))))
@ -236,19 +248,19 @@
(for-all+
[i gen/int
afn (gen/elements [inc dec])]
(and (= [i] (select nil i))
(= (afn i) (transform nil afn i)))))
(and (= [i] (s/select nil i))
(= (afn i) (s/transform nil afn i)))))
(deftest nil-comp-test
(is (= [5] (select (comp-paths* nil) 5))))
(is (= [5] (s/select (comp-paths* nil) 5))))
(defspec putval-test
(for-all+
[kw gen/keyword
m (max-size 10 (gen-map-with-keys gen/keyword gen/int kw))
m (limit-size 10 (gen-map-with-keys gen/keyword gen/int kw))
c gen/int]
(= (transform [(putval c) kw] + m)
(transform [kw (putval c)] + m)
(= (s/transform [(s/putval c) kw] + m)
(s/transform [kw (s/putval c)] + m)
(assoc m kw (+ c (get m kw)))
)))
@ -256,79 +268,79 @@
(for-all+
[v (gen/vector gen/int)]
(= [v]
(select [] v)
(select nil v)
(select (comp-paths) v)
(select (comp-paths nil) v)
(select [nil nil nil] v)
(s/select [] v)
(s/select nil v)
(s/select (s/comp-paths) v)
(s/select (s/comp-paths nil) v)
(s/select [nil nil nil] v)
)))
(defspec empty-selector-transform-test
(for-all+
[kw gen/keyword
m (max-size 10 (gen-map-with-keys gen/keyword gen/int kw))]
m (limit-size 10 (gen-map-with-keys gen/keyword gen/int kw))]
(and (= m
(transform nil identity m)
(transform [] identity m)
(transform (comp-paths []) identity m)
(transform (comp-paths nil nil) identity m)
(s/transform nil identity m)
(s/transform [] identity m)
(s/transform (s/comp-paths []) identity m)
(s/transform (s/comp-paths nil nil) identity m)
)
(= (transform kw inc m)
(transform [nil kw] inc m)
(transform (comp-paths kw nil) inc m)
(transform (comp-paths nil kw nil) inc m)
(= (s/transform kw inc m)
(s/transform [nil kw] inc m)
(s/transform (s/comp-paths kw nil) inc m)
(s/transform (s/comp-paths nil kw nil) inc m)
))))
(deftest compose-empty-comp-path-test
(let [m {:a 1}]
(is (= [1]
(select [:a (comp-paths)] m)
(select [(comp-paths) :a] m)
(s/select [:a (s/comp-paths)] m)
(s/select [(s/comp-paths) :a] m)
))))
(defspec mixed-selector-test
(for-all+
[k1 (max-size 3 gen/keyword)
k2 (max-size 3 gen/keyword)
m (max-size 5
[k1 (limit-size 3 gen/keyword)
k2 (limit-size 3 gen/keyword)
m (limit-size 5
(gen-map-with-keys
gen/keyword
(gen-map-with-keys gen/keyword gen/int k2)
k1))]
(= [(-> m k1 k2)]
(select [k1 (comp-paths k2)] m)
(select [(comp-paths k1) k2] m)
(select [(comp-paths k1 k2) nil] m)
(select [(comp-paths) k1 k2] m)
(select [k1 (comp-paths) k2] m)
(s/select [k1 (s/comp-paths k2)] m)
(s/select [(s/comp-paths k1) k2] m)
(s/select [(s/comp-paths k1 k2) nil] m)
(s/select [(s/comp-paths) k1 k2] m)
(s/select [k1 (s/comp-paths) k2] m)
)))
(deftest cond-path-test
(is (= [4 2 6 8 10]
(select [ALL (cond-path even? [(view inc) (view inc)]
#(= 3 %) (view dec))]
(s/select [s/ALL (s/cond-path even? [(s/view inc) (s/view inc)]
#(= 3 %) (s/view dec))]
[1 2 3 4 5 6 7 8])))
(is (empty? (select (if-path odd? (view inc)) 2)))
(is (empty? (s/select (s/if-path odd? (s/view inc)) 2)))
(is (= [6 2 10 6 14]
(transform [(putval 2)
ALL
(if-path odd? [(view inc) (view inc)] (view dec))]
(s/transform [(s/putval 2)
s/ALL
(s/if-path odd? [(s/view inc) (s/view inc)] (s/view dec))]
*
[1 2 3 4 5]
)))
(is (= 2
(transform [(putval 2)
(if-path odd? (view inc))]
(s/transform [(s/putval 2)
(s/if-path odd? (s/view inc))]
*
2)))
)
(defspec cond-path-selector-test
(for-all+
[k1 (max-size 3 gen/keyword)
k2 (max-size 3 gen/keyword)
k3 (max-size 3 gen/keyword)
m (max-size 5
[k1 (limit-size 3 gen/keyword)
k2 (limit-size 3 gen/keyword)
k3 (limit-size 3 gen/keyword)
m (limit-size 5
(gen-map-with-keys
gen/keyword
gen/int
@ -340,34 +352,34 @@
(let [v1 (get m k1)
k (if (pred v1) k2 k3)]
(and
(= (transform (if-path [k1 pred] k2 k3) inc m)
(transform k inc m))
(= (select (if-path [k1 pred] k2 k3) m)
(select k m))
(= (s/transform (s/if-path [k1 pred] k2 k3) inc m)
(s/transform k inc m))
(= (s/select (s/if-path [k1 pred] k2 k3) m)
(s/select k m))
))))
(defspec multi-path-test
(for-all+
[k1 (max-size 3 gen/keyword)
k2 (max-size 3 gen/keyword)
m (max-size 5
[k1 (limit-size 3 gen/keyword)
k2 (limit-size 3 gen/keyword)
m (limit-size 5
(gen-map-with-keys
gen/keyword
gen/int
k1
k2))
]
(= (transform (multi-path k1 k2) inc m)
(= (s/transform (s/multi-path k1 k2) inc m)
(->> m
(transform k1 inc)
(transform k2 inc)))
(s/transform k1 inc)
(s/transform k2 inc)))
))
(deftest empty-pos-transform
(is (empty? (select FIRST [])))
(is (empty? (select LAST [])))
(is (= [] (transform FIRST inc [])))
(is (= [] (transform LAST inc [])))
(is (empty? (s/select s/FIRST [])))
(is (empty? (s/select s/LAST [])))
(is (= [] (s/transform s/FIRST inc [])))
(is (= [] (s/transform s/LAST inc [])))
)
(defspec set-filter-test
@ -376,10 +388,10 @@
k2 (gen/such-that #(not= k1 %) gen/keyword)
k3 (gen/such-that (complement #{k1 k2}) gen/keyword)
v (gen/vector (gen/elements [k1 k2 k3]))]
(= (filter #{k1 k2} v) (select [ALL #{k1 k2}] v))
(= (filter #{k1 k2} v) (s/select [s/ALL #{k1 k2}] v))
))
(deftest nil-select-one-test
(is (= nil (select-one! ALL [nil])))
(is (thrown? Exception (select-one! ALL [])))
)
(is (= nil (s/select-one! s/ALL [nil])))
(is (thrown? #?(:clj Exception :cljs js/Error) (s/select-one! s/ALL [])))
)

19
test/clj/com/rpl/specter/test_helpers.clj → test/com/rpl/specter/test_helpers.clj
View file

@ -1,11 +1,8 @@
(ns com.rpl.specter.test-helpers
(:use [clojure.test]
[clojure.test.check.clojure-test])
(:require [clojure.test.check
[generators :as gen]
[properties :as prop]]
[clojure.test.check :as qc]
[clojure.pprint :as pp]))
[properties :as prop]]))
;; it seems like gen/bind and gen/return are a monad (hence the names)
(defmacro for-all+ [bindings & body]
@ -18,15 +15,3 @@
(reverse parts))]
`(prop/for-all [~vars ~genned]
~@body )))
(defn max-size [n {gen :gen}]
(gen/make-gen
(fn [rnd _size]
(gen rnd (if (< _size n) _size n)))))
(defn gen-tuple+ [& inputs]
(->> inputs
(map #(if (gen/generator? %) % (gen/return %)))
(apply gen/tuple)
))