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

Merge 9a34d381f2 into a379893598

Browse source
This commit is contained in:
Jeff Evans 2020-10-22 15:03:23 -04:00 committed by GitHub
commit 91706a1c31
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
14 changed files with 526 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
DEVELOPER.md
View file

@ -10,3 +10,11 @@ lein do clean, test
lein javac lein javac
lein doo node test-build once lein doo node test-build once
``` ```
# Running self-hosted ClojureScript tests
Clone and `lein install` [test.check](https://github.com/clojure/test.check) so that 0.9.1-SNAPSHOT is installed locally.
```
scripts/test-self-host
```

18
project.clj
View file

@ -8,9 +8,11 @@
:java-source-paths ["src/java"] :java-source-paths ["src/java"]
:test-paths ["test", "target/test-classes"] :test-paths ["test", "target/test-classes"]
:auto-clean false :auto-clean false
:dependencies [[riddley "0.1.12"]] :dependencies [[riddley "0.1.12"]
[net.cgrand/macrovich "0.2.1"]]
:plugins [[lein-codox "0.10.7"] :plugins [[lein-codox "0.10.7"]
[lein-doo "0.1.7"]] [lein-doo "0.1.10"]
[lein-tach "1.0.0"]]
:codox {:source-paths ["target/classes" "src/clj"] :codox {:source-paths ["target/classes" "src/clj"]
:namespaces [com.rpl.specter :namespaces [com.rpl.specter
com.rpl.specter.zipper com.rpl.specter.zipper
@ -24,17 +26,23 @@
:cljsbuild {:builds [{:id "test-build" :cljsbuild {:builds [{:id "test-build"
:source-paths ["src/clj" "target/classes" "test"] :source-paths ["src/clj" "target/classes" "test"]
:compiler {:output-to "out/testable.js" :compiler {:output-to "out/testable.js"
:main 'com.rpl.specter.cljs-test-runner :main com.rpl.specter.cljs-test-runner
:target :nodejs :target :nodejs
:optimizations :none}}]} :optimizations :none}}]}
:tach {:test-runner-ns 'com.rpl.specter.cljs-self-test-runner :debug? true}
:profiles {:dev {:dependencies :profiles {:dev {:dependencies
[[org.clojure/test.check "0.9.0"] [[org.clojure/test.check "0.10.0"]
[org.clojure/clojure "1.9.0"] [org.clojure/clojure "1.9.0"]
[org.clojure/clojurescript "1.10.439"]]} [org.clojure/clojurescript "1.10.439"]]}
:bench {:dependencies [[org.clojure/clojure "1.9.0"] :bench {:dependencies [[org.clojure/clojure "1.9.0"]
[criterium "0.4.4"]]} [criterium "0.4.4"]]}
:test {:dependencies [[org.clojure/clojure "1.7.0"]]}} :test {:dependencies [[org.clojure/clojure "1.7.0"]]}
:self-host {:dependencies [[org.clojure/test.check "0.9.1-SNAPSHOT"]
[org.clojure/clojure "1.8.0"]
[org.clojure/clojurescript "1.9.229"]]
:main clojure.main}}
:deploy-repositories :deploy-repositories
[["clojars" {:url "https://repo.clojars.org" [["clojars" {:url "https://repo.clojars.org"

148
scripts/self-host/com/rpl/specter/self_host/aux.cljs Normal file
View file

@ -0,0 +1,148 @@
(ns com.rpl.specter.self-host.aux
"This auxiliary namespace is not actually loaded.
Its mere presence cause it to be compiled and thus causes
the libs listed here to be dumped into the compiler output
directory where they can be loaded on demand when running
the tests in self-host mode."
(:require
goog.Delay
goog.Disposable
goog.Promise
goog.Throttle
goog.Timer
goog.Uri
goog.color
goog.color.Hsl
goog.color.Hsv
goog.color.Rgb
goog.color.alpha
goog.color.names
goog.crypt
goog.crypt.Aes
goog.crypt.Arc4
goog.crypt.BlobHasher
goog.crypt.Cbc
goog.crypt.Hash
goog.crypt.Hmac
goog.crypt.Md5
goog.crypt.Sha1
goog.crypt.Sha2
goog.crypt.Sha224
goog.crypt.Sha256
goog.crypt.Sha2_64bit
goog.crypt.Sha512
goog.crypt.Sha512_256
goog.crypt.base64
goog.crypt.baseN
goog.crypt.hash32
goog.crypt.hashTester
goog.crypt.pbkdf2
goog.date.Date
goog.date.DateLike
goog.date.DateRange
goog.date.DateTime
goog.date.Interval
goog.date.UtcDateTime
goog.date.duration
goog.date.month
goog.date.relative.TimeDeltaFormatter
goog.date.relative.Unit
goog.date.relativeWithPlurals
goog.date.weekDay
goog.format
goog.format.EmailAddress
goog.format.HtmlPrettyPrinter
goog.format.InternationalizedEmailAddress
goog.format.JsonPrettyPrinter
goog.i18n.BidiFormatter
goog.i18n.CharListDecompressor
goog.i18n.CharPickerData
goog.i18n.DateTimeFormat
goog.i18n.DateTimeParse
goog.i18n.GraphemeBreak
goog.i18n.MessageFormat
goog.i18n.NumberFormat
goog.i18n.TimeZone
goog.i18n.bidi
goog.i18n.bidi.Dir
goog.i18n.bidi.Format
goog.i18n.collation
goog.i18n.currency
goog.i18n.mime
goog.i18n.ordinalRules
goog.i18n.pluralRules
goog.i18n.uChar
goog.i18n.uChar.LocalNameFetcher
goog.i18n.uChar.RemoteNameFetcher
goog.i18n.uCharNames
goog.iter
goog.iter.Iterable
goog.iter.Iterator
goog.json
goog.json.EvalJsonProcessor
goog.json.HybridJsonProcessor
goog.json.NativeJsonProcessor
goog.json.Replacer
goog.json.Reviver
goog.json.Serializer
goog.json.hybrid
goog.locale
goog.locale.TimeZoneFingerprint
goog.locale.defaultLocaleNameConstants
goog.locale.genericFontNames
goog.locale.timeZoneDetection
goog.math
goog.math.AffineTransform
goog.math.Bezier
goog.math.Box
goog.math.Coordinate
goog.math.Coordinate3
goog.math.ExponentialBackoff
goog.math.Integer
goog.math.Line
goog.math.Long
goog.math.Matrix
goog.math.Path
goog.math.Path.Segment
goog.math.Range
goog.math.RangeSet
goog.math.Rect
goog.math.Size
goog.math.Vec2
goog.math.Vec3
goog.math.interpolator.Linear1
goog.math.interpolator.Pchip1
goog.math.interpolator.Spline1
goog.math.paths
goog.math.tdma
goog.spell.SpellCheck
goog.string
goog.string.Const
goog.string.StringBuffer
goog.string.Unicode
goog.string.format
goog.string.newlines
goog.string.newlines.Line
goog.structs
goog.structs.AvlTree
goog.structs.AvlTree.Node
goog.structs.CircularBuffer
goog.structs.Heap
goog.structs.InversionMap
goog.structs.LinkedMap
goog.structs.Map
goog.structs.Node
goog.structs.Pool
goog.structs.PriorityPool
goog.structs.PriorityQueue
goog.structs.QuadTree
goog.structs.QuadTree.Node
goog.structs.QuadTree.Point
goog.structs.Queue
goog.structs.Set
goog.structs.SimplePool
goog.structs.StringSet
goog.structs.TreeNode
goog.structs.Trie
goog.structs.weak
goog.text.LoremIpsum))

251
scripts/self-host/com/rpl/specter/self_host/test_runner.cljs Normal file
View file

@ -0,0 +1,251 @@
(ns com.rpl.specter.self-host.test-runner
(:require [clojure.string :as string]
[cljs.nodejs :as nodejs]
[cljs.js :as cljs]
[cljs.reader :as reader]))
(def out-dir "target/out-self-host")
(def src-paths [out-dir
"src/clj"
"test"])
(defn init-runtime
"Initializes the runtime so that we can use the cljs.user
namespace and so that Google Closure is set up to work
properly with :optimizations :none."
[]
(set! (.-user js/cljs) #js {})
;; monkey-patch isProvided_ to avoid useless warnings
(js* "goog.isProvided_ = function(x) { return false; };")
;; monkey-patch goog.require, skip all the loaded checks
(set! (.-require js/goog)
(fn [name]
(js/CLOSURE_IMPORT_SCRIPT
(aget (.. js/goog -dependencies_ -nameToPath) name))))
;; setup printing
(nodejs/enable-util-print!)
;; redef goog.require to track loaded libs
(set! *loaded-libs* #{"cljs.core"})
(set! (.-require js/goog)
(fn [name reload]
(when (or (not (contains? *loaded-libs* name)) reload)
(set! *loaded-libs* (conj (or *loaded-libs* #{}) name))
(js/CLOSURE_IMPORT_SCRIPT
(aget (.. js/goog -dependencies_ -nameToPath) name))))))
;; Node file reading fns
(def fs (nodejs/require "fs"))
(defn node-read-file
"Accepts a filename to read and a callback. Upon success, invokes
callback with the source. Otherwise invokes the callback with nil."
[filename cb]
(.readFile fs filename "utf-8"
(fn [err source]
(cb (when-not err
source)))))
(defn node-read-file-sync
"Accepts a filename to read. Upon success, returns the source.
Otherwise returns nil."
[filename]
(.readFileSync fs filename "utf-8"))
;; Facilities for loading Closure deps
(defn closure-index
"Builds an index of Closure files. Similar to
cljs.js-deps/goog-dependencies*"
[]
(let [paths-to-provides
(map (fn [[_ path provides]]
[path (map second
(re-seq #"'(.*?)'" provides))])
(re-seq #"\ngoog\.addDependency\('(.*)', \[(.*?)\].*"
(node-read-file-sync (str out-dir "/goog/deps.js"))))]
(into {}
(for [[path provides] paths-to-provides
provide provides]
[(symbol provide) (str out-dir "/goog/" (second (re-find #"(.*)\.js$" path)))]))))
(def closure-index-mem (memoize closure-index))
(defn load-goog
"Loads a Google Closure implementation source file."
[name cb]
(if-let [goog-path (get (closure-index-mem) name)]
(if-let [source (node-read-file-sync (str goog-path ".js"))]
(cb {:source source
:lang :js})
(cb nil))
(cb nil)))
;; Facilities for loading files
(defn- filename->lang
"Converts a filename to a lang keyword by inspecting the file
extension."
[filename]
(if (string/ends-with? filename ".js")
:js
:clj))
(defn replace-extension
"Replaces the extension on a file."
[filename new-extension]
(string/replace filename #".clj[sc]?$" new-extension))
(defn parse-edn
"Parses edn source to Clojure data."
[edn-source]
(reader/read-string edn-source))
(defn- read-some
"Reads the first filename in a sequence of supplied filenames,
using a supplied read-file-fn, calling back upon first successful
read, otherwise calling back with nil. Before calling back, first
attempts to read AOT artifacts (JavaScript and cache edn)."
[[filename & more-filenames] read-file-fn cb]
(if filename
(read-file-fn
filename
(fn [source]
(if source
(let [source-cb-value {:lang (filename->lang filename)
:file filename
:source source}]
(if (or (string/ends-with? filename ".cljs")
(string/ends-with? filename ".cljc"))
(read-file-fn
(replace-extension filename ".js")
(fn [javascript-source]
(if javascript-source
(read-file-fn
(str filename ".cache.edn")
(fn [cache-edn]
(if cache-edn
(cb {:lang :js
:source javascript-source
:cache (parse-edn cache-edn)})
(cb source-cb-value))))
(cb source-cb-value))))
(cb source-cb-value)))
(read-some more-filenames read-file-fn cb))))
(cb nil)))
(defn filenames-to-try
"Produces a sequence of filenames to try reading, in the
order they should be tried."
[src-paths macros path]
(let [extensions (if macros
[".clj" ".cljc"]
[".cljs" ".cljc" ".js"])]
(for [extension extensions
src-path src-paths]
(str src-path "/" path extension))))
(defn skip-load?
"Indicates namespaces that we either don't need to load,
shouldn't load, or cannot load (owing to unresolved
technical issues)."
[name macros]
((if macros
#{'cljs.core
'cljs.pprint
'cljs.env.macros
'cljs.analyzer.macros
'cljs.compiler.macros}
#{'goog.object
'goog.string
'goog.string.StringBuffer
'goog.array
'cljs.core
'cljs.env
'cljs.pprint
'cljs.tools.reader
'clojure.walk}) name))
;; An atom to keep track of things we've already loaded
(def loaded (atom #{}))
(defn load?
"Determines whether the given namespace should be loaded."
[name macros]
(let [do-not-load (or (@loaded [name macros])
(skip-load? name macros))]
(swap! loaded conj [name macros])
(not do-not-load)))
(defn make-load-fn
"Makes a load function that will read from a sequence of src-paths
using a supplied read-file-fn. It returns a cljs.js-compatible
*load-fn*.
Read-file-fn is a 2-arity function (fn [filename source-cb] ...) where
source-cb is itself a function (fn [source] ...) that needs to be called
with the source of the library (as string)."
[src-paths read-file-fn]
(fn [{:keys [name macros path]} cb]
(if (load? name macros)
(if (re-matches #"^goog/.*" path)
(load-goog name cb)
(read-some (filenames-to-try src-paths macros path) read-file-fn cb))
(cb {:source ""
:lang :js}))))
;; Facilities for evaluating JavaScript
(def vm (nodejs/require "vm"))
(defn node-eval
"Evaluates JavaScript in node."
[{:keys [name source]}]
(if-not js/COMPILED
(.runInThisContext vm source (str (munge name) ".js"))
(js/eval source)))
;; Facilities for driving cljs.js
(def load-fn (make-load-fn src-paths node-read-file))
(defn eval-form
"Evaluates a supplied form in a given namespace,
calling back with the evaluation result."
[st ns form cb]
(cljs/eval st
form
{:ns ns
:context :expr
:load load-fn
:eval node-eval
:verbose false}
cb))
(defn run-tests
"Runs the tests."
[]
(let [st (cljs/empty-state)]
(cljs/load-analysis-cache! st 'cljs.core$macros
(parse-edn (node-read-file-sync (str out-dir "/cljs/core$macros.cljc.cache.edn"))))
(eval-form st 'cljs.user
'(ns runner.core
(:require [cljs.test :as test :refer-macros [run-tests]]
[com.rpl.specter.core-test]
[com.rpl.specter.zipper-test]))
(fn [{:keys [value error]}]
(if error
(prn error)
(eval-form st 'runner.core
'(run-tests
'com.rpl.specter.core-test
'com.rpl.specter.zipper-test)
(fn [{:keys [value error]}]
(when error
(prn error)))))))))
(defn -main [& args]
(init-runtime)
(run-tests))
(set! *main-cli-fn* -main)

5
scripts/test-self-host Executable file
View file

@ -0,0 +1,5 @@
#!/bin/bash
rm -rf target/out-self-host
lein with-profile self-host run scripts/test-self-host.clj
node target/out-self-host/main.js

35
scripts/test-self-host.clj Normal file
View file

@ -0,0 +1,35 @@
(require '[cljs.build.api]
'[clojure.java.io :as io])
(cljs.build.api/build "scripts/self-host"
{:main 'com.rpl.specter.self-host.test-runner
:output-to "target/out-self-host/main.js"
:output-dir "target/out-self-host"
:target :nodejs})
(defn copy-source
[filename]
(let [fully-qualified (str "target/out-self-host/" filename)]
(io/make-parents fully-qualified)
(spit fully-qualified
(slurp (io/resource filename)))))
;; Copy some core source files so they can be loaded by self-host tests
(copy-source "cljs/test.cljc")
(copy-source "cljs/analyzer/api.cljc")
(copy-source "clojure/template.clj")
;; Copy all test.check source out of JAR so it can be loaded by self-host tests
;; Note: If test.check adds or renames namespaces, this will need to be updated.
(copy-source "clojure/test/check.cljc")
(copy-source "clojure/test/check/clojure_test.cljc")
(copy-source "clojure/test/check/generators.cljc")
(copy-source "clojure/test/check/impl.cljc")
(copy-source "clojure/test/check/properties.cljc")
(copy-source "clojure/test/check/random/doubles.cljs")
(copy-source "clojure/test/check/random/longs/bit_count_impl.cljs")
(copy-source "clojure/test/check/random/longs.cljs")
(copy-source "clojure/test/check/random.clj")
(copy-source "clojure/test/check/random.cljs")
(copy-source "clojure/test/check/results.cljc")
(copy-source "clojure/test/check/rose_tree.cljc")

76
src/clj/com/rpl/specter.cljc
View file

@ -1,5 +1,6 @@
(ns com.rpl.specter (ns com.rpl.specter
#?(:cljs (:require-macros #?(:cljs (:require-macros
[net.cgrand.macrovich :as mvch]
[com.rpl.specter [com.rpl.specter
:refer :refer
[late-bound-nav [late-bound-nav
@ -28,8 +29,9 @@
#?(:clj [com.rpl.specter.util-macros :only [doseqres]])) #?(:clj [com.rpl.specter.util-macros :only [doseqres]]))
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
[com.rpl.specter.navs :as n] [com.rpl.specter.navs :as n]
#?(:clj [clojure.walk :as cljwalk]) #?(:clj [net.cgrand.macrovich :as mvch])
#?(:clj [com.rpl.specter.macros :as macros]) [clojure.walk :as cljwalk]
[com.rpl.specter.macros :as macros]
[clojure.set :as set])) [clojure.set :as set]))
(defn- static-path? [path] (defn- static-path? [path]
@ -51,18 +53,23 @@
ret ret
)))) ))))
#?(:clj (mvch/deftime
(do
(defmacro defmacroalias [name target] (defmacro defmacroalias [name target]
`(do `(do
(def ~name (var ~target)) (def ~name (var ~target))
(alter-meta! (var ~name) merge {:macro true}))) (alter-meta! (var ~name) merge {:macro true})))
(defmacroalias richnav macros/richnav) ; defmacroalias doesn't seem to work in self-hosted (tach): "Can't take value of macro com.rpl.specter.macros/..."
(defmacroalias nav macros/nav) ; wrapping the second param in (quote ...) makes that warning go away in self-hosted, but breaks other environments
(defmacroalias defnav macros/defnav) ; therefore, using an alternative approach to aliasing these macros
(defmacroalias defrichnav macros/defrichnav) ;(defmacroalias richnav macros/richnav)
;(defmacroalias nav macros/nav)
;(defmacroalias defnav macros/defnav)
;(defmacroalias defrichnav macros/defrichnav)
(defmacro richnav [& args] `(macros/richnav ~@args))
(defmacro nav [& args] `(macros/nav ~@args))
(defmacro defnav [& args] `(macros/defnav ~@args))
(defmacro defrichnav [& args] `(macros/defrichnav ~@args))
(defmacro collector [params [_ [_ structure-sym] & body]] (defmacro collector [params [_ [_ structure-sym] & body]]
`(richnav ~params `(richnav ~params
@ -73,6 +80,7 @@
(defmacro defcollector [name & body] (defmacro defcollector [name & body]
`(def ~name (collector ~@body))) `(def ~name (collector ~@body)))
) ; end mvch/deftime
(defn- late-bound-operation [bindings builder-op impls] (defn- late-bound-operation [bindings builder-op impls]
@ -85,6 +93,7 @@
(apply builder# curr-params#) (apply builder# curr-params#)
(com.rpl.specter.impl/->DynamicFunction builder# curr-params# nil))))) (com.rpl.specter.impl/->DynamicFunction builder# curr-params# nil)))))
(mvch/deftime
(defmacro late-bound-nav [bindings & impls] (defmacro late-bound-nav [bindings & impls]
(late-bound-operation bindings `nav impls)) (late-bound-operation bindings `nav impls))
@ -114,6 +123,7 @@
(let [~self-sym (i/local-declarepath)] (let [~self-sym (i/local-declarepath)]
(providepath ~self-sym ~path) (providepath ~self-sym ~path)
~self-sym))))) ~self-sym)))))
) ; end mvch/deftime
;; copied from clojure.core ;; copied from clojure.core
(def (def
@ -177,6 +187,7 @@
m (conj {:arglists (list 'quote (sigs fdecl))} m)] m (conj {:arglists (list 'quote (sigs fdecl))} m)]
[(with-meta name m) fdecl])) [(with-meta name m) fdecl]))
(mvch/deftime
(defmacro dynamicnav [& args] (defmacro dynamicnav [& args]
`(vary-meta (wrap-dynamic-nav (fn ~@args)) assoc :dynamicnav true)) `(vary-meta (wrap-dynamic-nav (fn ~@args)) assoc :dynamicnav true))
@ -190,7 +201,6 @@
(let [[name args] (name-with-attributes name args)] (let [[name args] (name-with-attributes name args)]
`(def ~name (dynamicnav ~@args)))) `(def ~name (dynamicnav ~@args))))
(defn- ic-prepare-path [locals-set path] (defn- ic-prepare-path [locals-set path]
(cond (cond
(vector? path) (vector? path)
@ -204,7 +214,7 @@
;; var-get doesn't work in cljs, so capture the val in the macro instead ;; var-get doesn't work in cljs, so capture the val in the macro instead
`(com.rpl.specter.impl/->VarUse `(com.rpl.specter.impl/->VarUse
~path ~path
~(if-not (instance? Class (resolve path)) `(var ~path)) ~(if-not (mvch/case :clj (instance? Class (resolve path)) :cljs false) `(var ~path))
(quote ~path))) (quote ~path)))
@ -244,6 +254,7 @@
path))) path)))
) ; end mvch/deftime
(defn- cljs-macroexpand [env form] (defn- cljs-macroexpand [env form]
(let [expand-fn (i/cljs-analyzer-macroexpand-1) (let [expand-fn (i/cljs-analyzer-macroexpand-1)
@ -265,6 +276,7 @@
ret)) ret))
(mvch/deftime
(defmacro path (defmacro path
"Same as calling comp-paths, except it caches the composition of the static parts "Same as calling comp-paths, except it caches the composition of the static parts
of the path for later re-use (when possible). For almost all idiomatic uses of the path for later re-use (when possible). For almost all idiomatic uses
@ -439,7 +451,7 @@
to capture all the collected values as a single vector." to capture all the collected values as a single vector."
[params & body] [params & body]
`(i/collected?* (~'fn [~params] ~@body))) `(i/collected?* (~'fn [~params] ~@body)))
) ; end mvch/deftime
(defn- protpath-sym [name] (defn- protpath-sym [name]
(-> name (str "-prot") symbol)) (-> name (str "-prot") symbol))
@ -448,6 +460,7 @@
(-> name (str "-retrieve") symbol)) (-> name (str "-retrieve") symbol))
(mvch/deftime
(defmacro defprotocolpath (defmacro defprotocolpath
"Defines a navigator that chooses the path to take based on the type "Defines a navigator that chooses the path to take based on the type
of the value at the current point. May be specified with parameters to of the value at the current point. May be specified with parameters to
@ -487,31 +500,24 @@
(defmacro satisfies-protpath? [protpath o] (defmacro satisfies-protpath? [protpath o]
`(satisfies? ~(protpath-sym protpath) ~o)) `(satisfies? ~(protpath-sym protpath) ~o))
(defn extend-protocolpath* [protpath-prot extensions]
(let [m (-> protpath-prot :sigs keys first)
params (-> protpath-prot :sigs first last :arglists first)]
(doseq [[atype path-code] extensions]
(extend atype protpath-prot
{m (binding [*compile-files* false]
(eval `(fn ~params (path ~path-code))))}))))
(defmacro extend-protocolpath (defmacro extend-protocolpath
"Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]." "Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]."
[protpath & extensions] [protpath & extensions]
(let [extensions (partition 2 extensions) (let [extensions (partition 2 extensions)
embed (vec (for [[t p] extensions] [t `(quote ~p)]))] embed (vec (for [[t p] extensions] [t p]))
`(extend-protocolpath* prot-sym (protpath-sym protpath)
~(protpath-sym protpath) prot (mvch/case :clj (-> prot-sym resolve deref) :cljs prot-sym)
~embed))) m (-> prot :sigs keys first)
params (-> prot :sigs first last :arglists first)]
`(do ~@(for [[atype paths-expr] embed]
`(extend-protocol ~prot-sym ~atype
(~m ~params (path ~paths-expr)))))))
(defmacro end-fn [& args] (defmacro end-fn [& args]
`(n/->SrangeEndFunction (fn ~@args))) `(n/->SrangeEndFunction (fn ~@args)))
) ; end mvch/deftime
)) (defn comp-paths
(defn comp-paths
"Returns a compiled version of the given path for use with "Returns a compiled version of the given path for use with
compiled-{select/transform/setval/etc.} functions." compiled-{select/transform/setval/etc.} functions."
[& apath] [& apath]
@ -648,6 +654,7 @@
(def late-resolved-fn i/late-resolved-fn) (def late-resolved-fn i/late-resolved-fn)
(mvch/usetime
(defdynamicnav (defdynamicnav
^{:doc "Turns a navigator that takes one argument into a navigator that takes ^{:doc "Turns a navigator that takes one argument into a navigator that takes
many arguments and uses the same navigator with each argument. There many arguments and uses the same navigator with each argument. There
@ -658,7 +665,6 @@
(dynamicnav [& args] (dynamicnav [& args]
(map latenavfn args)))) (map latenavfn args))))
;; Helpers for making recursive or mutually recursive navs ;; Helpers for making recursive or mutually recursive navs
(def local-declarepath i/local-declarepath) (def local-declarepath i/local-declarepath)
@ -675,8 +681,6 @@
(transform* [this structure next-fn] (transform* [this structure next-fn]
structure)) structure))
(def (def
^{:doc "Stays navigated at the current point. Essentially a no-op navigator."} ^{:doc "Stays navigated at the current point. Essentially a no-op navigator."}
STAY STAY
@ -761,7 +765,6 @@
(defcollector VAL [] (defcollector VAL []
(collect-val [this structure] (collect-val [this structure]
structure)) structure))
(def (def
^{:doc "Navigate to the last element of the collection. If the collection is ^{:doc "Navigate to the last element of the collection. If the collection is
empty navigation is stopped at this point."} empty navigation is stopped at this point."}
@ -984,7 +987,6 @@
)) ))
structure structure
))) )))
(def ^{:doc "Navigate to the specified keys one after another. If navigate to NONE, (def ^{:doc "Navigate to the specified keys one after another. If navigate to NONE,
that element is removed from the map or vector."} that element is removed from the map or vector."}
keypath keypath
@ -1089,7 +1091,6 @@
structure structure
structure structure
)))) ))))
(def (def
^{:doc "`indexed-vals` with a starting index of 0."} ^{:doc "`indexed-vals` with a starting index of 0."}
INDEXED-VALS INDEXED-VALS
@ -1206,7 +1207,6 @@
(transform* [this structure next-fn] (transform* [this structure next-fn]
(next-fn (reduce late-fn (compiled-traverse late structure))) (next-fn (reduce late-fn (compiled-traverse late structure)))
))) )))
(def (def
^{:doc "Keeps the element only if it matches the supplied predicate. Functions in paths ^{:doc "Keeps the element only if it matches the supplied predicate. Functions in paths
implicitly convert to this navigator." implicitly convert to this navigator."
@ -1270,7 +1270,6 @@
(next-fn (if (nil? structure) v structure))) (next-fn (if (nil? structure) v structure)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(next-fn (if (nil? structure) v structure)))) (next-fn (if (nil? structure) v structure))))
(def (def
^{:doc "Navigates to #{} if the value is nil. Otherwise it stays ^{:doc "Navigates to #{} if the value is nil. Otherwise it stays
navigated at the current value."} navigated at the current value."}
@ -1477,7 +1476,6 @@
to implement post-order traversal." to implement post-order traversal."
[& path] [& path]
(multi-path path STAY)) (multi-path path STAY))
(def (def
^{:doc "Navigate the data structure until reaching ^{:doc "Navigate the data structure until reaching
a value for which `afn` returns truthy. Has a value for which `afn` returns truthy. Has
@ -1487,7 +1485,6 @@
(cond-path (pred afn) STAY (cond-path (pred afn) STAY
coll? [ALL p] coll? [ALL p]
))) )))
(def (def
^{:doc "Like `walker` but maintains metadata of any forms traversed."} ^{:doc "Like `walker` but maintains metadata of any forms traversed."}
codewalker codewalker
@ -1504,3 +1501,4 @@
[& path] [& path]
(map compact* path) (map compact* path)
)) ))
) ; end mvch/usetime

2
src/clj/com/rpl/specter/macros.cljs Normal file
View file

@ -0,0 +1,2 @@
(ns com.rpl.specter.macros
(:require-macros [com.rpl.specter.macros :refer [nav richnav defnav defrichnav]]))

2
src/clj/com/rpl/specter/navs.cljc
View file

@ -1,6 +1,6 @@
(ns com.rpl.specter.navs (ns com.rpl.specter.navs
#?(:cljs (:require-macros #?(:cljs (:require-macros
[com.rpl.specter [com.rpl.specter.macros
:refer :refer
[defnav defrichnav]] [defnav defrichnav]]
[com.rpl.specter.util-macros :refer [com.rpl.specter.util-macros :refer

7
test/com/rpl/specter/cljs_self_test_runner.cljs Normal file
View file

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

10
test/com/rpl/specter/core_test.cljc
View file

@ -1,9 +1,9 @@
(ns com.rpl.specter.core-test (ns com.rpl.specter.core-test
#?(:cljs (:require-macros #?(:cljs (:require-macros
[cljs.test :refer [is deftest]]
[clojure.test.check.clojure-test :refer [defspec]] [clojure.test.check.clojure-test :refer [defspec]]
[com.rpl.specter.cljs-test-helpers :refer [for-all+]] [com.rpl.specter.cljs-test-helpers :refer [for-all+]]
[com.rpl.specter.test-helpers :refer [ic-test]] [com.rpl.specter.test-helpers :refer [ic-test]]
[net.cgrand.macrovich :as mvch]
[com.rpl.specter [com.rpl.specter
:refer [defprotocolpath defnav extend-protocolpath :refer [defprotocolpath defnav extend-protocolpath
nav declarepath providepath select select-one select-one! nav declarepath providepath select select-one select-one!
@ -29,9 +29,12 @@
(:require #?(:clj [clojure.test.check.generators :as gen]) (:require #?(:clj [clojure.test.check.generators :as gen])
#?(:clj [clojure.test.check.properties :as prop]) #?(:clj [clojure.test.check.properties :as prop])
#?(:clj [net.cgrand.macrovich :as mvch])
#?(:cljs [clojure.test.check :as tc]) #?(:cljs [clojure.test.check :as tc])
#?(:cljs [clojure.test.check.generators :as gen]) #?(:cljs [clojure.test.check.generators :as gen])
#?(:cljs [clojure.test.check.properties :as prop :include-macros true]) #?(:cljs [clojure.test.check.properties :as prop :include-macros true])
#?(:cljs [cljs.test :refer-macros [is deftest]])
#?(:cljs [clojure.test.check.clojure-test :refer-macros [defspec]])
[com.rpl.specter :as s] [com.rpl.specter :as s]
[com.rpl.specter.transients :as t] [com.rpl.specter.transients :as t]
[clojure.set :as set])) [clojure.set :as set]))
@ -61,7 +64,6 @@
(= (select [s/ALL kw pred] v) (= (select [s/ALL kw pred] v)
(->> v (map kw) (filter pred))))) (->> v (map kw) (filter pred)))))
(defspec select-pos-extreme-pred (defspec select-pos-extreme-pred
(for-all+ (for-all+
[v (gen/vector gen/int) [v (gen/vector gen/int)
@ -883,7 +885,7 @@
[[true] [false]]) [[true] [false]])
(ic-test (ic-test
[v] [v]
[s/ALL (double-str-keypath v (inc v))] [s/ALL (double-str-keypath v ((mvch/case :clj 'clojure.core/inc :cljs 'cljs.core/inc) v))]
str str
[{"12" :a "1011" :b} {"1011" :c}] [{"12" :a "1011" :b} {"1011" :c}]
[[1] [10]]) [[1] [10]])
@ -1701,4 +1703,4 @@
(deftest satisfies-protpath-test (deftest satisfies-protpath-test
(is (satisfies-protpath? FooPP "a")) (is (satisfies-protpath? FooPP "a"))
(is (not (satisfies-protpath? FooPP 1))) (is (not (satisfies-protpath? FooPP 1)))
))) )))

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

@ -1,11 +1,8 @@
(ns com.rpl.specter.test-helpers (ns com.rpl.specter.test-helpers
(:require [clojure.test.check (:require [clojure.test.check.generators :as gen]
[generators :as gen] [clojure.test.check.properties :as prop]
[properties :as prop]] [clojure.test]
[clojure.test]) [com.rpl.specter :as s]))
(:use [com.rpl.specter :only [select transform]]
[com.rpl.specter :only [select* transform*]]))
;; it seems like gen/bind and gen/return are a monad (hence the names) ;; it seems like gen/bind and gen/return are a monad (hence the names)
@ -25,10 +22,10 @@
(defmacro ic-test [params-decl apath transform-fn data params] (defmacro ic-test [params-decl apath transform-fn data params]
(let [platform (if (contains? &env :locals) :cljs :clj) (let [platform (if (contains? &env :locals) :cljs :clj)
is-sym (if (= platform :clj) 'clojure.test/is 'cljs.test/is)] is-sym (if (= platform :clj) 'clojure.test/is 'cljs.test/is)]
`(let [icfnsel# (fn [~@params-decl] (select ~apath ~data)) `(let [icfnsel# (fn [~@params-decl] (s/select ~apath ~data))
icfntran# (fn [~@params-decl] (transform ~apath ~transform-fn ~data)) icfntran# (fn [~@params-decl] (s/transform ~apath ~transform-fn ~data))
regfnsel# (fn [~@params-decl] (select* ~apath ~data)) regfnsel# (fn [~@params-decl] (s/select* ~apath ~data))
regfntran# (fn [~@params-decl] (transform* ~apath ~transform-fn ~data)) regfntran# (fn [~@params-decl] (s/transform* ~apath ~transform-fn ~data))
params# (if (empty? ~params) [[]] ~params)] params# (if (empty? ~params) [[]] ~params)]
(dotimes [_# 3] (dotimes [_# 3]
(doseq [ps# params#] (doseq [ps# params#]

3
test/com/rpl/specter/test_helpers.cljs Normal file
View file

@ -0,0 +1,3 @@
(ns com.rpl.specter.test-helpers
(:require-macros [com.rpl.specter.test-helpers :refer [for-all+ ic-test]])
(:require [com.rpl.specter :refer-macros [select transform]]))

4
test/com/rpl/specter/zipper_test.cljc
View file

@ -1,7 +1,5 @@
(ns com.rpl.specter.zipper-test (ns com.rpl.specter.zipper-test
#?(:cljs (:require-macros #?(:cljs (:require-macros
[cljs.test :refer [is deftest]]
[clojure.test.check.clojure-test :refer [defspec]]
[com.rpl.specter.cljs-test-helpers :refer [for-all+]] [com.rpl.specter.cljs-test-helpers :refer [for-all+]]
[com.rpl.specter [com.rpl.specter
:refer [declarepath providepath select select-one select-one! :refer [declarepath providepath select select-one select-one!
@ -20,6 +18,8 @@
#?(:cljs [clojure.test.check :as tc]) #?(:cljs [clojure.test.check :as tc])
#?(:cljs [clojure.test.check.generators :as gen]) #?(:cljs [clojure.test.check.generators :as gen])
#?(:cljs [clojure.test.check.properties :as prop :include-macros true]) #?(:cljs [clojure.test.check.properties :as prop :include-macros true])
#?(:cljs [cljs.test :refer-macros [deftest is]])
#?(:cljs [clojure.test.check.clojure-test :refer-macros [defspec]])
[com.rpl.specter :as s] [com.rpl.specter :as s]
[com.rpl.specter.zipper :as z])) [com.rpl.specter.zipper :as z]))