initial commit
This commit is contained in:
commit
a1d1f236ab
9 changed files with 825 additions and 0 deletions
11
.gitignore
vendored
Normal file
11
.gitignore
vendored
Normal file
|
|
@ -0,0 +1,11 @@
|
||||||
|
pom.xml
|
||||||
|
pom.xml.asc
|
||||||
|
*jar
|
||||||
|
/lib/
|
||||||
|
/classes/
|
||||||
|
/target/
|
||||||
|
/checkouts/
|
||||||
|
.lein-deps-sum
|
||||||
|
.lein-repl-history
|
||||||
|
.lein-plugins/
|
||||||
|
.lein-failures
|
||||||
202
LICENSE
Normal file
202
LICENSE
Normal file
|
|
@ -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.
|
||||||
|
|
||||||
41
README.md
Normal file
41
README.md
Normal file
|
|
@ -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?
|
||||||
9
project.clj
Normal file
9
project.clj
Normal file
|
|
@ -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"]]}
|
||||||
|
})
|
||||||
117
src/clj/com/rpl/specter.clj
Normal file
117
src/clj/com/rpl/specter.clj
Normal file
|
|
@ -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 [<user-ret> <user-ret>...]"
|
||||||
|
(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)))
|
||||||
228
src/clj/com/rpl/specter/impl.clj
Normal file
228
src/clj/com/rpl/specter/impl.clj
Normal file
|
|
@ -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)))
|
||||||
9
src/clj/com/rpl/specter/protocols.clj
Normal file
9
src/clj/com/rpl/specter/protocols.clj
Normal file
|
|
@ -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]))
|
||||||
176
test/clj/com/rpl/specter/core_test.clj
Normal file
176
test/clj/com/rpl/specter/core_test.clj
Normal file
|
|
@ -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}})))
|
||||||
|
)
|
||||||
32
test/clj/com/rpl/specter/test_helpers.clj
Normal file
32
test/clj/com/rpl/specter/test_helpers.clj
Normal file
|
|
@ -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)
|
||||||
|
))
|
||||||
Loading…
Reference in a new issue