diff --git a/.gitignore b/.gitignore index 0ef5d3f..49624ef 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ pom.xml.asc .lein-repl-history .lein-plugins/ .lein-failures +out/ diff --git a/DEVELOPER.md b/DEVELOPER.md new file mode 100644 index 0000000..f98bd5d --- /dev/null +++ b/DEVELOPER.md @@ -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) +``` diff --git a/project.clj b/project.clj index 13c1e4d..1b5ef14 100644 --- a/project.clj +++ b/project.clj @@ -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 + }} + } + }) diff --git a/repl.clj b/repl.clj new file mode 100644 index 0000000..278074a --- /dev/null +++ b/repl.clj @@ -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") diff --git a/src/clj/com/rpl/specter.clj b/src/com/rpl/specter.cljc similarity index 70% rename from src/clj/com/rpl/specter.clj rename to src/com/rpl/specter.cljc index 8056e7f..2bac341 100644 --- a/src/clj/com/rpl/specter.clj +++ b/src/com/rpl/specter.cljc @@ -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))) diff --git a/src/clj/com/rpl/specter/impl.clj b/src/com/rpl/specter/impl.cljc similarity index 68% rename from src/clj/com/rpl/specter/impl.clj rename to src/com/rpl/specter/impl.cljc index 48e8994..364e1ee 100644 --- a/src/clj/com/rpl/specter/impl.clj +++ b/src/com/rpl/specter/impl.cljc @@ -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] diff --git a/src/clj/com/rpl/specter/protocols.clj b/src/com/rpl/specter/protocols.cljc similarity index 100% rename from src/clj/com/rpl/specter/protocols.clj rename to src/com/rpl/specter/protocols.cljc diff --git a/test/com/rpl/specter/cljs_test_helpers.clj b/test/com/rpl/specter/cljs_test_helpers.clj new file mode 100644 index 0000000..0176219 --- /dev/null +++ b/test/com/rpl/specter/cljs_test_helpers.clj @@ -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 ))) diff --git a/test/com/rpl/specter/cljs_test_runner.cljs b/test/com/rpl/specter/cljs_test_runner.cljs new file mode 100644 index 0000000..122b3f6 --- /dev/null +++ b/test/com/rpl/specter/cljs_test_runner.cljs @@ -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) diff --git a/test/clj/com/rpl/specter/core_test.clj b/test/com/rpl/specter/core_test.cljc similarity index 55% rename from test/clj/com/rpl/specter/core_test.clj rename to test/com/rpl/specter/core_test.cljc index e50920b..6589d1c 100644 --- a/test/clj/com/rpl/specter/core_test.clj +++ b/test/com/rpl/specter/core_test.cljc @@ -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 []))) - ) \ No newline at end of file + (is (= nil (s/select-one! s/ALL [nil]))) + (is (thrown? #?(:clj Exception :cljs js/Error) (s/select-one! s/ALL []))) + ) diff --git a/test/clj/com/rpl/specter/test_helpers.clj b/test/com/rpl/specter/test_helpers.clj similarity index 56% rename from test/clj/com/rpl/specter/test_helpers.clj rename to test/com/rpl/specter/test_helpers.clj index 2ee4ca7..e256026 100644 --- a/test/clj/com/rpl/specter/test_helpers.clj +++ b/test/com/rpl/specter/test_helpers.clj @@ -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) - ))