commit a1d1f236ab3ca62f492c09cee07b1c42a9ea4277 Author: Nathan Marz Date: Thu Feb 26 10:55:20 2015 -0500 initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0ef5d3f --- /dev/null +++ b/.gitignore @@ -0,0 +1,11 @@ +pom.xml +pom.xml.asc +*jar +/lib/ +/classes/ +/target/ +/checkouts/ +.lein-deps-sum +.lein-repl-history +.lein-plugins/ +.lein-failures diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..e06d208 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ +Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "{}" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright {yyyy} {name of copyright owner} + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + diff --git a/README.md b/README.md new file mode 100644 index 0000000..d523db5 --- /dev/null +++ b/README.md @@ -0,0 +1,41 @@ +# clojung +Deep introspection and transformation of data + +# About + +Clojung is a library for concisely querying and updating nested data structures. One way to think of it is "get-in" and "assoc-in" on steroids. It is similar to the concept of a "lens" in functional programming, though it has some important extensions. + +# How to use + +;; explain basic usage +;; explain structurepath interface +;; explain how structurepath can be extended (I've done it for working with directed acyclic graphs) + - show implementations for ALL, VAL, LAST, etc. +;; explain precompiling to make things far faster + +From a sequence of maps get all the even values for :a keys: +```clojure +>>> (select [ALL :a even?] [{:a 1} {:a 2} {:a 4} {:a 3}]) +[2 4] +``` + +In a sequence of maps increment all the even values for :a keys: +>>> (update [ALL :a even?] inc [{:a 1} {:a 2} {:a 4} {:a 3}]) +[{:a 1} {:a 3} {:a 5} {:a 3}] + + +Increment the last odd number in a sequence: +```clojure +>>> (update [(filterer odd?) LAST] inc [2 1 6 9 4 8]) +[2 1 6 10 4 8] +``` + +For all maps in a sequence, add the value of :b key to the value of :a key, but only if the :a value is even: +```clojure +>>> (update [ALL (val-selector-one :b) :a even?] + [{:a 1 :b 3} {:a 2 :b -10} {:a 4 :b 10} {:a 3}]) +[{:b 3, :a 1} {:b -10, :a -8} {:b 10, :a 14} {:a 3}] +``` + +# Future work +;; parallelize the transformations +;; any connection to transducers? diff --git a/project.clj b/project.clj new file mode 100644 index 0000000..cb148dc --- /dev/null +++ b/project.clj @@ -0,0 +1,9 @@ +(defproject com.rpl/specter "0.0.2" + :dependencies [[org.clojure/clojure "1.6.0"] + ] + :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"] + :profiles {:dev {:dependencies + [[org.clojure/test.check "0.5.9"]]} + }) diff --git a/src/clj/com/rpl/specter.clj b/src/clj/com/rpl/specter.clj new file mode 100644 index 0000000..a4ed2ea --- /dev/null +++ b/src/clj/com/rpl/specter.clj @@ -0,0 +1,117 @@ +(ns com.rpl.specter + (:use [com.rpl.specter impl protocols]) + ) + +;;TODO: can make usage of vals much more efficient by determining during composition how many vals +;;there are going to be. this should make it much easier to allocate space for vals without doing concats +;;all over the place. The apply to the vals + structure can also be avoided since the number of vals is known +;;beforehand +(defn comp-structure-paths [& structure-paths] + (comp-structure-paths* (vec structure-paths))) + +;; Selector functions + +(defn select [selector structure] + (let [sp (comp-structure-paths* selector)] + (select* sp + [] + structure + (fn [vals structure] + (if-not (empty? vals) [(conj vals structure)] [structure]))) + )) + +(defn select-one + "Like select, but returns either one element or nil. Throws exception if multiple elements returned" + [selector structure] + (let [res (select selector structure)] + (when (> (count res) 1) + (throw-illegal "More than one element found for params: " selector structure)) + (first res) + )) + +(defn select-one! + "Returns exactly one element, throws exception if zero or multiple elements returned" + [selector structure] + (let [res (select-one selector structure)] + (when (nil? res) (throw-illegal "No elements found for params: " selector structure)) + res + )) + +(defn select-first + "Returns first element returned. Not any more efficient than select, just a convenience" + [selector structure] + (first (select selector structure))) + +;; Update functions + +(defn update [selector update-fn structure] + (let [selector (comp-structure-paths* selector)] + (update* selector + [] + structure + (fn [vals structure] + (if (empty? vals) + (update-fn structure) + (apply update-fn (conj vals structure))) + )))) + + +(defn replace-in [selector update-fn structure & {:keys [merge-fn] :or {merge-fn concat}}] + "Returns [new structure [ ...]" + (let [state (mutable-cell nil)] + [(update selector + (fn [e] + (let [res (update-fn e)] + (if res + (let [[ret user-ret] res] + (->> user-ret + (merge-fn (get-cell state)) + (set-cell! state)) + ret) + e + ))) + structure) + (get-cell state)] + )) + +;; Built-in pathing and context operations + +(def ALL (->AllStructurePath)) + +(def VAL (->ValStructurePath)) + +(def LAST (->LastStructurePath)) + +(def FIRST (->FirstStructurePath)) + +(defn walker [afn] (->WalkerStructurePath afn)) + +(defn codewalker [afn] (->CodeWalkerStructurePath afn)) + +(defn filterer [afn] (->FilterStructurePath afn)) + +(defn keypath [akey] (->KeyPath akey)) + +(extend-type clojure.lang.Keyword + StructurePath + (select* [kw vals structure next-fn] + (key-select kw vals structure next-fn)) + (update* [kw vals structure next-fn] + (key-update kw vals structure next-fn) + )) + +(extend-type clojure.lang.AFn + StructurePath + (select* [afn vals structure next-fn] + (if (afn structure) + (next-fn vals structure))) + (update* [afn vals structure next-fn] + (if (afn structure) + (next-fn vals structure) + structure))) + +(defn val-selector [& selector] + (->SelectorValsPath select (comp-structure-paths* selector))) + +(defn val-selector-one [& selector] + (->SelectorValsPath select-one (comp-structure-paths* selector))) diff --git a/src/clj/com/rpl/specter/impl.clj b/src/clj/com/rpl/specter/impl.clj new file mode 100644 index 0000000..df02295 --- /dev/null +++ b/src/clj/com/rpl/specter/impl.clj @@ -0,0 +1,228 @@ +(ns com.rpl.specter.impl + (:use [com.rpl.specter protocols]) + (:require [clojure.walk :as walk] + [clojure.core.reducers :as r]) + ) + +(extend-protocol StructurePathComposer + Object + (comp-structure-paths* [sp] + sp) + java.util.List + (comp-structure-paths* [structure-paths] + (reduce (fn [sp-curr sp] + (reify StructurePath + (select* [this vals structure next-fn] + (select* sp vals structure + (fn [vals-next structure-next] + (select* sp-curr vals-next structure-next next-fn))) + ) + (update* [this vals structure next-fn] + (update* sp vals structure + (fn [vals-next structure-next] + (update* sp-curr vals-next structure-next next-fn)))) + )) + (-> structure-paths flatten reverse)) + )) + +;; cell implementation idea taken from prismatic schema library +(definterface PMutableCell + (get_cell ^Object []) + (set_cell [^Object x])) + +(deftype MutableCell [^:volatile-mutable ^Object q] + PMutableCell + (get_cell [this] q) + (set_cell [this x] (set! q x))) + +(defn mutable-cell ^PMutableCell + ([] (mutable-cell nil)) + ([init] (MutableCell. init))) + +(defn set-cell! [^PMutableCell cell val] + (.set_cell cell val)) + +(defn get-cell [^PMutableCell cell] + (.get_cell cell)) + +(defmacro throw* [etype & args] + `(throw (new ~etype (pr-str ~@args)))) + +(defmacro throw-illegal [& args] + `(throw* IllegalArgumentException ~@args)) + +(defn update-cell! [cell afn] + (let [ret (afn (get-cell cell))] + (set-cell! cell ret) + ret)) + +(defn- append [coll elem] + (-> coll vec (conj elem))) + +(defprotocol SetExtremes + (set-first [s val]) + (set-last [s val])) + +(defn- set-first-list [l v] + (cons v (rest l))) + +(defn- set-last-list [l v] + (append (butlast l) v)) + +(extend-protocol SetExtremes + clojure.lang.PersistentVector + (set-first [v val] + (assoc v 0 val)) + (set-last [v val] + (assoc v (-> v count dec) val)) + Object + (set-first [l val] + (set-first-list l val)) + (set-last [l val] + (set-last-list l val) + )) + +(defn- walk-until [pred on-match-fn structure] + (if (pred structure) + (on-match-fn structure) + (walk/walk (partial walk-until pred on-match-fn) identity structure) + )) + +(defn- fn-invocation? [f] + (or (instance? clojure.lang.Cons f) + (instance? clojure.lang.LazySeq f) + (list? f))) + +(defn- codewalk-until [pred on-match-fn structure] + (if (pred structure) + (on-match-fn structure) + (let [ret (walk/walk (partial codewalk-until pred on-match-fn) identity structure)] + (if (and (fn-invocation? structure) (fn-invocation? ret)) + (with-meta ret (meta structure)) + ret + )))) + +(defn- conj-all! [atrans elems] + (doseq [e elems] + (conj! atrans e))) + +;; returns vector of all results +(defn- walk-select [pred continue-fn structure] + (let [ret (transient []) + walker (fn this [structure] + (if (pred structure) + (conj-all! ret (continue-fn structure)) + (walk/walk this identity structure)) + )] + (walker structure) + (persistent! ret) + )) + +(defn- filter+ancestry [afn aseq] + (let [aseq (vec aseq) + seqret (transient []) + ;; transient maps are broken, e.g.: + ;; (def m (transient {})) + ;; (doseq [i (range 9)] (assoc! m i i)) + ;; (persistent! m) --> only has 8 elements! + mapret (mutable-cell {})] + (doseq [i (range (count aseq)) + :let [e (get aseq i)]] + (when (afn e) + (conj! seqret e) + (set-cell! mapret (assoc (get-cell mapret) (-> seqret count dec) i)) + )) + [(persistent! seqret) (get-cell mapret)] + )) + +(defn key-select [akey vals structure next-fn] + (next-fn vals (get structure akey))) + +(defn key-update [akey vals structure next-fn] + (assoc structure akey (next-fn vals (get structure akey)) + )) + +(deftype AllStructurePath [] + StructurePath + (select* [this vals structure next-fn] + (into [] (r/mapcat (partial next-fn vals) structure))) + (update* [this vals structure next-fn] + (let [ret (r/map (partial next-fn vals) structure)] + (cond (vector? structure) + (into [] ret) + + (map? structure) + (into {} ret) + + :else + (into '() ret))) + )) + +(deftype ValStructurePath [] + StructurePath + (select* [this vals structure next-fn] + (next-fn (conj vals structure) structure)) + (update* [this vals structure next-fn] + (next-fn (conj vals structure) structure))) + +(deftype LastStructurePath [] + StructurePath + (select* [this vals structure next-fn] + (next-fn vals (last structure))) + (update* [this vals structure next-fn] + (set-last structure (next-fn vals (last structure))))) + +(deftype FirstStructurePath [] + StructurePath + (select* [this vals structure next-fn] + (next-fn vals (first structure))) + (update* [this vals structure next-fn] + (set-first structure (next-fn vals (first structure))))) + +(deftype WalkerStructurePath [afn] + StructurePath + (select* [this vals structure next-fn] + (walk-select afn (partial next-fn vals) structure)) + (update* [this vals structure next-fn] + (walk-until afn (partial next-fn vals) structure))) + +(deftype CodeWalkerStructurePath [afn] + StructurePath + (select* [this vals structure next-fn] + (walk-select afn (partial next-fn vals) structure)) + (update* [this vals structure next-fn] + (codewalk-until afn (partial next-fn vals) structure))) + +(deftype FilterStructurePath [afn] + StructurePath + (select* [this vals structure next-fn] + (next-fn vals (filter afn structure))) + (update* [this vals structure next-fn] + (let [[filtered ancestry] (filter+ancestry afn structure) + ;; the vec is necessary so that we can get by index later + ;; (can't get by index for cons'd lists) + next (vec (next-fn vals filtered))] + (reduce (fn [curr [newi oldi]] + (assoc curr oldi (get next newi))) + (vec structure) + ancestry)))) + +(deftype KeyPath [akey] + StructurePath + (select* [this vals structure next-fn] + (key-select akey vals structure next-fn)) + (update* [this vals structure next-fn] + (key-update akey vals structure next-fn) + )) + +(defn- selector-vals* [sel-fn selector vals structure next-fn] + (next-fn (vec (concat vals + [(sel-fn selector structure)])) + structure)) + +(deftype SelectorValsPath [sel-fn selector] + StructurePath + (select* [this vals structure next-fn] + (selector-vals* sel-fn selector vals structure next-fn)) + (update* [this vals structure next-fn] + (selector-vals* sel-fn selector vals structure next-fn))) diff --git a/src/clj/com/rpl/specter/protocols.clj b/src/clj/com/rpl/specter/protocols.clj new file mode 100644 index 0000000..0ea8550 --- /dev/null +++ b/src/clj/com/rpl/specter/protocols.clj @@ -0,0 +1,9 @@ +(ns com.rpl.specter.protocols) + +(defprotocol StructurePath + (select* [this vals structure next-fn]) + (update* [this vals structure next-fn]) + ) + +(defprotocol StructurePathComposer + (comp-structure-paths* [structure-paths])) diff --git a/test/clj/com/rpl/specter/core_test.clj b/test/clj/com/rpl/specter/core_test.clj new file mode 100644 index 0000000..fbd6ceb --- /dev/null +++ b/test/clj/com/rpl/specter/core_test.clj @@ -0,0 +1,176 @@ +(ns com.rpl.specter.core-test + (:use [clojure.test] + [clojure.test.check.clojure-test] + [com.rpl specter] + [com.rpl.specter test-helpers]) + (:require [clojure.test.check + [generators :as gen] + [properties :as prop]] + [clojure.test.check :as qc])) + +;;TODO: +;; test walk, codewalk +;; test keypath +;; test comp-structure-paths + +(defn gen-map-with-keys [key-gen val-gen & keys] + (gen/bind (gen/map key-gen val-gen) + (fn [m] + (gen/bind + (apply gen/hash-map (mapcat (fn [k] [k val-gen]) keys)) + (fn [m2] + (gen/return (merge m m2))))))) + +(defspec select-all-keyword-filter + (for-all+ + [v (gen/vector (max-size 5 + (gen-map-with-keys gen/keyword gen/int :a))) + pred (gen/elements [odd? even?])] + (= (select [ALL :a pred] v) + (->> v (map :a) (filter pred)) + ))) + +(defspec select-pos-extreme-pred + (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) + (->> 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) + (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]))) + ) + +(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]))) + ) + +(defspec update-all-on-map + (for-all+ + [m (max-size 5 (gen/map gen/keyword gen/int))] + (= (update [ALL LAST] inc m) + (into {} (for [[k v] m] [k (inc v)])) + ))) + +(defspec update-all + (for-all+ + [v (gen/vector gen/int)] + (let [v2 (update [ALL] inc v)] + (= v2 (map inc v)) + ))) + +(defspec update-all-filter + (for-all+ + [v (gen/vector gen/int) + pred (gen/elements [odd? even?]) + action (gen/elements [inc dec])] + (let [v2 (update [ALL pred] action v)] + (= v2 (map (fn [v] (if (pred v) (action v) v)) v)) + ))) + +(defspec update-last + (for-all+ + [v (gen/not-empty (gen/vector gen/int)) + pred (gen/elements [inc dec])] + (let [v2 (update [LAST] pred v)] + (= v2 (concat (butlast v) [(pred (last v))])) + ))) + +(defspec update-first + (for-all+ + [v (gen/not-empty (gen/vector gen/int)) + pred (gen/elements [inc dec])] + (let [v2 (update [FIRST] pred v)] + (= v2 (concat [(pred (first v))] (rest v) )) + ))) + +(defspec update-filterer-all-equivalency + (prop/for-all + [v (gen/vector gen/int)] + (let [v2 (update [(filterer odd?) ALL] inc v) + v3 (update [ALL odd?] inc v)] + (= v2 v3)) + )) + +(defspec update-with-context + (for-all+ + [m (max-size 10 (gen-map-with-keys gen/keyword gen/int :a :b)) + pred (gen/elements [odd? even?])] + (= (update [(val-selector-one :b) :a pred] + m) + (if (pred (:a m)) + (assoc m :a (+ (:a m) (:b m))) + m + )))) + +(defn differing-elements [v1 v2] + (->> (map vector v1 v2) + (map-indexed (fn [i [e1 e2]] + (if (not= e1 e2) + i))) + (filter identity))) + +(defspec update-last-compound + (for-all+ + [v (gen/such-that #(some odd? %) (gen/vector gen/int))] + (let [v2 (update [(filterer odd?) LAST] inc v) + differing-elems (differing-elements v v2)] + (and (= (count v2) (count v)) + (= (count differing-elems) 1) + (every? even? (drop (first differing-elems) v2)) + )))) + +;; max sizes prevent too much data from being generated and keeps test from taking forever +(defspec update-keyword + (for-all+ + [k1 (max-size 3 gen/keyword) + k2 (max-size 3 gen/keyword) + m1 (max-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 (update [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])) + ))) + +(defspec replace-in-test + (for-all+ + [v (gen/vector gen/int)] + (let [res (->> v (map (fn [v] (if (even? v) (inc v) v)))) + user-ret (->> v + (filter even?) + (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) + [res user-ret] + )))) + +(defspec replace-in-custom-merge + (for-all+ + [v (gen/vector gen/int)] + (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))) + [res user-ret] + )))) + +(deftest structure-path-directly-test + (is (= 3 (select-one :b {:a 1 :b 3}))) + (is (= 5 (select-one (comp-structure-paths :a :b) {:a {:b 5}}))) + ) diff --git a/test/clj/com/rpl/specter/test_helpers.clj b/test/clj/com/rpl/specter/test_helpers.clj new file mode 100644 index 0000000..2ee4ca7 --- /dev/null +++ b/test/clj/com/rpl/specter/test_helpers.clj @@ -0,0 +1,32 @@ +(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])) + +;; 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]] + `(gen/bind ~code (fn [~v] ~curr))) + `(gen/return ~vars) + (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) + ))