pax_global_header00006660000000000000000000000064133436213770014523gustar00rootroot0000000000000052 comment=e55884e47619d713f068ea9e814b8a28f60e4c5d spec.alpha-spec.alpha-0.2.176/000077500000000000000000000000001334362137700157325ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/.gitignore000066400000000000000000000000561334362137700177230ustar00rootroot00000000000000.idea *.jar *.iml /target/ .lein* .nrepl-port spec.alpha-spec.alpha-0.2.176/CHANGES.md000066400000000000000000000053661334362137700173360ustar00rootroot00000000000000# Change Log for spec.alpha ## Version 0.2.168 on June 26, 2018 * [CLJ-2182](https://dev.clojure.org/jira/browse/CLJ-2182) Always check preds for s/& on nil input * [CLJ-2178](https://dev.clojure.org/jira/browse/CLJ-2178) Return resolved pred for s/& explain-data * [CLJ-2177](https://dev.clojure.org/jira/browse/CLJ-2177) Return valid resolved pred in s/keys explain-data * [CLJ-2167](https://dev.clojure.org/jira/browse/CLJ-2176) Properly check for int? in int-in-range? * [CLJ-2166](https://dev.clojure.org/jira/browse/CLJ-2166) added function name to instrument exception map * [CLJ-2111](https://dev.clojure.org/jira/browse/CLJ-2111) Clarify docstring for :kind in s/every * [CLJ-2068](https://dev.clojure.org/jira/browse/CLJ-2068) Capture form of set and function instances in spec * [CLJ-2060](https://dev.clojure.org/jira/browse/CLJ-2060) Remove a spec by s/def of nil * [CLJ-2046](https://dev.clojure.org/jira/browse/CLJ-2046) gen random subsets of or'd req keys in map specs * [CLJ-2026](https://dev.clojure.org/jira/browse/CLJ-2026) Prevent concurrent loads in dynaload * [CLJ-2176](https://dev.clojure.org/jira/browse/CLJ-2176) s/tuple explain-data :pred problem ## Version 0.1.143 on Oct 30, 2017 * [CLJ-2259](https://dev.clojure.org/jira/browse/CLJ-2259) - map decimal? to big decimal generator (instead of bigdec?) ## Version 0.1.134 on Oct 6, 2017 * [CLJ-2103](https://dev.clojure.org/jira/browse/CLJ-2103) - s/coll-of and s/every gen is very slow if :kind specified without :into * [CLJ-2171](https://dev.clojure.org/jira/browse/CLJ-2171) - Default explain printer shouldn't print root val and spec * Mark Clojure dependency as a provided dep so it's not transitively included ## Version 0.1.123 on May 26, 2017 * No changes, just a rebuild ## Version 0.1.109 on May 26, 2017 * [CLJ-2153](https://dev.clojure.org/jira/browse/CLJ-2153) - Docstring for int-in-range? and int-in now mention fixed precision constraint * [CLJ-2085](https://dev.clojure.org/jira/browse/CLJ-2085) - Add the top level spec and value to explain-data * [CLJ-2076](https://dev.clojure.org/jira/browse/CLJ-2076) - coll-of and map-of should unform their elements * [CLJ-2063](https://dev.clojure.org/jira/browse/CLJ-2063) - report explain errors in order from longest to shortest path * [CLJ-2061](https://dev.clojure.org/jira/browse/CLJ-2061) - Better error message when exercise-fn called on fn without :args spec * [CLJ-2059](https://dev.clojure.org/jira/browse/CLJ-2059) - explain-data should return resolved preds * [CLJ-2057](https://dev.clojure.org/jira/browse/CLJ-2057) - If :ret spec is not supplied, use any? ## Version 0.1.108 on May 2, 2017 * AOT compile the spec namespaces ## Version 0.1.94 on Apr 26, 2017 * Moved spec namespaces from Clojure * Renamed spec namespaces to append ".alpha" spec.alpha-spec.alpha-0.2.176/CONTRIBUTING.md000066400000000000000000000012221334362137700201600ustar00rootroot00000000000000This is a [Clojure contrib] project. Under the Clojure contrib [guidelines], this project cannot accept pull requests. All patches must be submitted via [JIRA]. See [Contributing] and the [FAQ] on the Clojure development [wiki] for more information on how to contribute. [Clojure contrib]: http://dev.clojure.org/display/doc/Clojure+Contrib [Contributing]: http://dev.clojure.org/display/community/Contributing [FAQ]: http://dev.clojure.org/display/community/Contributing+FAQ [JIRA]: http://dev.clojure.org/jira/browse/CCACHE [guidelines]: http://dev.clojure.org/display/community/Guidelines+for+Clojure+Contrib+committers [wiki]: http://dev.clojure.org/ spec.alpha-spec.alpha-0.2.176/README.md000066400000000000000000000052211334362137700172110ustar00rootroot00000000000000spec.alpha ======================================== spec is a Clojure library to describe the structure of data and functions. Specs can be used to validate data, conform (destructure) data, explain invalid data, generate examples that conform to the specs, and automatically use generative testing to test functions. Clojure 1.9 depends on this library and provides it to users of Clojure. Thus, the recommended way to use this library is to add a dependency on the latest version of Clojure 1.9, rather than including it directly. In some cases, this library may release more frequently than Clojure. In those cases, you can explictly include the latest version of this library with the dependency info below. For more information: * Rationale - https://clojure.org/about/spec * Guide - https://clojure.org/guides/spec * Spec split notice - https://groups.google.com/forum/#!msg/clojure/10dbF7w2IQo/ec37TzP5AQAJ Releases and Dependency Information ======================================== Latest stable release: 0.2.168 * [All Released Versions](http://search.maven.org/#search%7Cgav%7C1%7Cg%3A%22org.clojure%22%20AND%20a%3A%22spec.alpha%22) * [Development Snapshot Versions](https://oss.sonatype.org/index.html#nexus-search;gav~org.clojure~spec.alpha~~~) [deps.edn](https://clojure.org/guides/deps_and_cli) dependency information: org.clojure/spec.alpha {:mvn/version "0.2.168"} [Leiningen](https://github.com/technomancy/leiningen) dependency information: [org.clojure/spec.alpha "0.2.168"] [Maven](http://maven.apache.org/) dependency information: org.clojure spec.alpha 0.2.168 Developer Information ======================================== * [API docs](http://clojure.github.io/spec.alpha/) * [GitHub project](https://github.com/clojure/spec.alpha) * [Changelog](https://github.com/clojure/spec.alpha/blob/master/CHANGES.md) * [Bug Tracker](http://dev.clojure.org/jira/browse/CLJ) * [Continuous Integration](http://build.clojure.org/job/spec.alpha/) * [Compatibility Test Matrix](http://build.clojure.org/job/spec.alpha-test-matrix/) Copyright and License ======================================== Copyright (c) Rich Hickey, and contributors, 2018. All rights reserved. The use and distribution terms for this software are covered by the Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can be found in the file epl-v10.html at the root of this distribution. By using this software in any fashion, you are agreeing to be bound bythe terms of this license. You must not remove this notice, or any other, from this software. spec.alpha-spec.alpha-0.2.176/VERSION_TEMPLATE000077500000000000000000000000261334362137700202760ustar00rootroot000000000000000.2.GENERATED_VERSION spec.alpha-spec.alpha-0.2.176/epl-v10.html000066400000000000000000000305601334362137700200100ustar00rootroot00000000000000 Eclipse Public License - Version 1.0

Eclipse Public License - v 1.0

THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.

1. DEFINITIONS

"Contribution" means:

a) in the case of the initial Contributor, the initial code and documentation distributed under this Agreement, and

b) in the case of each subsequent Contributor:

i) changes to the Program, and

ii) additions to the Program;

where such changes and/or additions to the Program originate from and are distributed by that particular Contributor. A Contribution 'originates' from a Contributor if it was added to the Program by such Contributor itself or anyone acting on such Contributor's behalf. Contributions do not include additions to the Program which: (i) are separate modules of software distributed in conjunction with the Program under their own license agreement, and (ii) are not derivative works of the Program.

"Contributor" means any person or entity that distributes the Program.

"Licensed Patents" mean patent claims licensable by a Contributor which are necessarily infringed by the use or sale of its Contribution alone or when combined with the Program.

"Program" means the Contributions distributed in accordance with this Agreement.

"Recipient" means anyone who receives the Program under this Agreement, including all Contributors.

2. GRANT OF RIGHTS

a) Subject to the terms of this Agreement, each Contributor hereby grants Recipient a non-exclusive, worldwide, royalty-free copyright license to reproduce, prepare derivative works of, publicly display, publicly perform, distribute and sublicense the Contribution of such Contributor, if any, and such derivative works, in source code and object code form.

b) Subject to the terms of this Agreement, each Contributor hereby grants Recipient a non-exclusive, worldwide, royalty-free patent license under Licensed Patents to make, use, sell, offer to sell, import and otherwise transfer the Contribution of such Contributor, if any, in source code and object code form. This patent license shall apply to the combination of the Contribution and the Program if, at the time the Contribution is added by the Contributor, such addition of the Contribution causes such combination to be covered by the Licensed Patents. The patent license shall not apply to any other combinations which include the Contribution. No hardware per se is licensed hereunder.

c) Recipient understands that although each Contributor grants the licenses to its Contributions set forth herein, no assurances are provided by any Contributor that the Program does not infringe the patent or other intellectual property rights of any other entity. Each Contributor disclaims any liability to Recipient for claims brought by any other entity based on infringement of intellectual property rights or otherwise. As a condition to exercising the rights and licenses granted hereunder, each Recipient hereby assumes sole responsibility to secure any other intellectual property rights needed, if any. For example, if a third party patent license is required to allow Recipient to distribute the Program, it is Recipient's responsibility to acquire that license before distributing the Program.

d) Each Contributor represents that to its knowledge it has sufficient copyright rights in its Contribution, if any, to grant the copyright license set forth in this Agreement.

3. REQUIREMENTS

A Contributor may choose to distribute the Program in object code form under its own license agreement, provided that:

a) it complies with the terms and conditions of this Agreement; and

b) its license agreement:

i) effectively disclaims on behalf of all Contributors all warranties and conditions, express and implied, including warranties or conditions of title and non-infringement, and implied warranties or conditions of merchantability and fitness for a particular purpose;

ii) effectively excludes on behalf of all Contributors all liability for damages, including direct, indirect, special, incidental and consequential damages, such as lost profits;

iii) states that any provisions which differ from this Agreement are offered by that Contributor alone and not by any other party; and

iv) states that source code for the Program is available from such Contributor, and informs licensees how to obtain it in a reasonable manner on or through a medium customarily used for software exchange.

When the Program is made available in source code form:

a) it must be made available under this Agreement; and

b) a copy of this Agreement must be included with each copy of the Program.

Contributors may not remove or alter any copyright notices contained within the Program.

Each Contributor must identify itself as the originator of its Contribution, if any, in a manner that reasonably allows subsequent Recipients to identify the originator of the Contribution.

4. COMMERCIAL DISTRIBUTION

Commercial distributors of software may accept certain responsibilities with respect to end users, business partners and the like. While this license is intended to facilitate the commercial use of the Program, the Contributor who includes the Program in a commercial product offering should do so in a manner which does not create potential liability for other Contributors. Therefore, if a Contributor includes the Program in a commercial product offering, such Contributor ("Commercial Contributor") hereby agrees to defend and indemnify every other Contributor ("Indemnified Contributor") against any losses, damages and costs (collectively "Losses") arising from claims, lawsuits and other legal actions brought by a third party against the Indemnified Contributor to the extent caused by the acts or omissions of such Commercial Contributor in connection with its distribution of the Program in a commercial product offering. The obligations in this section do not apply to any claims or Losses relating to any actual or alleged intellectual property infringement. In order to qualify, an Indemnified Contributor must: a) promptly notify the Commercial Contributor in writing of such claim, and b) allow the Commercial Contributor to control, and cooperate with the Commercial Contributor in, the defense and any related settlement negotiations. The Indemnified Contributor may participate in any such claim at its own expense.

For example, a Contributor might include the Program in a commercial product offering, Product X. That Contributor is then a Commercial Contributor. If that Commercial Contributor then makes performance claims, or offers warranties related to Product X, those performance claims and warranties are such Commercial Contributor's responsibility alone. Under this section, the Commercial Contributor would have to defend claims against the other Contributors related to those performance claims and warranties, and if a court requires any other Contributor to pay any damages as a result, the Commercial Contributor must pay those damages.

5. NO WARRANTY

EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED 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. Each Recipient is solely responsible for determining the appropriateness of using and distributing the Program and assumes all risks associated with its exercise of rights under this Agreement , including but not limited to the risks and costs of program errors, compliance with applicable laws, damage to or loss of data, programs or equipment, and unavailability or interruption of operations.

6. DISCLAIMER OF LIABILITY

EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.

7. GENERAL

If any provision of this Agreement is invalid or unenforceable under applicable law, it shall not affect the validity or enforceability of the remainder of the terms of this Agreement, and without further action by the parties hereto, such provision shall be reformed to the minimum extent necessary to make such provision valid and enforceable.

If Recipient institutes patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Program itself (excluding combinations of the Program with other software or hardware) infringes such Recipient's patent(s), then such Recipient's rights granted under Section 2(b) shall terminate as of the date such litigation is filed.

All Recipient's rights under this Agreement shall terminate if it fails to comply with any of the material terms or conditions of this Agreement and does not cure such failure in a reasonable period of time after becoming aware of such noncompliance. If all Recipient's rights under this Agreement terminate, Recipient agrees to cease use and distribution of the Program as soon as reasonably practicable. However, Recipient's obligations under this Agreement and any licenses granted by Recipient relating to the Program shall continue and survive.

Everyone is permitted to copy and distribute copies of this Agreement, but in order to avoid inconsistency the Agreement is copyrighted and may only be modified in the following manner. The Agreement Steward reserves the right to publish new versions (including revisions) of this Agreement from time to time. No one other than the Agreement Steward has the right to modify this Agreement. The Eclipse Foundation is the initial Agreement Steward. The Eclipse Foundation may assign the responsibility to serve as the Agreement Steward to a suitable separate entity. Each new version of the Agreement will be given a distinguishing version number. The Program (including Contributions) may always be distributed subject to the version of the Agreement under which it was received. In addition, after a new version of the Agreement is published, Contributor may elect to distribute the Program (including its Contributions) under the new version. Except as expressly stated in Sections 2(a) and 2(b) above, Recipient receives no rights or licenses to the intellectual property of any Contributor under this Agreement, whether expressly, by implication, estoppel or otherwise. All rights in the Program not expressly granted under this Agreement are reserved.

This Agreement is governed by the laws of the State of New York and the intellectual property laws of the United States of America. No party to this Agreement will bring a legal action under this Agreement more than one year after the cause of action arose. Each party waives its rights to a jury trial in any resulting litigation.

spec.alpha-spec.alpha-0.2.176/pom.xml000066400000000000000000000067061334362137700172600ustar00rootroot00000000000000 4.0.0 spec.alpha 0.2.176 spec.alpha Specification of data and functions scm:git:git://github.com/clojure/spec.alpha.git scm:git:ssh://git@github.com/clojure/spec.alpha.git spec.alpha-0.2.176 https://github.com/clojure/spec.alpha Eclipse Public License 1.0 http://opensource.org/licenses/eclipse-1.0.php repo org.clojure pom.contrib 0.2.2 richhickey Rich Hickey http://clojure.org 1.9.0 org.clojure clojure ${clojure.version} provided org.clojure test.check 0.9.0 test org.codehaus.mojo exec-maven-plugin 1.6.0 compile-clojure compile exec java compile -Dclojure.compile.path=${project.build.directory}/classes -Dclojure.spec.skip-macros=true -classpath clojure.lang.Compile clojure.spec.alpha clojure.spec.gen.alpha clojure.spec.test.alpha com.theoryinpractise clojure-maven-plugin 1.7.1 clojure-compile none clojure-test test src/main/clojure src/test/clojure spec.alpha-spec.alpha-0.2.176/script/000077500000000000000000000000001334362137700172365ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/script/build/000077500000000000000000000000001334362137700203355ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/script/build/branch_revision000077500000000000000000000005501334362137700234360ustar00rootroot00000000000000#!/usr/bin/env bash # If on a branch other than master, returns the number of commits made off of master # If on master, returns 0 set -e master_tag=`git rev-parse --abbrev-ref HEAD` if [ "$master_tag" == "master" ]; then echo "0" else last_commit=`git rev-parse HEAD` revision=`git rev-list master..$last_commit | wc -l` echo $revision fi spec.alpha-spec.alpha-0.2.176/script/build/git_revision000077500000000000000000000004011334362137700227570ustar00rootroot00000000000000#!/usr/bin/env bash # Return the portion of the version number generated from git # set -e trunk_basis=`script/build/trunk_revision` sha=`git rev-parse HEAD` sha=${sha:0:${#sha}-34} # drop the last 34 characters, keep 6 echo $trunk_basis spec.alpha-spec.alpha-0.2.176/script/build/revision000077500000000000000000000007111334362137700221200ustar00rootroot00000000000000#!/usr/bin/env bash # Return the complete revision number # ...-[-qualifier] set -e version_template=`cat VERSION_TEMPLATE` if [[ "$version_template" =~ ^[0-9]+\.[0-9]+\.GENERATED_VERSION(-[a-zA-Z0-9]+)?$ ]]; then git_revision=`script/build/git_revision` echo ${version_template/GENERATED_VERSION/$git_revision} else echo "Invalid version template string: $version_template" >&2 exit -1 fi spec.alpha-spec.alpha-0.2.176/script/build/trunk_revision000077500000000000000000000006061334362137700233460ustar00rootroot00000000000000#!/usr/bin/env bash # Returns the number of commits made since the v0.0 tag set -e REVISION=`git --no-replace-objects describe --match v0.0` # Extract the version number from the string. Do this in two steps so # it is a little easier to understand. REVISION=${REVISION:5} # drop the first 5 characters REVISION=${REVISION:0:${#REVISION}-9} # drop the last 9 characters echo $REVISION spec.alpha-spec.alpha-0.2.176/script/build/update_version000077500000000000000000000002471334362137700233150ustar00rootroot00000000000000#!/usr/bin/env bash set -e mvn versions:set -DgenerateBackupPoms=false -DnewVersion=`script/build/revision`-SNAPSHOT git commit -m 'update version' pom.xml git push spec.alpha-spec.alpha-0.2.176/src/000077500000000000000000000000001334362137700165215ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/src/main/000077500000000000000000000000001334362137700174455ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/src/main/clojure/000077500000000000000000000000001334362137700211105ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/src/main/clojure/clojure/000077500000000000000000000000001334362137700225535ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/src/main/clojure/clojure/spec/000077500000000000000000000000001334362137700235055ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/src/main/clojure/clojure/spec/alpha.clj000066400000000000000000002245201334362137700252710ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns clojure.spec.alpha (:refer-clojure :exclude [+ * and assert or cat def keys merge]) (:require [clojure.walk :as walk] [clojure.spec.gen.alpha :as gen] [clojure.string :as str])) (alias 'c 'clojure.core) (set! *warn-on-reflection* true) (def ^:dynamic *recursion-limit* "A soft limit on how many times a branching spec (or/alt/*/opt-keys/multi-spec) can be recursed through during generation. After this a non-recursive branch will be chosen." 4) (def ^:dynamic *fspec-iterations* "The number of times an anonymous fn specified by fspec will be (generatively) tested during conform" 21) (def ^:dynamic *coll-check-limit* "The number of elements validated in a collection spec'ed with 'every'" 101) (def ^:dynamic *coll-error-limit* "The number of errors reported by explain in a collection spec'ed with 'every'" 20) (defprotocol Spec (conform* [spec x]) (unform* [spec y]) (explain* [spec path via in x]) (gen* [spec overrides path rmap]) (with-gen* [spec gfn]) (describe* [spec])) (defonce ^:private registry-ref (atom {})) (defn- deep-resolve [reg k] (loop [spec k] (if (ident? spec) (recur (get reg spec)) spec))) (defn- reg-resolve "returns the spec/regex at end of alias chain starting with k, nil if not found, k if k not ident" [k] (if (ident? k) (let [reg @registry-ref spec (get reg k)] (if-not (ident? spec) spec (deep-resolve reg spec))) k)) (defn- reg-resolve! "returns the spec/regex at end of alias chain starting with k, throws if not found, k if k not ident" [k] (if (ident? k) (c/or (reg-resolve k) (throw (Exception. (str "Unable to resolve spec: " k)))) k)) (defn spec? "returns x if x is a spec object, else logical false" [x] (when (instance? clojure.spec.alpha.Spec x) x)) (defn regex? "returns x if x is a (clojure.spec) regex op, else logical false" [x] (c/and (::op x) x)) (defn- with-name [spec name] (cond (ident? spec) spec (regex? spec) (assoc spec ::name name) (instance? clojure.lang.IObj spec) (with-meta spec (assoc (meta spec) ::name name)))) (defn- spec-name [spec] (cond (ident? spec) spec (regex? spec) (::name spec) (instance? clojure.lang.IObj spec) (-> (meta spec) ::name))) (declare spec-impl) (declare regex-spec-impl) (defn- maybe-spec "spec-or-k must be a spec, regex or resolvable kw/sym, else returns nil." [spec-or-k] (let [s (c/or (c/and (ident? spec-or-k) (reg-resolve spec-or-k)) (spec? spec-or-k) (regex? spec-or-k) nil)] (if (regex? s) (with-name (regex-spec-impl s nil) (spec-name s)) s))) (defn- the-spec "spec-or-k must be a spec, regex or kw/sym, else returns nil. Throws if unresolvable kw/sym" [spec-or-k] (c/or (maybe-spec spec-or-k) (when (ident? spec-or-k) (throw (Exception. (str "Unable to resolve spec: " spec-or-k)))))) (defprotocol Specize (specize* [_] [_ form])) (defn- fn-sym [^Object f] (let [[_ f-ns f-n] (re-matches #"(.*)\$(.*?)(__[0-9]+)?" (.. f getClass getName))] ;; check for anonymous function (when (not= "fn" f-n) (symbol (clojure.lang.Compiler/demunge f-ns) (clojure.lang.Compiler/demunge f-n))))) (extend-protocol Specize clojure.lang.Keyword (specize* ([k] (specize* (reg-resolve! k))) ([k _] (specize* (reg-resolve! k)))) clojure.lang.Symbol (specize* ([s] (specize* (reg-resolve! s))) ([s _] (specize* (reg-resolve! s)))) clojure.lang.IPersistentSet (specize* ([s] (spec-impl s s nil nil)) ([s form] (spec-impl form s nil nil))) Object (specize* ([o] (if (c/and (not (map? o)) (ifn? o)) (if-let [s (fn-sym o)] (spec-impl s o nil nil) (spec-impl ::unknown o nil nil)) (spec-impl ::unknown o nil nil))) ([o form] (spec-impl form o nil nil)))) (defn- specize ([s] (c/or (spec? s) (specize* s))) ([s form] (c/or (spec? s) (specize* s form)))) (defn invalid? "tests the validity of a conform return value" [ret] (identical? ::invalid ret)) (defn conform "Given a spec and a value, returns :clojure.spec.alpha/invalid if value does not match spec, else the (possibly destructured) value." [spec x] (conform* (specize spec) x)) (defn unform "Given a spec and a value created by or compliant with a call to 'conform' with the same spec, returns a value with all conform destructuring undone." [spec x] (unform* (specize spec) x)) (defn form "returns the spec as data" [spec] ;;TODO - incorporate gens (describe* (specize spec))) (defn abbrev [form] (cond (seq? form) (walk/postwalk (fn [form] (cond (c/and (symbol? form) (namespace form)) (-> form name symbol) (c/and (seq? form) (= 'fn (first form)) (= '[%] (second form))) (last form) :else form)) form) (c/and (symbol? form) (namespace form)) (-> form name symbol) :else form)) (defn describe "returns an abbreviated description of the spec as data" [spec] (abbrev (form spec))) (defn with-gen "Takes a spec and a no-arg, generator-returning fn and returns a version of that spec that uses that generator" [spec gen-fn] (let [spec (reg-resolve spec)] (if (regex? spec) (assoc spec ::gfn gen-fn) (with-gen* (specize spec) gen-fn)))) (defn explain-data* [spec path via in x] (let [probs (explain* (specize spec) path via in x)] (when-not (empty? probs) {::problems probs ::spec spec ::value x}))) (defn explain-data "Given a spec and a value x which ought to conform, returns nil if x conforms, else a map with at least the key ::problems whose value is a collection of problem-maps, where problem-map has at least :path :pred and :val keys describing the predicate and the value that failed at that path." [spec x] (explain-data* spec [] (if-let [name (spec-name spec)] [name] []) [] x)) (defn explain-printer "Default printer for explain-data. nil indicates a successful validation." [ed] (if ed (let [problems (->> (::problems ed) (sort-by #(- (count (:in %)))) (sort-by #(- (count (:path %)))))] ;;(prn {:ed ed}) (doseq [{:keys [path pred val reason via in] :as prob} problems] (pr val) (print " - failed: ") (if reason (print reason) (pr (abbrev pred))) (when-not (empty? in) (print (str " in: " (pr-str in)))) (when-not (empty? path) (print (str " at: " (pr-str path)))) (when-not (empty? via) (print (str " spec: " (pr-str (last via))))) (doseq [[k v] prob] (when-not (#{:path :pred :val :reason :via :in} k) (print "\n\t" (pr-str k) " ") (pr v))) (newline))) (println "Success!"))) (def ^:dynamic *explain-out* explain-printer) (defn explain-out "Prints explanation data (per 'explain-data') to *out* using the printer in *explain-out*, by default explain-printer." [ed] (*explain-out* ed)) (defn explain "Given a spec and a value that fails to conform, prints an explanation to *out*." [spec x] (explain-out (explain-data spec x))) (defn explain-str "Given a spec and a value that fails to conform, returns an explanation as a string." [spec x] (with-out-str (explain spec x))) (declare valid?) (defn- gensub [spec overrides path rmap form] ;;(prn {:spec spec :over overrides :path path :form form}) (let [spec (specize spec)] (if-let [g (c/or (when-let [gfn (c/or (get overrides (c/or (spec-name spec) spec)) (get overrides path))] (gfn)) (gen* spec overrides path rmap))] (gen/such-that #(valid? spec %) g 100) (let [abbr (abbrev form)] (throw (ex-info (str "Unable to construct gen at: " path " for: " abbr) {::path path ::form form ::failure :no-gen})))))) (defn gen "Given a spec, returns the generator for it, or throws if none can be constructed. Optionally an overrides map can be provided which should map spec names or paths (vectors of keywords) to no-arg generator-creating fns. These will be used instead of the generators at those names/paths. Note that parent generator (in the spec or overrides map) will supersede those of any subtrees. A generator for a regex op must always return a sequential collection (i.e. a generator for s/? should return either an empty sequence/vector or a sequence/vector with one item in it)" ([spec] (gen spec nil)) ([spec overrides] (gensub spec overrides [] {::recursion-limit *recursion-limit*} spec))) (defn- ->sym "Returns a symbol from a symbol or var" [x] (if (var? x) (let [^clojure.lang.Var v x] (symbol (str (.name (.ns v))) (str (.sym v)))) x)) (defn- unfn [expr] (if (c/and (seq? expr) (symbol? (first expr)) (= "fn*" (name (first expr)))) (let [[[s] & form] (rest expr)] (conj (walk/postwalk-replace {s '%} form) '[%] 'fn)) expr)) (defn- res [form] (cond (keyword? form) form (symbol? form) (c/or (-> form resolve ->sym) form) (sequential? form) (walk/postwalk #(if (symbol? %) (res %) %) (unfn form)) :else form)) (defn ^:skip-wiki def-impl "Do not call this directly, use 'def'" [k form spec] (c/assert (c/and (ident? k) (namespace k)) "k must be namespaced keyword or resolvable symbol") (if (nil? spec) (swap! registry-ref dissoc k) (let [spec (if (c/or (spec? spec) (regex? spec) (get @registry-ref spec)) spec (spec-impl form spec nil nil))] (swap! registry-ref assoc k (with-name spec k)))) k) (defn- ns-qualify "Qualify symbol s by resolving it or using the current *ns*." [s] (if-let [ns-sym (some-> s namespace symbol)] (c/or (some-> (get (ns-aliases *ns*) ns-sym) str (symbol (name s))) s) (symbol (str (.name *ns*)) (str s)))) (defmacro def "Given a namespace-qualified keyword or resolvable symbol k, and a spec, spec-name, predicate or regex-op makes an entry in the registry mapping k to the spec. Use nil to remove an entry in the registry for k." [k spec-form] (let [k (if (symbol? k) (ns-qualify k) k)] `(def-impl '~k '~(res spec-form) ~spec-form))) (defn registry "returns the registry map, prefer 'get-spec' to lookup a spec by name" [] @registry-ref) (defn get-spec "Returns spec registered for keyword/symbol/var k, or nil." [k] (get (registry) (if (keyword? k) k (->sym k)))) (defmacro spec "Takes a single predicate form, e.g. can be the name of a predicate, like even?, or a fn literal like #(< % 42). Note that it is not generally necessary to wrap predicates in spec when using the rest of the spec macros, only to attach a unique generator Can also be passed the result of one of the regex ops - cat, alt, *, +, ?, in which case it will return a regex-conforming spec, useful when nesting an independent regex. --- Optionally takes :gen generator-fn, which must be a fn of no args that returns a test.check generator. Returns a spec." [form & {:keys [gen]}] (when form `(spec-impl '~(res form) ~form ~gen nil))) (defmacro multi-spec "Takes the name of a spec/predicate-returning multimethod and a tag-restoring keyword or fn (retag). Returns a spec that when conforming or explaining data will pass it to the multimethod to get an appropriate spec. You can e.g. use multi-spec to dynamically and extensibly associate specs with 'tagged' data (i.e. data where one of the fields indicates the shape of the rest of the structure). (defmulti mspec :tag) The methods should ignore their argument and return a predicate/spec: (defmethod mspec :int [_] (s/keys :req-un [::tag ::i])) retag is used during generation to retag generated values with matching tags. retag can either be a keyword, at which key the dispatch-tag will be assoc'ed, or a fn of generated value and dispatch-tag that should return an appropriately retagged value. Note that because the tags themselves comprise an open set, the tag key spec cannot enumerate the values, but can e.g. test for keyword?. Note also that the dispatch values of the multimethod will be included in the path, i.e. in reporting and gen overrides, even though those values are not evident in the spec. " [mm retag] `(multi-spec-impl '~(res mm) (var ~mm) ~retag)) (defmacro keys "Creates and returns a map validating spec. :req and :opt are both vectors of namespaced-qualified keywords. The validator will ensure the :req keys are present. The :opt keys serve as documentation and may be used by the generator. The :req key vector supports 'and' and 'or' for key groups: (s/keys :req [::x ::y (or ::secret (and ::user ::pwd))] :opt [::z]) There are also -un versions of :req and :opt. These allow you to connect unqualified keys to specs. In each case, fully qualfied keywords are passed, which name the specs, but unqualified keys (with the same name component) are expected and checked at conform-time, and generated during gen: (s/keys :req-un [:my.ns/x :my.ns/y]) The above says keys :x and :y are required, and will be validated and generated by specs (if they exist) named :my.ns/x :my.ns/y respectively. In addition, the values of *all* namespace-qualified keys will be validated (and possibly destructured) by any registered specs. Note: there is no support for inline value specification, by design. Optionally takes :gen generator-fn, which must be a fn of no args that returns a test.check generator." [& {:keys [req req-un opt opt-un gen]}] (let [unk #(-> % name keyword) req-keys (filterv keyword? (flatten req)) req-un-specs (filterv keyword? (flatten req-un)) _ (c/assert (every? #(c/and (keyword? %) (namespace %)) (concat req-keys req-un-specs opt opt-un)) "all keys must be namespace-qualified keywords") req-specs (into req-keys req-un-specs) req-keys (into req-keys (map unk req-un-specs)) opt-keys (into (vec opt) (map unk opt-un)) opt-specs (into (vec opt) opt-un) gx (gensym) parse-req (fn [rk f] (map (fn [x] (if (keyword? x) `(contains? ~gx ~(f x)) (walk/postwalk (fn [y] (if (keyword? y) `(contains? ~gx ~(f y)) y)) x))) rk)) pred-exprs [`(map? ~gx)] pred-exprs (into pred-exprs (parse-req req identity)) pred-exprs (into pred-exprs (parse-req req-un unk)) keys-pred `(fn* [~gx] (c/and ~@pred-exprs)) pred-exprs (mapv (fn [e] `(fn* [~gx] ~e)) pred-exprs) pred-forms (walk/postwalk res pred-exprs)] ;; `(map-spec-impl ~req-keys '~req ~opt '~pred-forms ~pred-exprs ~gen) `(map-spec-impl {:req '~req :opt '~opt :req-un '~req-un :opt-un '~opt-un :req-keys '~req-keys :req-specs '~req-specs :opt-keys '~opt-keys :opt-specs '~opt-specs :pred-forms '~pred-forms :pred-exprs ~pred-exprs :keys-pred ~keys-pred :gfn ~gen}))) (defmacro or "Takes key+pred pairs, e.g. (s/or :even even? :small #(< % 42)) Returns a destructuring spec that returns a map entry containing the key of the first matching pred and the corresponding value. Thus the 'key' and 'val' functions can be used to refer generically to the components of the tagged return." [& key-pred-forms] (let [pairs (partition 2 key-pred-forms) keys (mapv first pairs) pred-forms (mapv second pairs) pf (mapv res pred-forms)] (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "spec/or expects k1 p1 k2 p2..., where ks are keywords") `(or-spec-impl ~keys '~pf ~pred-forms nil))) (defmacro and "Takes predicate/spec-forms, e.g. (s/and even? #(< % 42)) Returns a spec that returns the conformed value. Successive conformed values propagate through rest of predicates." [& pred-forms] `(and-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) (defmacro merge "Takes map-validating specs (e.g. 'keys' specs) and returns a spec that returns a conformed map satisfying all of the specs. Unlike 'and', merge can generate maps satisfying the union of the predicates." [& pred-forms] `(merge-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) (defn- res-kind [opts] (let [{kind :kind :as mopts} opts] (->> (if kind (assoc mopts :kind `~(res kind)) mopts) (mapcat identity)))) (defmacro every "takes a pred and validates collection elements against that pred. Note that 'every' does not do exhaustive checking, rather it samples *coll-check-limit* elements. Nor (as a result) does it do any conforming of elements. 'explain' will report at most *coll-error-limit* problems. Thus 'every' should be suitable for potentially large collections. Takes several kwargs options that further constrain the collection: :kind - a pred that the collection type must satisfy, e.g. vector? (default nil) Note that if :kind is specified and :into is not, this pred must generate in order for every to generate. :count - specifies coll has exactly this count (default nil) :min-count, :max-count - coll has count (<= min-count count max-count) (defaults nil) :distinct - all the elements are distinct (default nil) And additional args that control gen :gen-max - the maximum coll size to generate (default 20) :into - one of [], (), {}, #{} - the default collection to generate into (default: empty coll as generated by :kind pred if supplied, else []) Optionally takes :gen generator-fn, which must be a fn of no args that returns a test.check generator See also - coll-of, every-kv " [pred & {:keys [into kind count max-count min-count distinct gen-max gen] :as opts}] (let [desc (::describe opts) nopts (-> opts (dissoc :gen ::describe) (assoc ::kind-form `'~(res (:kind opts)) ::describe (c/or desc `'(every ~(res pred) ~@(res-kind opts))))) gx (gensym) cpreds (cond-> [(list (c/or kind `coll?) gx)] count (conj `(= ~count (bounded-count ~count ~gx))) (c/or min-count max-count) (conj `(<= (c/or ~min-count 0) (bounded-count (if ~max-count (inc ~max-count) ~min-count) ~gx) (c/or ~max-count Integer/MAX_VALUE))) distinct (conj `(c/or (empty? ~gx) (apply distinct? ~gx))))] `(every-impl '~pred ~pred ~(assoc nopts ::cpred `(fn* [~gx] (c/and ~@cpreds))) ~gen))) (defmacro every-kv "like 'every' but takes separate key and val preds and works on associative collections. Same options as 'every', :into defaults to {} See also - map-of" [kpred vpred & opts] (let [desc `(every-kv ~(res kpred) ~(res vpred) ~@(res-kind opts))] `(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (nth v# 0)) :into {} ::describe '~desc ~@opts))) (defmacro coll-of "Returns a spec for a collection of items satisfying pred. Unlike 'every', coll-of will exhaustively conform every value. Same options as 'every'. conform will produce a collection corresponding to :into if supplied, else will match the input collection, avoiding rebuilding when possible. See also - every, map-of" [pred & opts] (let [desc `(coll-of ~(res pred) ~@(res-kind opts))] `(every ~pred ::conform-all true ::describe '~desc ~@opts))) (defmacro map-of "Returns a spec for a map whose keys satisfy kpred and vals satisfy vpred. Unlike 'every-kv', map-of will exhaustively conform every value. Same options as 'every', :kind defaults to map?, with the addition of: :conform-keys - conform keys as well as values (default false) See also - every-kv" [kpred vpred & opts] (let [desc `(map-of ~(res kpred) ~(res vpred) ~@(res-kind opts))] `(every-kv ~kpred ~vpred ::conform-all true :kind map? ::describe '~desc ~@opts))) (defmacro * "Returns a regex op that matches zero or more values matching pred. Produces a vector of matches iff there is at least one match" [pred-form] `(rep-impl '~(res pred-form) ~pred-form)) (defmacro + "Returns a regex op that matches one or more values matching pred. Produces a vector of matches" [pred-form] `(rep+impl '~(res pred-form) ~pred-form)) (defmacro ? "Returns a regex op that matches zero or one value matching pred. Produces a single value (not a collection) if matched." [pred-form] `(maybe-impl ~pred-form '~(res pred-form))) (defmacro alt "Takes key+pred pairs, e.g. (s/alt :even even? :small #(< % 42)) Returns a regex op that returns a map entry containing the key of the first matching pred and the corresponding value. Thus the 'key' and 'val' functions can be used to refer generically to the components of the tagged return" [& key-pred-forms] (let [pairs (partition 2 key-pred-forms) keys (mapv first pairs) pred-forms (mapv second pairs) pf (mapv res pred-forms)] (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "alt expects k1 p1 k2 p2..., where ks are keywords") `(alt-impl ~keys ~pred-forms '~pf))) (defmacro cat "Takes key+pred pairs, e.g. (s/cat :e even? :o odd?) Returns a regex op that matches (all) values in sequence, returning a map containing the keys of each pred and the corresponding value." [& key-pred-forms] (let [pairs (partition 2 key-pred-forms) keys (mapv first pairs) pred-forms (mapv second pairs) pf (mapv res pred-forms)] ;;(prn key-pred-forms) (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "cat expects k1 p1 k2 p2..., where ks are keywords") `(cat-impl ~keys ~pred-forms '~pf))) (defmacro & "takes a regex op re, and predicates. Returns a regex-op that consumes input as per re but subjects the resulting value to the conjunction of the predicates, and any conforming they might perform." [re & preds] (let [pv (vec preds)] `(amp-impl ~re '~(res re) ~pv '~(mapv res pv)))) (defmacro conformer "takes a predicate function with the semantics of conform i.e. it should return either a (possibly converted) value or :clojure.spec.alpha/invalid, and returns a spec that uses it as a predicate/conformer. Optionally takes a second fn that does unform of result of first" ([f] `(spec-impl '(conformer ~(res f)) ~f nil true)) ([f unf] `(spec-impl '(conformer ~(res f) ~(res unf)) ~f nil true ~unf))) (defmacro fspec "takes :args :ret and (optional) :fn kwargs whose values are preds and returns a spec whose conform/explain take a fn and validates it using generative testing. The conformed value is always the fn itself. See 'fdef' for a single operation that creates an fspec and registers it, as well as a full description of :args, :ret and :fn fspecs can generate functions that validate the arguments and fabricate a return value compliant with the :ret spec, ignoring the :fn spec if present. Optionally takes :gen generator-fn, which must be a fn of no args that returns a test.check generator." [& {:keys [args ret fn gen] :or {ret `any?}}] `(fspec-impl (spec ~args) '~(res args) (spec ~ret) '~(res ret) (spec ~fn) '~(res fn) ~gen)) (defmacro tuple "takes one or more preds and returns a spec for a tuple, a vector where each element conforms to the corresponding pred. Each element will be referred to in paths using its ordinal." [& preds] (c/assert (not (empty? preds))) `(tuple-impl '~(mapv res preds) ~(vec preds))) (defn- macroexpand-check [v args] (let [fn-spec (get-spec v)] (when-let [arg-spec (:args fn-spec)] (when (invalid? (conform arg-spec args)) (let [ed (assoc (explain-data* arg-spec [] (if-let [name (spec-name arg-spec)] [name] []) [] args) ::args args)] (throw (ex-info (str "Call to " (->sym v) " did not conform to spec.") ed))))))) (defmacro fdef "Takes a symbol naming a function, and one or more of the following: :args A regex spec for the function arguments as they were a list to be passed to apply - in this way, a single spec can handle functions with multiple arities :ret A spec for the function's return value :fn A spec of the relationship between args and ret - the value passed is {:args conformed-args :ret conformed-ret} and is expected to contain predicates that relate those values Qualifies fn-sym with resolve, or using *ns* if no resolution found. Registers an fspec in the global registry, where it can be retrieved by calling get-spec with the var or fully-qualified symbol. Once registered, function specs are included in doc, checked by instrument, tested by the runner clojure.spec.test.alpha/check, and (if a macro) used to explain errors during macroexpansion. Note that :fn specs require the presence of :args and :ret specs to conform values, and so :fn specs will be ignored if :args or :ret are missing. Returns the qualified fn-sym. For example, to register function specs for the symbol function: (s/fdef clojure.core/symbol :args (s/alt :separate (s/cat :ns string? :n string?) :str string? :sym symbol?) :ret symbol?)" [fn-sym & specs] `(clojure.spec.alpha/def ~fn-sym (clojure.spec.alpha/fspec ~@specs))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; impl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- recur-limit? [rmap id path k] (c/and (> (get rmap id) (::recursion-limit rmap)) (contains? (set path) k))) (defn- inck [m k] (assoc m k (inc (c/or (get m k) 0)))) (defn- dt ([pred x form] (dt pred x form nil)) ([pred x form cpred?] (if pred (if-let [spec (the-spec pred)] (conform spec x) (if (ifn? pred) (if cpred? (pred x) (if (pred x) x ::invalid)) (throw (Exception. (str (pr-str form) " is not a fn, expected predicate fn"))))) x))) (defn valid? "Helper function that returns true when x is valid for spec." ([spec x] (let [spec (specize spec)] (not (invalid? (conform* spec x))))) ([spec x form] (let [spec (specize spec form)] (not (invalid? (conform* spec x)))))) (defn- pvalid? "internal helper function that returns true when x is valid for spec." ([pred x] (not (invalid? (dt pred x ::unknown)))) ([pred x form] (not (invalid? (dt pred x form))))) (defn- explain-1 [form pred path via in v] ;;(prn {:form form :pred pred :path path :in in :v v}) (let [pred (maybe-spec pred)] (if (spec? pred) (explain* pred path (if-let [name (spec-name pred)] (conj via name) via) in v) [{:path path :pred form :val v :via via :in in}]))) (declare or-k-gen and-k-gen) (defn- k-gen "returns a generator for form f, which can be a keyword or a list starting with 'or or 'and." [f] (cond (keyword? f) (gen/return f) (= 'or (first f)) (or-k-gen 1 (rest f)) (= 'and (first f)) (and-k-gen (rest f)))) (defn- or-k-gen "returns a tuple generator made up of generators for a random subset of min-count (default 0) to all elements in s." ([s] (or-k-gen 0 s)) ([min-count s] (gen/bind (gen/tuple (gen/choose min-count (count s)) (gen/shuffle (map k-gen s))) (fn [[n gens]] (apply gen/tuple (take n gens)))))) (defn- and-k-gen "returns a tuple generator made up of generators for every element in s." [s] (apply gen/tuple (map k-gen s))) (defn ^:skip-wiki map-spec-impl "Do not call this directly, use 'spec' with a map argument" [{:keys [req-un opt-un keys-pred pred-exprs opt-keys req-specs req req-keys opt-specs pred-forms opt gfn] :as argm}] (let [k->s (zipmap (concat req-keys opt-keys) (concat req-specs opt-specs)) keys->specnames #(c/or (k->s %) %) id (java.util.UUID/randomUUID)] (reify Specize (specize* [s] s) (specize* [s _] s) Spec (conform* [_ m] (if (keys-pred m) (let [reg (registry)] (loop [ret m, [[k v] & ks :as keys] m] (if keys (let [sname (keys->specnames k)] (if-let [s (get reg sname)] (let [cv (conform s v)] (if (invalid? cv) ::invalid (recur (if (identical? cv v) ret (assoc ret k cv)) ks))) (recur ret ks))) ret))) ::invalid)) (unform* [_ m] (let [reg (registry)] (loop [ret m, [k & ks :as keys] (c/keys m)] (if keys (if (contains? reg (keys->specnames k)) (let [cv (get m k) v (unform (keys->specnames k) cv)] (recur (if (identical? cv v) ret (assoc ret k v)) ks)) (recur ret ks)) ret)))) (explain* [_ path via in x] (if-not (map? x) [{:path path :pred `map? :val x :via via :in in}] (let [reg (registry)] (apply concat (when-let [probs (->> (map (fn [pred form] (when-not (pred x) form)) pred-exprs pred-forms) (keep identity) seq)] (map #(identity {:path path :pred % :val x :via via :in in}) probs)) (map (fn [[k v]] (when-not (c/or (not (contains? reg (keys->specnames k))) (pvalid? (keys->specnames k) v k)) (explain-1 (keys->specnames k) (keys->specnames k) (conj path k) via (conj in k) v))) (seq x)))))) (gen* [_ overrides path rmap] (if gfn (gfn) (let [rmap (inck rmap id) rgen (fn [k s] [k (gensub s overrides (conj path k) rmap k)]) ogen (fn [k s] (when-not (recur-limit? rmap id path k) [k (gen/delay (gensub s overrides (conj path k) rmap k))])) reqs (map rgen req-keys req-specs) opts (remove nil? (map ogen opt-keys opt-specs))] (when (every? identity (concat (map second reqs) (map second opts))) (gen/bind (gen/tuple (and-k-gen req) (or-k-gen opt) (and-k-gen req-un) (or-k-gen opt-un)) (fn [[req-ks opt-ks req-un-ks opt-un-ks]] (let [qks (flatten (concat req-ks opt-ks)) unqks (map (comp keyword name) (flatten (concat req-un-ks opt-un-ks)))] (->> (into reqs opts) (filter #((set (concat qks unqks)) (first %))) (apply concat) (apply gen/hash-map))))))))) (with-gen* [_ gfn] (map-spec-impl (assoc argm :gfn gfn))) (describe* [_] (cons `keys (cond-> [] req (conj :req req) opt (conj :opt opt) req-un (conj :req-un req-un) opt-un (conj :opt-un opt-un))))))) (defn ^:skip-wiki spec-impl "Do not call this directly, use 'spec'" ([form pred gfn cpred?] (spec-impl form pred gfn cpred? nil)) ([form pred gfn cpred? unc] (cond (spec? pred) (cond-> pred gfn (with-gen gfn)) (regex? pred) (regex-spec-impl pred gfn) (ident? pred) (cond-> (the-spec pred) gfn (with-gen gfn)) :else (reify Specize (specize* [s] s) (specize* [s _] s) Spec (conform* [_ x] (let [ret (pred x)] (if cpred? ret (if ret x ::invalid)))) (unform* [_ x] (if cpred? (if unc (unc x) (throw (IllegalStateException. "no unform fn for conformer"))) x)) (explain* [_ path via in x] (when (invalid? (dt pred x form cpred?)) [{:path path :pred form :val x :via via :in in}])) (gen* [_ _ _ _] (if gfn (gfn) (gen/gen-for-pred pred))) (with-gen* [_ gfn] (spec-impl form pred gfn cpred? unc)) (describe* [_] form))))) (defn ^:skip-wiki multi-spec-impl "Do not call this directly, use 'multi-spec'" ([form mmvar retag] (multi-spec-impl form mmvar retag nil)) ([form mmvar retag gfn] (let [id (java.util.UUID/randomUUID) predx #(let [^clojure.lang.MultiFn mm @mmvar] (c/and (.getMethod mm ((.dispatchFn mm) %)) (mm %))) dval #((.dispatchFn ^clojure.lang.MultiFn @mmvar) %) tag (if (keyword? retag) #(assoc %1 retag %2) retag)] (reify Specize (specize* [s] s) (specize* [s _] s) Spec (conform* [_ x] (if-let [pred (predx x)] (dt pred x form) ::invalid)) (unform* [_ x] (if-let [pred (predx x)] (unform pred x) (throw (IllegalStateException. (str "No method of: " form " for dispatch value: " (dval x)))))) (explain* [_ path via in x] (let [dv (dval x) path (conj path dv)] (if-let [pred (predx x)] (explain-1 form pred path via in x) [{:path path :pred form :val x :reason "no method" :via via :in in}]))) (gen* [_ overrides path rmap] (if gfn (gfn) (let [gen (fn [[k f]] (let [p (f nil)] (let [rmap (inck rmap id)] (when-not (recur-limit? rmap id path k) (gen/delay (gen/fmap #(tag % k) (gensub p overrides (conj path k) rmap (list 'method form k)))))))) gs (->> (methods @mmvar) (remove (fn [[k]] (invalid? k))) (map gen) (remove nil?))] (when (every? identity gs) (gen/one-of gs))))) (with-gen* [_ gfn] (multi-spec-impl form mmvar retag gfn)) (describe* [_] `(multi-spec ~form ~retag)))))) (defn ^:skip-wiki tuple-impl "Do not call this directly, use 'tuple'" ([forms preds] (tuple-impl forms preds nil)) ([forms preds gfn] (let [specs (delay (mapv specize preds forms)) cnt (count preds)] (reify Specize (specize* [s] s) (specize* [s _] s) Spec (conform* [_ x] (let [specs @specs] (if-not (c/and (vector? x) (= (count x) cnt)) ::invalid (loop [ret x, i 0] (if (= i cnt) ret (let [v (x i) cv (conform* (specs i) v)] (if (invalid? cv) ::invalid (recur (if (identical? cv v) ret (assoc ret i cv)) (inc i))))))))) (unform* [_ x] (c/assert (c/and (vector? x) (= (count x) (count preds)))) (loop [ret x, i 0] (if (= i (count x)) ret (let [cv (x i) v (unform (preds i) cv)] (recur (if (identical? cv v) ret (assoc ret i v)) (inc i)))))) (explain* [_ path via in x] (cond (not (vector? x)) [{:path path :pred `vector? :val x :via via :in in}] (not= (count x) (count preds)) [{:path path :pred `(= (count ~'%) ~(count preds)) :val x :via via :in in}] :else (apply concat (map (fn [i form pred] (let [v (x i)] (when-not (pvalid? pred v) (explain-1 form pred (conj path i) via (conj in i) v)))) (range (count preds)) forms preds)))) (gen* [_ overrides path rmap] (if gfn (gfn) (let [gen (fn [i p f] (gensub p overrides (conj path i) rmap f)) gs (map gen (range (count preds)) preds forms)] (when (every? identity gs) (apply gen/tuple gs))))) (with-gen* [_ gfn] (tuple-impl forms preds gfn)) (describe* [_] `(tuple ~@forms)))))) (defn- tagged-ret [tag ret] (clojure.lang.MapEntry. tag ret)) (defn ^:skip-wiki or-spec-impl "Do not call this directly, use 'or'" [keys forms preds gfn] (let [id (java.util.UUID/randomUUID) kps (zipmap keys preds) specs (delay (mapv specize preds forms)) cform (case (count preds) 2 (fn [x] (let [specs @specs ret (conform* (specs 0) x)] (if (invalid? ret) (let [ret (conform* (specs 1) x)] (if (invalid? ret) ::invalid (tagged-ret (keys 1) ret))) (tagged-ret (keys 0) ret)))) 3 (fn [x] (let [specs @specs ret (conform* (specs 0) x)] (if (invalid? ret) (let [ret (conform* (specs 1) x)] (if (invalid? ret) (let [ret (conform* (specs 2) x)] (if (invalid? ret) ::invalid (tagged-ret (keys 2) ret))) (tagged-ret (keys 1) ret))) (tagged-ret (keys 0) ret)))) (fn [x] (let [specs @specs] (loop [i 0] (if (< i (count specs)) (let [spec (specs i)] (let [ret (conform* spec x)] (if (invalid? ret) (recur (inc i)) (tagged-ret (keys i) ret)))) ::invalid)))))] (reify Specize (specize* [s] s) (specize* [s _] s) Spec (conform* [_ x] (cform x)) (unform* [_ [k x]] (unform (kps k) x)) (explain* [this path via in x] (when-not (pvalid? this x) (apply concat (map (fn [k form pred] (when-not (pvalid? pred x) (explain-1 form pred (conj path k) via in x))) keys forms preds)))) (gen* [_ overrides path rmap] (if gfn (gfn) (let [gen (fn [k p f] (let [rmap (inck rmap id)] (when-not (recur-limit? rmap id path k) (gen/delay (gensub p overrides (conj path k) rmap f))))) gs (remove nil? (map gen keys preds forms))] (when-not (empty? gs) (gen/one-of gs))))) (with-gen* [_ gfn] (or-spec-impl keys forms preds gfn)) (describe* [_] `(or ~@(mapcat vector keys forms)))))) (defn- and-preds [x preds forms] (loop [ret x [pred & preds] preds [form & forms] forms] (if pred (let [nret (dt pred ret form)] (if (invalid? nret) ::invalid ;;propagate conformed values (recur nret preds forms))) ret))) (defn- explain-pred-list [forms preds path via in x] (loop [ret x [form & forms] forms [pred & preds] preds] (when pred (let [nret (dt pred ret form)] (if (invalid? nret) (explain-1 form pred path via in ret) (recur nret forms preds)))))) (defn ^:skip-wiki and-spec-impl "Do not call this directly, use 'and'" [forms preds gfn] (let [specs (delay (mapv specize preds forms)) cform (case (count preds) 2 (fn [x] (let [specs @specs ret (conform* (specs 0) x)] (if (invalid? ret) ::invalid (conform* (specs 1) ret)))) 3 (fn [x] (let [specs @specs ret (conform* (specs 0) x)] (if (invalid? ret) ::invalid (let [ret (conform* (specs 1) ret)] (if (invalid? ret) ::invalid (conform* (specs 2) ret)))))) (fn [x] (let [specs @specs] (loop [ret x i 0] (if (< i (count specs)) (let [nret (conform* (specs i) ret)] (if (invalid? nret) ::invalid ;;propagate conformed values (recur nret (inc i)))) ret)))))] (reify Specize (specize* [s] s) (specize* [s _] s) Spec (conform* [_ x] (cform x)) (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) (explain* [_ path via in x] (explain-pred-list forms preds path via in x)) (gen* [_ overrides path rmap] (if gfn (gfn) (gensub (first preds) overrides path rmap (first forms)))) (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) (describe* [_] `(and ~@forms))))) (defn ^:skip-wiki merge-spec-impl "Do not call this directly, use 'merge'" [forms preds gfn] (reify Specize (specize* [s] s) (specize* [s _] s) Spec (conform* [_ x] (let [ms (map #(dt %1 x %2) preds forms)] (if (some invalid? ms) ::invalid (apply c/merge ms)))) (unform* [_ x] (apply c/merge (map #(unform % x) (reverse preds)))) (explain* [_ path via in x] (apply concat (map #(explain-1 %1 %2 path via in x) forms preds))) (gen* [_ overrides path rmap] (if gfn (gfn) (gen/fmap #(apply c/merge %) (apply gen/tuple (map #(gensub %1 overrides path rmap %2) preds forms))))) (with-gen* [_ gfn] (merge-spec-impl forms preds gfn)) (describe* [_] `(merge ~@forms)))) (defn- coll-prob [x kfn kform distinct count min-count max-count path via in] (let [pred (c/or kfn coll?) kform (c/or kform `coll?)] (cond (not (pvalid? pred x)) (explain-1 kform pred path via in x) (c/and count (not= count (bounded-count count x))) [{:path path :pred `(= ~count (c/count ~'%)) :val x :via via :in in}] (c/and (c/or min-count max-count) (not (<= (c/or min-count 0) (bounded-count (if max-count (inc max-count) min-count) x) (c/or max-count Integer/MAX_VALUE)))) [{:path path :pred `(<= ~(c/or min-count 0) (c/count ~'%) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}] (c/and distinct (not (empty? x)) (not (apply distinct? x))) [{:path path :pred 'distinct? :val x :via via :in in}]))) (def ^:private empty-coll {`vector? [], `set? #{}, `list? (), `map? {}}) (defn ^:skip-wiki every-impl "Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'" ([form pred opts] (every-impl form pred opts nil)) ([form pred {conform-into :into describe-form ::describe :keys [kind ::kind-form count max-count min-count distinct gen-max ::kfn ::cpred conform-keys ::conform-all] :or {gen-max 20} :as opts} gfn] (let [gen-into (if conform-into (empty conform-into) (get empty-coll kind-form)) spec (delay (specize pred)) check? #(valid? @spec %) kfn (c/or kfn (fn [i v] i)) addcv (fn [ret i v cv] (conj ret cv)) cfns (fn [x] ;;returns a tuple of [init add complete] fns (cond (c/and (vector? x) (c/or (not conform-into) (vector? conform-into))) [identity (fn [ret i v cv] (if (identical? v cv) ret (assoc ret i cv))) identity] (c/and (map? x) (c/or (c/and kind (not conform-into)) (map? conform-into))) [(if conform-keys empty identity) (fn [ret i v cv] (if (c/and (identical? v cv) (not conform-keys)) ret (assoc ret (nth (if conform-keys cv v) 0) (nth cv 1)))) identity] (c/or (list? conform-into) (seq? conform-into) (c/and (not conform-into) (c/or (list? x) (seq? x)))) [(constantly ()) addcv reverse] :else [#(empty (c/or conform-into %)) addcv identity]))] (reify Specize (specize* [s] s) (specize* [s _] s) Spec (conform* [_ x] (let [spec @spec] (cond (not (cpred x)) ::invalid conform-all (let [[init add complete] (cfns x)] (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)] (if vseq (let [cv (conform* spec v)] (if (invalid? cv) ::invalid (recur (add ret i v cv) (inc i) vs))) (complete ret)))) :else (if (indexed? x) (let [step (max 1 (long (/ (c/count x) *coll-check-limit*)))] (loop [i 0] (if (>= i (c/count x)) x (if (valid? spec (nth x i)) (recur (c/+ i step)) ::invalid)))) (let [limit *coll-check-limit*] (loop [i 0 [v & vs :as vseq] (seq x)] (cond (c/or (nil? vseq) (= i limit)) x (valid? spec v) (recur (inc i) vs) :else ::invalid))))))) (unform* [_ x] (if conform-all (let [spec @spec [init add complete] (cfns x)] (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)] (if (>= i (c/count x)) (complete ret) (recur (add ret i v (unform* spec v)) (inc i) vs)))) x)) (explain* [_ path via in x] (c/or (coll-prob x kind kind-form distinct count min-count max-count path via in) (apply concat ((if conform-all identity (partial take *coll-error-limit*)) (keep identity (map (fn [i v] (let [k (kfn i v)] (when-not (check? v) (let [prob (explain-1 form pred path via (conj in k) v)] prob)))) (range) x)))))) (gen* [_ overrides path rmap] (if gfn (gfn) (let [pgen (gensub pred overrides path rmap form)] (gen/bind (cond gen-into (gen/return gen-into) kind (gen/fmap #(if (empty? %) % (empty %)) (gensub kind overrides path rmap form)) :else (gen/return [])) (fn [init] (gen/fmap #(if (vector? init) % (into init %)) (cond distinct (if count (gen/vector-distinct pgen {:num-elements count :max-tries 100}) (gen/vector-distinct pgen {:min-elements (c/or min-count 0) :max-elements (c/or max-count (max gen-max (c/* 2 (c/or min-count 0)))) :max-tries 100})) count (gen/vector pgen count) (c/or min-count max-count) (gen/vector pgen (c/or min-count 0) (c/or max-count (max gen-max (c/* 2 (c/or min-count 0))))) :else (gen/vector pgen 0 gen-max)))))))) (with-gen* [_ gfn] (every-impl form pred opts gfn)) (describe* [_] (c/or describe-form `(every ~(res form) ~@(mapcat identity opts)))))))) ;;;;;;;;;;;;;;;;;;;;;;; regex ;;;;;;;;;;;;;;;;;;; ;;See: ;; http://matt.might.net/articles/implementation-of-regular-expression-matching-in-scheme-with-derivatives/ ;; http://www.ccs.neu.edu/home/turon/re-deriv.pdf ;;ctors (defn- accept [x] {::op ::accept :ret x}) (defn- accept? [{:keys [::op]}] (= ::accept op)) (defn- pcat* [{[p1 & pr :as ps] :ps, [k1 & kr :as ks] :ks, [f1 & fr :as forms] :forms, ret :ret, rep+ :rep+}] (when (every? identity ps) (if (accept? p1) (let [rp (:ret p1) ret (conj ret (if ks {k1 rp} rp))] (if pr (pcat* {:ps pr :ks kr :forms fr :ret ret}) (accept ret))) {::op ::pcat, :ps ps, :ret ret, :ks ks, :forms forms :rep+ rep+}))) (defn- pcat [& ps] (pcat* {:ps ps :ret []})) (defn ^:skip-wiki cat-impl "Do not call this directly, use 'cat'" [ks ps forms] (pcat* {:ks ks, :ps ps, :forms forms, :ret {}})) (defn- rep* [p1 p2 ret splice form] (when p1 (let [r {::op ::rep, :p2 p2, :splice splice, :forms form :id (java.util.UUID/randomUUID)}] (if (accept? p1) (assoc r :p1 p2 :ret (conj ret (:ret p1))) (assoc r :p1 p1, :ret ret))))) (defn ^:skip-wiki rep-impl "Do not call this directly, use '*'" [form p] (rep* p p [] false form)) (defn ^:skip-wiki rep+impl "Do not call this directly, use '+'" [form p] (pcat* {:ps [p (rep* p p [] true form)] :forms `[~form (* ~form)] :ret [] :rep+ form})) (defn ^:skip-wiki amp-impl "Do not call this directly, use '&'" [re re-form preds pred-forms] {::op ::amp :p1 re :amp re-form :ps preds :forms pred-forms}) (defn- filter-alt [ps ks forms f] (if (c/or ks forms) (let [pks (->> (map vector ps (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil))) (filter #(-> % first f)))] [(seq (map first pks)) (when ks (seq (map second pks))) (when forms (seq (map #(nth % 2) pks)))]) [(seq (filter f ps)) ks forms])) (defn- alt* [ps ks forms] (let [[[p1 & pr :as ps] [k1 :as ks] forms] (filter-alt ps ks forms identity)] (when ps (let [ret {::op ::alt, :ps ps, :ks ks :forms forms}] (if (nil? pr) (if k1 (if (accept? p1) (accept (tagged-ret k1 (:ret p1))) ret) p1) ret))))) (defn- alts [& ps] (alt* ps nil nil)) (defn- alt2 [p1 p2] (if (c/and p1 p2) (alts p1 p2) (c/or p1 p2))) (defn ^:skip-wiki alt-impl "Do not call this directly, use 'alt'" [ks ps forms] (assoc (alt* ps ks forms) :id (java.util.UUID/randomUUID))) (defn ^:skip-wiki maybe-impl "Do not call this directly, use '?'" [p form] (assoc (alt* [p (accept ::nil)] nil [form ::nil]) :maybe form)) (defn- noret? [p1 pret] (c/or (= pret ::nil) (c/and (#{::rep ::pcat} (::op (reg-resolve! p1))) ;;hrm, shouldn't know these (empty? pret)) nil)) (declare preturn) (defn- accept-nil? [p] (let [{:keys [::op ps p1 p2 forms] :as p} (reg-resolve! p)] (case op ::accept true nil nil ::amp (c/and (accept-nil? p1) (let [ret (-> (preturn p1) (and-preds ps (next forms)))] (not (invalid? ret)))) ::rep (c/or (identical? p1 p2) (accept-nil? p1)) ::pcat (every? accept-nil? ps) ::alt (c/some accept-nil? ps)))) (declare add-ret) (defn- preturn [p] (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms] :as p} (reg-resolve! p)] (case op ::accept ret nil nil ::amp (let [pret (preturn p1)] (if (noret? p1 pret) ::nil (and-preds pret ps forms))) ::rep (add-ret p1 ret k) ::pcat (add-ret p0 ret k) ::alt (let [[[p0] [k0]] (filter-alt ps ks forms accept-nil?) r (if (nil? p0) ::nil (preturn p0))] (if k0 (tagged-ret k0 r) r))))) (defn- op-unform [p x] ;;(prn {:p p :x x}) (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms rep+ maybe] :as p} (reg-resolve! p) kps (zipmap ks ps)] (case op ::accept [ret] nil [(unform p x)] ::amp (let [px (reduce #(unform %2 %1) x (reverse ps))] (op-unform p1 px)) ::rep (mapcat #(op-unform p1 %) x) ::pcat (if rep+ (mapcat #(op-unform p0 %) x) (mapcat (fn [k] (when (contains? x k) (op-unform (kps k) (get x k)))) ks)) ::alt (if maybe [(unform p0 x)] (let [[k v] x] (op-unform (kps k) v)))))) (defn- add-ret [p r k] (let [{:keys [::op ps splice] :as p} (reg-resolve! p) prop #(let [ret (preturn p)] (if (empty? ret) r ((if splice into conj) r (if k {k ret} ret))))] (case op nil r (::alt ::accept ::amp) (let [ret (preturn p)] ;;(prn {:ret ret}) (if (= ret ::nil) r (conj r (if k {k ret} ret)))) (::rep ::pcat) (prop)))) (defn- deriv [p x] (let [{[p0 & pr :as ps] :ps, [k0 & kr :as ks] :ks, :keys [::op p1 p2 ret splice forms amp] :as p} (reg-resolve! p)] (when p (case op ::accept nil nil (let [ret (dt p x p)] (when-not (invalid? ret) (accept ret))) ::amp (when-let [p1 (deriv p1 x)] (if (= ::accept (::op p1)) (let [ret (-> (preturn p1) (and-preds ps (next forms)))] (when-not (invalid? ret) (accept ret))) (amp-impl p1 amp ps forms))) ::pcat (alt2 (pcat* {:ps (cons (deriv p0 x) pr), :ks ks, :forms forms, :ret ret}) (when (accept-nil? p0) (deriv (pcat* {:ps pr, :ks kr, :forms (next forms), :ret (add-ret p0 ret k0)}) x))) ::alt (alt* (map #(deriv % x) ps) ks forms) ::rep (alt2 (rep* (deriv p1 x) p2 ret splice forms) (when (accept-nil? p1) (deriv (rep* p2 p2 (add-ret p1 ret nil) splice forms) x))))))) (defn- op-describe [p] (let [{:keys [::op ps ks forms splice p1 rep+ maybe amp] :as p} (reg-resolve! p)] ;;(prn {:op op :ks ks :forms forms :p p}) (when p (case op ::accept nil nil p ::amp (list* 'clojure.spec.alpha/& amp forms) ::pcat (if rep+ (list `+ rep+) (cons `cat (mapcat vector (c/or (seq ks) (repeat :_)) forms))) ::alt (if maybe (list `? maybe) (cons `alt (mapcat vector ks forms))) ::rep (list (if splice `+ `*) forms))))) (defn- op-explain [form p path via in input] ;;(prn {:form form :p p :path path :input input}) (let [[x :as input] input {:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve! p) via (if-let [name (spec-name p)] (conj via name) via) insufficient (fn [path form] [{:path path :reason "Insufficient input" :pred form :val () :via via :in in}])] (when p (case op ::accept nil nil (if (empty? input) (insufficient path form) (explain-1 form p path via in x)) ::amp (if (empty? input) (if (accept-nil? p1) (explain-pred-list forms ps path via in (preturn p1)) (insufficient path (:amp p))) (if-let [p1 (deriv p1 x)] (explain-pred-list forms ps path via in (preturn p1)) (op-explain (:amp p) p1 path via in input))) ::pcat (let [pkfs (map vector ps (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil))) [pred k form] (if (= 1 (count pkfs)) (first pkfs) (first (remove (fn [[p]] (accept-nil? p)) pkfs))) path (if k (conj path k) path) form (c/or form (op-describe pred))] (if (c/and (empty? input) (not pred)) (insufficient path form) (op-explain form pred path via in input))) ::alt (if (empty? input) (insufficient path (op-describe p)) (apply concat (map (fn [k form pred] (op-explain (c/or form (op-describe pred)) pred (if k (conj path k) path) via in input)) (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil)) ps))) ::rep (op-explain (if (identical? p1 p2) forms (op-describe p1)) p1 path via in input))))) (defn- re-gen [p overrides path rmap f] ;;(prn {:op op :ks ks :forms forms}) (let [origp p {:keys [::op ps ks p1 p2 forms splice ret id ::gfn] :as p} (reg-resolve! p) rmap (if id (inck rmap id) rmap) ggens (fn [ps ks forms] (let [gen (fn [p k f] ;;(prn {:k k :path path :rmap rmap :op op :id id}) (when-not (c/and rmap id k (recur-limit? rmap id path k)) (if id (gen/delay (re-gen p overrides (if k (conj path k) path) rmap (c/or f p))) (re-gen p overrides (if k (conj path k) path) rmap (c/or f p)))))] (map gen ps (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil)))))] (c/or (when-let [gfn (c/or (get overrides (spec-name origp)) (get overrides (spec-name p) ) (get overrides path))] (case op (:accept nil) (gen/fmap vector (gfn)) (gfn))) (when gfn (gfn)) (when p (case op ::accept (if (= ret ::nil) (gen/return []) (gen/return [ret])) nil (when-let [g (gensub p overrides path rmap f)] (gen/fmap vector g)) ::amp (re-gen p1 overrides path rmap (op-describe p1)) ::pcat (let [gens (ggens ps ks forms)] (when (every? identity gens) (apply gen/cat gens))) ::alt (let [gens (remove nil? (ggens ps ks forms))] (when-not (empty? gens) (gen/one-of gens))) ::rep (if (recur-limit? rmap id [id] id) (gen/return []) (when-let [g (re-gen p2 overrides path rmap forms)] (gen/fmap #(apply concat %) (gen/vector g))))))))) (defn- re-conform [p [x & xs :as data]] ;;(prn {:p p :x x :xs xs}) (if (empty? data) (if (accept-nil? p) (let [ret (preturn p)] (if (= ret ::nil) nil ret)) ::invalid) (if-let [dp (deriv p x)] (recur dp xs) ::invalid))) (defn- re-explain [path via in re input] (loop [p re [x & xs :as data] input i 0] ;;(prn {:p p :x x :xs xs :re re}) (prn) (if (empty? data) (if (accept-nil? p) nil ;;success (op-explain (op-describe p) p path via in nil)) (if-let [dp (deriv p x)] (recur dp xs (inc i)) (if (accept? p) (if (= (::op p) ::pcat) (op-explain (op-describe p) p path via (conj in i) (seq data)) [{:path path :reason "Extra input" :pred (op-describe re) :val data :via via :in (conj in i)}]) (c/or (op-explain (op-describe p) p path via (conj in i) (seq data)) [{:path path :reason "Extra input" :pred (op-describe p) :val data :via via :in (conj in i)}])))))) (defn ^:skip-wiki regex-spec-impl "Do not call this directly, use 'spec' with a regex op argument" [re gfn] (reify Specize (specize* [s] s) (specize* [s _] s) Spec (conform* [_ x] (if (c/or (nil? x) (sequential? x)) (re-conform re (seq x)) ::invalid)) (unform* [_ x] (op-unform re x)) (explain* [_ path via in x] (if (c/or (nil? x) (sequential? x)) (re-explain path via in re (seq x)) [{:path path :pred (res `#(c/or (nil? %) (sequential? %))) :val x :via via :in in}])) (gen* [_ overrides path rmap] (if gfn (gfn) (re-gen re overrides path rmap (op-describe re)))) (with-gen* [_ gfn] (regex-spec-impl re gfn)) (describe* [_] (op-describe re)))) ;;;;;;;;;;;;;;;;; HOFs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- call-valid? [f specs args] (let [cargs (conform (:args specs) args)] (when-not (invalid? cargs) (let [ret (apply f args) cret (conform (:ret specs) ret)] (c/and (not (invalid? cret)) (if (:fn specs) (pvalid? (:fn specs) {:args cargs :ret cret}) true)))))) (defn- validate-fn "returns f if valid, else smallest" [f specs iters] (let [g (gen (:args specs)) prop (gen/for-all* [g] #(call-valid? f specs %))] (let [ret (gen/quick-check iters prop)] (if-let [[smallest] (-> ret :shrunk :smallest)] smallest f)))) (defn ^:skip-wiki fspec-impl "Do not call this directly, use 'fspec'" [argspec aform retspec rform fnspec fform gfn] (let [specs {:args argspec :ret retspec :fn fnspec}] (reify clojure.lang.ILookup (valAt [this k] (get specs k)) (valAt [_ k not-found] (get specs k not-found)) Specize (specize* [s] s) (specize* [s _] s) Spec (conform* [this f] (if argspec (if (ifn? f) (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid) ::invalid) (throw (Exception. (str "Can't conform fspec without args spec: " (pr-str (describe this))))))) (unform* [_ f] f) (explain* [_ path via in f] (if (ifn? f) (let [args (validate-fn f specs 100)] (if (identical? f args) ;;hrm, we might not be able to reproduce nil (let [ret (try (apply f args) (catch Throwable t t))] (if (instance? Throwable ret) ;;TODO add exception data [{:path path :pred '(apply fn) :val args :reason (.getMessage ^Throwable ret) :via via :in in}] (let [cret (dt retspec ret rform)] (if (invalid? cret) (explain-1 rform retspec (conj path :ret) via in ret) (when fnspec (let [cargs (conform argspec args)] (explain-1 fform fnspec (conj path :fn) via in {:args cargs :ret cret}))))))))) [{:path path :pred 'ifn? :val f :via via :in in}])) (gen* [_ overrides _ _] (if gfn (gfn) (gen/return (fn [& args] (c/assert (pvalid? argspec args) (with-out-str (explain argspec args))) (gen/generate (gen retspec overrides)))))) (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn)) (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; non-primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (clojure.spec.alpha/def ::kvs->map (conformer #(zipmap (map ::k %) (map ::v %)) #(map (fn [[k v]] {::k k ::v v}) %))) (defmacro keys* "takes the same arguments as spec/keys and returns a regex op that matches sequences of key/values, converts them into a map, and conforms that map with a corresponding spec/keys call: user=> (s/conform (s/keys :req-un [::a ::c]) {:a 1 :c 2}) {:a 1, :c 2} user=> (s/conform (s/keys* :req-un [::a ::c]) [:a 1 :c 2]) {:a 1, :c 2} the resulting regex op can be composed into a larger regex: user=> (s/conform (s/cat :i1 integer? :m (s/keys* :req-un [::a ::c]) :i2 integer?) [42 :a 1 :c 2 :d 4 99]) {:i1 42, :m {:a 1, :c 2, :d 4}, :i2 99}" [& kspecs] `(let [mspec# (keys ~@kspecs)] (with-gen (clojure.spec.alpha/& (* (cat ::k keyword? ::v any?)) ::kvs->map mspec#) (fn [] (gen/fmap (fn [m#] (apply concat m#)) (gen mspec#)))))) (defn ^:skip-wiki nonconforming "takes a spec and returns a spec that has the same properties except 'conform' returns the original (not the conformed) value. Note, will specize regex ops." [spec] (let [spec (delay (specize spec))] (reify Specize (specize* [s] s) (specize* [s _] s) Spec (conform* [_ x] (let [ret (conform* @spec x)] (if (invalid? ret) ::invalid x))) (unform* [_ x] x) (explain* [_ path via in x] (explain* @spec path via in x)) (gen* [_ overrides path rmap] (gen* @spec overrides path rmap)) (with-gen* [_ gfn] (nonconforming (with-gen* @spec gfn))) (describe* [_] `(nonconforming ~(describe* @spec)))))) (defn ^:skip-wiki nilable-impl "Do not call this directly, use 'nilable'" [form pred gfn] (let [spec (delay (specize pred form))] (reify Specize (specize* [s] s) (specize* [s _] s) Spec (conform* [_ x] (if (nil? x) nil (conform* @spec x))) (unform* [_ x] (if (nil? x) nil (unform* @spec x))) (explain* [_ path via in x] (when-not (c/or (pvalid? @spec x) (nil? x)) (conj (explain-1 form pred (conj path ::pred) via in x) {:path (conj path ::nil) :pred 'nil? :val x :via via :in in}))) (gen* [_ overrides path rmap] (if gfn (gfn) (gen/frequency [[1 (gen/delay (gen/return nil))] [9 (gen/delay (gensub pred overrides (conj path ::pred) rmap form))]]))) (with-gen* [_ gfn] (nilable-impl form pred gfn)) (describe* [_] `(nilable ~(res form)))))) (defmacro nilable "returns a spec that accepts nil and values satisfying pred" [pred] (let [pf (res pred)] `(nilable-impl '~pf ~pred nil))) (defn exercise "generates a number (default 10) of values compatible with spec and maps conform over them, returning a sequence of [val conformed-val] tuples. Optionally takes a generator overrides map as per gen" ([spec] (exercise spec 10)) ([spec n] (exercise spec n nil)) ([spec n overrides] (map #(vector % (conform spec %)) (gen/sample (gen spec overrides) n)))) (defn exercise-fn "exercises the fn named by sym (a symbol) by applying it to n (default 10) generated samples of its args spec. When fspec is supplied its arg spec is used, and sym-or-f can be a fn. Returns a sequence of tuples of [args ret]. " ([sym] (exercise-fn sym 10)) ([sym n] (exercise-fn sym n (get-spec sym))) ([sym-or-f n fspec] (let [f (if (symbol? sym-or-f) (resolve sym-or-f) sym-or-f)] (if-let [arg-spec (c/and fspec (:args fspec))] (for [args (gen/sample (gen arg-spec) n)] [args (apply f args)]) (throw (Exception. "No :args spec found, can't generate")))))) (defn inst-in-range? "Return true if inst at or after start and before end" [start end inst] (c/and (inst? inst) (let [t (inst-ms inst)] (c/and (<= (inst-ms start) t) (< t (inst-ms end)))))) (defmacro inst-in "Returns a spec that validates insts in the range from start (inclusive) to end (exclusive)." [start end] `(let [st# (inst-ms ~start) et# (inst-ms ~end) mkdate# (fn [d#] (java.util.Date. ^{:tag ~'long} d#))] (spec (and inst? #(inst-in-range? ~start ~end %)) :gen (fn [] (gen/fmap mkdate# (gen/large-integer* {:min st# :max et#})))))) (defn int-in-range? "Return true if start <= val, val < end and val is a fixed precision integer." [start end val] (c/and (int? val) (<= start val) (< val end))) (defmacro int-in "Returns a spec that validates fixed precision integers in the range from start (inclusive) to end (exclusive)." [start end] `(spec (and int? #(int-in-range? ~start ~end %)) :gen #(gen/large-integer* {:min ~start :max (dec ~end)}))) (defmacro double-in "Specs a 64-bit floating point number. Options: :infinite? - whether +/- infinity allowed (default true) :NaN? - whether NaN allowed (default true) :min - minimum value (inclusive, default none) :max - maximum value (inclusive, default none)" [& {:keys [infinite? NaN? min max] :or {infinite? true NaN? true} :as m}] `(spec (and c/double? ~@(when-not infinite? '[#(not (Double/isInfinite %))]) ~@(when-not NaN? '[#(not (Double/isNaN %))]) ~@(when max `[#(<= % ~max)]) ~@(when min `[#(<= ~min %)])) :gen #(gen/double* ~m))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; assert ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defonce ^{:dynamic true :doc "If true, compiler will enable spec asserts, which are then subject to runtime control via check-asserts? If false, compiler will eliminate all spec assert overhead. See 'assert'. Initially set to boolean value of clojure.spec.compile-asserts system property. Defaults to true."} *compile-asserts* (not= "false" (System/getProperty "clojure.spec.compile-asserts"))) (defn check-asserts? "Returns the value set by check-asserts." [] clojure.lang.RT/checkSpecAsserts) (defn check-asserts "Enable or disable spec asserts that have been compiled with '*compile-asserts*' true. See 'assert'. Initially set to boolean value of clojure.spec.check-asserts system property. Defaults to false." [flag] (set! (. clojure.lang.RT checkSpecAsserts) flag)) (defn assert* "Do not call this directly, use 'assert'." [spec x] (if (valid? spec x) x (let [ed (c/merge (assoc (explain-data* spec [] [] [] x) ::failure :assertion-failed))] (throw (ex-info (str "Spec assertion failed\n" (with-out-str (explain-out ed))) ed))))) (defmacro assert "spec-checking assert expression. Returns x if x is valid? according to spec, else throws an ex-info with explain-data plus ::failure of :assertion-failed. Can be disabled at either compile time or runtime: If *compile-asserts* is false at compile time, compiles to x. Defaults to value of 'clojure.spec.compile-asserts' system property, or true if not set. If (check-asserts?) is false at runtime, always returns x. Defaults to value of 'clojure.spec.check-asserts' system property, or false if not set. You can toggle check-asserts? with (check-asserts bool)." [spec x] (if *compile-asserts* `(if clojure.lang.RT/checkSpecAsserts (assert* ~spec ~x) ~x) x)) spec.alpha-spec.alpha-0.2.176/src/main/clojure/clojure/spec/gen/000077500000000000000000000000001334362137700242565ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/src/main/clojure/clojure/spec/gen/alpha.clj000066400000000000000000000164111334362137700260400ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns clojure.spec.gen.alpha (:refer-clojure :exclude [boolean bytes cat hash-map list map not-empty set vector char double int keyword symbol string uuid delay shuffle])) (alias 'c 'clojure.core) (defonce ^:private dynalock (Object.)) (defn- dynaload [s] (let [ns (namespace s)] (assert ns) (locking dynalock (require (c/symbol ns))) (let [v (resolve s)] (if v @v (throw (RuntimeException. (str "Var " s " is not on the classpath"))))))) (def ^:private quick-check-ref (c/delay (dynaload 'clojure.test.check/quick-check))) (defn quick-check [& args] (apply @quick-check-ref args)) (def ^:private for-all*-ref (c/delay (dynaload 'clojure.test.check.properties/for-all*))) (defn for-all* "Dynamically loaded clojure.test.check.properties/for-all*." [& args] (apply @for-all*-ref args)) (let [g? (c/delay (dynaload 'clojure.test.check.generators/generator?)) g (c/delay (dynaload 'clojure.test.check.generators/generate)) mkg (c/delay (dynaload 'clojure.test.check.generators/->Generator))] (defn- generator? [x] (@g? x)) (defn- generator [gfn] (@mkg gfn)) (defn generate "Generate a single value using generator." [generator] (@g generator))) (defn ^:skip-wiki delay-impl [gfnd] ;;N.B. depends on test.check impl details (generator (fn [rnd size] ((:gen @gfnd) rnd size)))) (defmacro delay "given body that returns a generator, returns a generator that delegates to that, but delays creation until used." [& body] `(delay-impl (c/delay ~@body))) (defn gen-for-name "Dynamically loads test.check generator named s." [s] (let [g (dynaload s)] (if (generator? g) g (throw (RuntimeException. (str "Var " s " is not a generator")))))) (defmacro ^:skip-wiki lazy-combinator "Implementation macro, do not call directly." [s] (let [fqn (c/symbol "clojure.test.check.generators" (name s)) doc (str "Lazy loaded version of " fqn)] `(let [g# (c/delay (dynaload '~fqn))] (defn ~s ~doc [& ~'args] (apply @g# ~'args))))) (defmacro ^:skip-wiki lazy-combinators "Implementation macro, do not call directly." [& syms] `(do ~@(c/map (fn [s] (c/list 'lazy-combinator s)) syms))) (lazy-combinators hash-map list map not-empty set vector vector-distinct fmap elements bind choose fmap one-of such-that tuple sample return large-integer* double* frequency shuffle) (defmacro ^:skip-wiki lazy-prim "Implementation macro, do not call directly." [s] (let [fqn (c/symbol "clojure.test.check.generators" (name s)) doc (str "Fn returning " fqn)] `(let [g# (c/delay (dynaload '~fqn))] (defn ~s ~doc [& ~'args] @g#)))) (defmacro ^:skip-wiki lazy-prims "Implementation macro, do not call directly." [& syms] `(do ~@(c/map (fn [s] (c/list 'lazy-prim s)) syms))) (lazy-prims any any-printable boolean bytes char char-alpha char-alphanumeric char-ascii double int keyword keyword-ns large-integer ratio simple-type simple-type-printable string string-ascii string-alphanumeric symbol symbol-ns uuid) (defn cat "Returns a generator of a sequence catenated from results of gens, each of which should generate something sequential." [& gens] (fmap #(apply concat %) (apply tuple gens))) (defn- qualified? [ident] (not (nil? (namespace ident)))) (def ^:private gen-builtins (c/delay (let [simple (simple-type-printable)] {any? (one-of [(return nil) (any-printable)]) some? (such-that some? (any-printable)) number? (one-of [(large-integer) (double)]) integer? (large-integer) int? (large-integer) pos-int? (large-integer* {:min 1}) neg-int? (large-integer* {:max -1}) nat-int? (large-integer* {:min 0}) float? (double) double? (double) boolean? (boolean) string? (string-alphanumeric) ident? (one-of [(keyword-ns) (symbol-ns)]) simple-ident? (one-of [(keyword) (symbol)]) qualified-ident? (such-that qualified? (one-of [(keyword-ns) (symbol-ns)])) keyword? (keyword-ns) simple-keyword? (keyword) qualified-keyword? (such-that qualified? (keyword-ns)) symbol? (symbol-ns) simple-symbol? (symbol) qualified-symbol? (such-that qualified? (symbol-ns)) uuid? (uuid) uri? (fmap #(java.net.URI/create (str "http://" % ".com")) (uuid)) decimal? (fmap #(BigDecimal/valueOf %) (double* {:infinite? false :NaN? false})) inst? (fmap #(java.util.Date. %) (large-integer)) seqable? (one-of [(return nil) (list simple) (vector simple) (map simple simple) (set simple) (string-alphanumeric)]) indexed? (vector simple) map? (map simple simple) vector? (vector simple) list? (list simple) seq? (list simple) char? (char) set? (set simple) nil? (return nil) false? (return false) true? (return true) zero? (return 0) rational? (one-of [(large-integer) (ratio)]) coll? (one-of [(map simple simple) (list simple) (vector simple) (set simple)]) empty? (elements [nil '() [] {} #{}]) associative? (one-of [(map simple simple) (vector simple)]) sequential? (one-of [(list simple) (vector simple)]) ratio? (such-that ratio? (ratio)) bytes? (bytes)}))) (defn gen-for-pred "Given a predicate, returns a built-in generator if one exists." [pred] (if (set? pred) (elements pred) (get @gen-builtins pred))) (comment (require :reload 'clojure.spec.gen.alpha) (in-ns 'clojure.spec.gen.alpha) ;; combinators, see call to lazy-combinators above for complete list (generate (one-of [(gen-for-pred integer?) (gen-for-pred string?)])) (generate (such-that #(< 10000 %) (gen-for-pred integer?))) (let [reqs {:a (gen-for-pred number?) :b (gen-for-pred ratio?)} opts {:c (gen-for-pred string?)}] (generate (bind (choose 0 (count opts)) #(let [args (concat (seq reqs) (c/shuffle (seq opts)))] (->> args (take (+ % (count reqs))) (mapcat identity) (apply hash-map)))))) (generate (cat (list (gen-for-pred string?)) (list (gen-for-pred ratio?)))) ;; load your own generator (gen-for-name 'clojure.test.check.generators/int) ;; failure modes (gen-for-name 'unqualified) (gen-for-name 'clojure.core/+) (gen-for-name 'clojure.core/name-does-not-exist) (gen-for-name 'ns.does.not.exist/f) ) spec.alpha-spec.alpha-0.2.176/src/main/clojure/clojure/spec/test/000077500000000000000000000000001334362137700244645ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/src/main/clojure/clojure/spec/test/alpha.clj000066400000000000000000000364041334362137700262520ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns clojure.spec.test.alpha (:refer-clojure :exclude [test]) (:require [clojure.pprint :as pp] [clojure.spec.alpha :as s] [clojure.spec.gen.alpha :as gen] [clojure.string :as str])) (in-ns 'clojure.spec.test.check) (in-ns 'clojure.spec.test.alpha) (alias 'stc 'clojure.spec.test.check) (defn- throwable? [x] (instance? Throwable x)) (defn ->sym [x] (@#'s/->sym x)) (defn- ->var [s-or-v] (if (var? s-or-v) s-or-v (let [v (and (symbol? s-or-v) (resolve s-or-v))] (if (var? v) v (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var"))))))) (defn- collectionize [x] (if (symbol? x) (list x) x)) (defn enumerate-namespace "Given a symbol naming an ns, or a collection of such symbols, returns the set of all symbols naming vars in those nses." [ns-sym-or-syms] (into #{} (mapcat (fn [ns-sym] (map (fn [name-sym] (symbol (name ns-sym) (name name-sym))) (keys (ns-interns ns-sym))))) (collectionize ns-sym-or-syms))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^:private ^:dynamic *instrument-enabled* "if false, instrumented fns call straight through" true) (defn- fn-spec? "Fn-spec must include at least :args or :ret specs." [m] (or (:args m) (:ret m))) (defmacro with-instrument-disabled "Disables instrument's checking of calls, within a scope." [& body] `(binding [*instrument-enabled* nil] ~@body)) (defn- interpret-stack-trace-element "Given the vector-of-syms form of a stacktrace element produced by e.g. Throwable->map, returns a map form that adds some keys guessing the original Clojure names. Returns a map with :class class name symbol from stack trace :method method symbol from stack trace :file filename from stack trace :line line number from stack trace :var-scope optional Clojure var symbol scoping fn def :local-fn optional local Clojure symbol scoping fn def For non-Clojure fns, :scope and :local-fn will be absent." [[cls method file line]] (let [clojure? (contains? '#{invoke invokeStatic} method) demunge #(clojure.lang.Compiler/demunge %) degensym #(str/replace % #"--.*" "") [ns-sym name-sym local] (when clojure? (->> (str/split (str cls) #"\$" 3) (map demunge)))] (merge {:file file :line line :method method :class cls} (when (and ns-sym name-sym) {:var-scope (symbol ns-sym name-sym)}) (when local {:local-fn (symbol (degensym local))})))) (defn- stacktrace-relevant-to-instrument "Takes a coll of stack trace elements (as returned by StackTraceElement->vec) and returns a coll of maps as per interpret-stack-trace-element that are relevant to a failure in instrument." [elems] (let [plumbing? (fn [{:keys [var-scope]}] (contains? '#{clojure.spec.test.alpha/spec-checking-fn} var-scope))] (sequence (comp (map StackTraceElement->vec) (map interpret-stack-trace-element) (filter :var-scope) (drop-while plumbing?)) elems))) (defn- spec-checking-fn [v f fn-spec] (let [fn-spec (@#'s/maybe-spec fn-spec) conform! (fn [v role spec data args] (let [conformed (s/conform spec data)] (if (= ::s/invalid conformed) (let [caller (->> (.getStackTrace (Thread/currentThread)) stacktrace-relevant-to-instrument first) ed (merge (assoc (s/explain-data* spec [] [] [] data) ::s/fn (->sym v) ::s/args args ::s/failure :instrument) (when caller {::caller (dissoc caller :class :method)}))] (throw (ex-info (str "Call to " v " did not conform to spec.") ed))) conformed)))] (fn [& args] (if *instrument-enabled* (with-instrument-disabled (when (:args fn-spec) (conform! v :args (:args fn-spec) args args)) (binding [*instrument-enabled* true] (.applyTo ^clojure.lang.IFn f args))) (.applyTo ^clojure.lang.IFn f args))))) (defn- no-fspec [v spec] (ex-info (str "Fn at " v " is not spec'ed.") {:var v :spec spec ::s/failure :no-fspec})) (defonce ^:private instrumented-vars (atom {})) (defn- instrument-choose-fn "Helper for instrument." [f spec sym {over :gen :keys [stub replace]}] (if (some #{sym} stub) (-> spec (s/gen over) gen/generate) (get replace sym f))) (defn- instrument-choose-spec "Helper for instrument" [spec sym {overrides :spec}] (get overrides sym spec)) (defn- instrument-1 [s opts] (when-let [v (resolve s)] (when-not (-> v meta :macro) (let [spec (s/get-spec v) {:keys [raw wrapped]} (get @instrumented-vars v) current @v to-wrap (if (= wrapped current) raw current) ospec (or (instrument-choose-spec spec s opts) (throw (no-fspec v spec))) ofn (instrument-choose-fn to-wrap ospec s opts) checked (spec-checking-fn v ofn ospec)] (alter-var-root v (constantly checked)) (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked}) (->sym v))))) (defn- unstrument-1 [s] (when-let [v (resolve s)] (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] (swap! instrumented-vars dissoc v) (let [current @v] (when (= wrapped current) (alter-var-root v (constantly raw)) (->sym v)))))) (defn- opt-syms "Returns set of symbols referenced by 'instrument' opts map" [opts] (reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))])) (defn- fn-spec-name? [s] (and (symbol? s) (not (some-> (resolve s) meta :macro)))) (defn instrumentable-syms "Given an opts map as per instrument, returns the set of syms that can be instrumented." ([] (instrumentable-syms nil)) ([opts] (assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys") (reduce into #{} [(filter fn-spec-name? (keys (s/registry))) (keys (:spec opts)) (:stub opts) (keys (:replace opts))]))) (defn instrument "Instruments the vars named by sym-or-syms, a symbol or collection of symbols, or all instrumentable vars if sym-or-syms is not specified. If a var has an :args fn-spec, sets the var's root binding to a fn that checks arg conformance (throwing an exception on failure) before delegating to the original fn. The opts map can be used to override registered specs, and/or to replace fn implementations entirely. Opts for symbols not included in sym-or-syms are ignored. This facilitates sharing a common options map across many different calls to instrument. The opts map may have the following keys: :spec a map from var-name symbols to override specs :stub a set of var-name symbols to be replaced by stubs :gen a map from spec names to generator overrides :replace a map from var-name symbols to replacement fns :spec overrides registered fn-specs with specs your provide. Use :spec overrides to provide specs for libraries that do not have them, or to constrain your own use of a fn to a subset of its spec'ed contract. :stub replaces a fn with a stub that checks :args, then uses the :ret spec to generate a return value. :gen overrides are used only for :stub generation. :replace replaces a fn with a fn that checks args conformance, then invokes the fn you provide, enabling arbitrary stubbing and mocking. :spec can be used in combination with :stub or :replace. Returns a collection of syms naming the vars instrumented." ([] (instrument (instrumentable-syms))) ([sym-or-syms] (instrument sym-or-syms nil)) ([sym-or-syms opts] (locking instrumented-vars (into [] (comp (filter (instrumentable-syms opts)) (distinct) (map #(instrument-1 % opts)) (remove nil?)) (collectionize sym-or-syms))))) (defn unstrument "Undoes instrument on the vars named by sym-or-syms, specified as in instrument. With no args, unstruments all instrumented vars. Returns a collection of syms naming the vars unstrumented." ([] (unstrument (map ->sym (keys @instrumented-vars)))) ([sym-or-syms] (locking instrumented-vars (into [] (comp (filter symbol?) (map unstrument-1) (remove nil?)) (collectionize sym-or-syms))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; testing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- explain-check [args spec v role] (ex-info "Specification-based check failed" (when-not (s/valid? spec v nil) (assoc (s/explain-data* spec [role] [] [] v) ::args args ::val v ::s/failure :check-failed)))) (defn- check-call "Returns true if call passes specs, otherwise *returns* an exception with explain-data + ::s/failure." [f specs args] (let [cargs (when (:args specs) (s/conform (:args specs) args))] (if (= cargs ::s/invalid) (explain-check args (:args specs) args :args) (let [ret (apply f args) cret (when (:ret specs) (s/conform (:ret specs) ret))] (if (= cret ::s/invalid) (explain-check args (:ret specs) ret :ret) (if (and (:args specs) (:ret specs) (:fn specs)) (if (s/valid? (:fn specs) {:args cargs :ret cret}) true (explain-check args (:fn specs) {:args cargs :ret cret} :fn)) true)))))) (defn- quick-check [f specs {gen :gen opts ::stc/opts}] (let [{:keys [num-tests] :or {num-tests 1000}} opts g (try (s/gen (:args specs) gen) (catch Throwable t t))] (if (throwable? g) {:result g} (let [prop (gen/for-all* [g] #(check-call f specs %))] (apply gen/quick-check num-tests prop (mapcat identity opts)))))) (defn- make-check-result "Builds spec result map." [check-sym spec test-check-ret] (merge {:spec spec ::stc/ret test-check-ret} (when check-sym {:sym check-sym}) (when-let [result (-> test-check-ret :result)] (when-not (true? result) {:failure result})) (when-let [shrunk (-> test-check-ret :shrunk)] {:failure (:result shrunk)}))) (defn- check-1 [{:keys [s f v spec]} opts] (let [re-inst? (and v (seq (unstrument s)) true) f (or f (when v @v)) specd (s/spec spec)] (try (cond (or (nil? f) (some-> v meta :macro)) {:failure (ex-info "No fn to spec" {::s/failure :no-fn}) :sym s :spec spec} (:args specd) (let [tcret (quick-check f specd opts)] (make-check-result s spec tcret)) :default {:failure (ex-info "No :args spec" {::s/failure :no-args-spec}) :sym s :spec spec}) (finally (when re-inst? (instrument s)))))) (defn- sym->check-map [s] (let [v (resolve s)] {:s s :v v :spec (when v (s/get-spec v))})) (defn- validate-check-opts [opts] (assert (every? ident? (keys (:gen opts))) "check :gen expects ident keys")) (defn check-fn "Runs generative tests for fn f using spec and opts. See 'check' for options and return." ([f spec] (check-fn f spec nil)) ([f spec opts] (validate-check-opts opts) (check-1 {:f f :spec spec} opts))) (defn checkable-syms "Given an opts map as per check, returns the set of syms that can be checked." ([] (checkable-syms nil)) ([opts] (validate-check-opts opts) (reduce into #{} [(filter fn-spec-name? (keys (s/registry))) (keys (:spec opts))]))) (defn check "Run generative tests for spec conformance on vars named by sym-or-syms, a symbol or collection of symbols. If sym-or-syms is not specified, check all checkable vars. The opts map includes the following optional keys, where stc aliases clojure.spec.test.check: ::stc/opts opts to flow through test.check/quick-check :gen map from spec names to generator overrides The ::stc/opts include :num-tests in addition to the keys documented by test.check. Generator overrides are passed to spec/gen when generating function args. Returns a lazy sequence of check result maps with the following keys :spec the spec tested :sym optional symbol naming the var tested :failure optional test failure ::stc/ret optional value returned by test.check/quick-check The value for :failure can be any exception. Exceptions thrown by spec itself will have an ::s/failure value in ex-data: :check-failed at least one checked return did not conform :no-args-spec no :args spec provided :no-fn no fn provided :no-fspec no fspec provided :no-gen unable to generate :args :instrument invalid args detected by instrument " ([] (check (checkable-syms))) ([sym-or-syms] (check sym-or-syms nil)) ([sym-or-syms opts] (->> (collectionize sym-or-syms) (filter (checkable-syms opts)) (pmap #(check-1 (sym->check-map %) opts))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check reporting ;;;;;;;;;;;;;;;;;;;;;;;; (defn- failure-type [x] (::s/failure (ex-data x))) (defn- unwrap-failure [x] (if (failure-type x) (ex-data x) x)) (defn- result-type "Returns the type of the check result. This can be any of the ::s/failure keywords documented in 'check', or: :check-passed all checked fn returns conformed :check-threw checked fn threw an exception" [ret] (let [failure (:failure ret)] (cond (nil? failure) :check-passed (failure-type failure) (failure-type failure) :default :check-threw))) (defn abbrev-result "Given a check result, returns an abbreviated version suitable for summary use." [x] (if (:failure x) (-> (dissoc x ::stc/ret) (update :spec s/describe) (update :failure unwrap-failure)) (dissoc x :spec ::stc/ret))) (defn summarize-results "Given a collection of check-results, e.g. from 'check', pretty prints the summary-result (default abbrev-result) of each. Returns a map with :total, the total number of results, plus a key with a count for each different :type of result." ([check-results] (summarize-results check-results abbrev-result)) ([check-results summary-result] (reduce (fn [summary result] (pp/pprint (summary-result result)) (-> summary (update :total inc) (update (result-type result) (fnil inc 0)))) {:total 0} check-results))) spec.alpha-spec.alpha-0.2.176/src/test/000077500000000000000000000000001334362137700175005ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/src/test/clojure/000077500000000000000000000000001334362137700211435ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/src/test/clojure/clojure/000077500000000000000000000000001334362137700226065ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/src/test/clojure/clojure/test_clojure/000077500000000000000000000000001334362137700253105ustar00rootroot00000000000000spec.alpha-spec.alpha-0.2.176/src/test/clojure/clojure/test_clojure/spec.clj000066400000000000000000000273351334362137700267460ustar00rootroot00000000000000(ns clojure.test-clojure.spec (:require [clojure.spec.alpha :as s] [clojure.spec.gen.alpha :as gen] [clojure.spec.test.alpha :as stest] [clojure.test :refer :all])) (set! *warn-on-reflection* true) (defmacro result-or-ex [x] `(try ~x (catch Throwable t# (.getName (class t#))))) (def even-count? #(even? (count %))) (defn submap? "Is m1 a subset of m2?" [m1 m2] (if (and (map? m1) (map? m2)) (every? (fn [[k v]] (and (contains? m2 k) (submap? v (get m2 k)))) m1) (= m1 m2))) (deftest conform-explain (let [a (s/and #(> % 5) #(< % 10)) o (s/or :s string? :k keyword?) c (s/cat :a string? :b keyword?) either (s/alt :a string? :b keyword?) star (s/* keyword?) plus (s/+ keyword?) opt (s/? keyword?) andre (s/& (s/* keyword?) even-count?) andre2 (s/& (s/* keyword?) #{[:a]}) m (s/map-of keyword? string?) mkeys (s/map-of (s/and keyword? (s/conformer name)) any?) mkeys2 (s/map-of (s/and keyword? (s/conformer name)) any? :conform-keys true) s (s/coll-of (s/spec (s/cat :tag keyword? :val any?)) :kind list?) v (s/coll-of keyword? :kind vector?) coll (s/coll-of keyword?) lrange (s/int-in 7 42) drange (s/double-in :infinite? false :NaN? false :min 3.1 :max 3.2) irange (s/inst-in #inst "1939" #inst "1946") ] (are [spec x conformed ed] (let [co (result-or-ex (s/conform spec x)) e (result-or-ex (::s/problems (s/explain-data spec x)))] (when (not= conformed co) (println "conform fail\n\texpect=" conformed "\n\tactual=" co)) (when (not (every? true? (map submap? ed e))) (println "explain failures\n\texpect=" ed "\n\tactual failures=" e "\n\tsubmap?=" (map submap? ed e))) (and (= conformed co) (every? true? (map submap? ed e)))) lrange 7 7 nil lrange 8 8 nil lrange 42 ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.spec.alpha/int-in-range? 7 42 %)), :val 42}] irange #inst "1938" ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.spec.alpha/inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %)), :val #inst "1938"}] irange #inst "1942" #inst "1942" nil irange #inst "1946" ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.spec.alpha/inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %)), :val #inst "1946"}] drange 3.0 ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.core/<= 3.1 %)), :val 3.0}] drange 3.1 3.1 nil drange 3.2 3.2 nil drange Double/POSITIVE_INFINITY ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.core/not (Double/isInfinite %))), :val Double/POSITIVE_INFINITY}] ;; can't use equality-based test for Double/NaN ;; drange Double/NaN ::s/invalid {[] {:pred '(clojure.core/fn [%] (clojure.core/not (Double/isNaN %))), :val Double/NaN}} keyword? :k :k nil keyword? nil ::s/invalid [{:pred `keyword? :val nil}] keyword? "abc" ::s/invalid [{:pred `keyword? :val "abc"}] a 6 6 nil a 3 ::s/invalid '[{:pred (clojure.core/fn [%] (clojure.core/> % 5)), :val 3}] a 20 ::s/invalid '[{:pred (clojure.core/fn [%] (clojure.core/< % 10)), :val 20}] a nil "java.lang.NullPointerException" "java.lang.NullPointerException" a :k "java.lang.ClassCastException" "java.lang.ClassCastException" o "a" [:s "a"] nil o :a [:k :a] nil o 'a ::s/invalid '[{:pred clojure.core/string?, :val a, :path [:s]} {:pred clojure.core/keyword?, :val a :path [:k]}] c nil ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/string?, :val (), :path [:a]}] c [] ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/string?, :val (), :path [:a]}] c [:a] ::s/invalid '[{:pred clojure.core/string?, :val :a, :path [:a], :in [0]}] c ["a"] ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/keyword?, :val (), :path [:b]}] c ["s" :k] '{:a "s" :b :k} nil c ["s" :k 5] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/cat :a clojure.core/string? :b clojure.core/keyword?), :val (5)}] (s/cat) nil {} nil (s/cat) [5] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/cat), :val (5), :in [0]}] either nil ::s/invalid '[{:reason "Insufficient input", :pred (clojure.spec.alpha/alt :a clojure.core/string? :b clojure.core/keyword?), :val () :via []}] either [] ::s/invalid '[{:reason "Insufficient input", :pred (clojure.spec.alpha/alt :a clojure.core/string? :b clojure.core/keyword?), :val () :via []}] either [:k] [:b :k] nil either ["s"] [:a "s"] nil either [:b "s"] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/alt :a clojure.core/string? :b clojure.core/keyword?), :val ("s") :via []}] star nil [] nil star [] [] nil star [:k] [:k] nil star [:k1 :k2] [:k1 :k2] nil star [:k1 :k2 "x"] ::s/invalid '[{:pred clojure.core/keyword?, :val "x" :via []}] star ["a"] ::s/invalid '[{:pred clojure.core/keyword?, :val "a" :via []}] plus nil ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/keyword?, :val () :via []}] plus [] ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/keyword?, :val () :via []}] plus [:k] [:k] nil plus [:k1 :k2] [:k1 :k2] nil plus [:k1 :k2 "x"] ::s/invalid '[{:pred clojure.core/keyword?, :val "x", :in [2]}] plus ["a"] ::s/invalid '[{:pred clojure.core/keyword?, :val "a" :via []}] opt nil nil nil opt [] nil nil opt :k ::s/invalid '[{:pred (clojure.core/fn [%] (clojure.core/or (clojure.core/nil? %) (clojure.core/sequential? %))), :val :k}] opt [:k] :k nil opt [:k1 :k2] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/? clojure.core/keyword?), :val (:k2)}] opt [:k1 :k2 "x"] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/? clojure.core/keyword?), :val (:k2 "x")}] opt ["a"] ::s/invalid '[{:pred clojure.core/keyword?, :val "a"}] andre nil nil nil andre [] nil nil andre :k :clojure.spec.alpha/invalid '[{:pred (clojure.core/fn [%] (clojure.core/or (clojure.core/nil? %) (clojure.core/sequential? %))), :val :k}] andre [:k] ::s/invalid '[{:pred clojure.test-clojure.spec/even-count?, :val [:k]}] andre [:j :k] [:j :k] nil andre2 nil :clojure.spec.alpha/invalid [{:pred #{[:a]}, :val []}] andre2 [] :clojure.spec.alpha/invalid [{:pred #{[:a]}, :val []}] andre2 [:a] [:a] nil m nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] m {} {} nil m {:a "b"} {:a "b"} nil mkeys nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] mkeys {} {} nil mkeys {:a 1 :b 2} {:a 1 :b 2} nil mkeys2 nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] mkeys2 {} {} nil mkeys2 {:a 1 :b 2} {"a" 1 "b" 2} nil s '([:a 1] [:b "2"]) '({:tag :a :val 1} {:tag :b :val "2"}) nil v [:a :b] [:a :b] nil v '(:a :b) ::s/invalid '[{:pred clojure.core/vector? :val (:a :b)}] coll nil ::s/invalid '[{:path [], :pred clojure.core/coll?, :val nil, :via [], :in []}] coll [] [] nil coll [:a] [:a] nil coll [:a :b] [:a :b] nil coll (map identity [:a :b]) '(:a :b) nil ;;coll [:a "b"] ::s/invalid '[{:pred (coll-checker keyword?), :val [:a b]}] ))) (deftest describing-evaled-specs (let [sp #{1 2}] (is (= (s/describe sp) (s/form sp) sp))) (is (= (s/describe odd?) 'odd?)) (is (= (s/form odd?) 'clojure.core/odd?)) (is (= (s/describe #(odd? %)) ::s/unknown)) (is (= (s/form #(odd? %)) ::s/unknown))) (defn check-conform-unform [spec vals expected-conforms] (let [actual-conforms (map #(s/conform spec %) vals) unforms (map #(s/unform spec %) actual-conforms)] (is (= actual-conforms expected-conforms)) (is (= vals unforms)))) (deftest nilable-conform-unform (check-conform-unform (s/nilable int?) [5 nil] [5 nil]) (check-conform-unform (s/nilable (s/or :i int? :s string?)) [5 "x" nil] [[:i 5] [:s "x"] nil])) (deftest nonconforming-conform-unform (check-conform-unform (s/nonconforming (s/or :i int? :s string?)) [5 "x"] [5 "x"])) (deftest coll-form (are [spec form] (= (s/form spec) form) (s/map-of int? any?) '(clojure.spec.alpha/map-of clojure.core/int? clojure.core/any?) (s/coll-of int?) '(clojure.spec.alpha/coll-of clojure.core/int?) (s/every-kv int? int?) '(clojure.spec.alpha/every-kv clojure.core/int? clojure.core/int?) (s/every int?) '(clojure.spec.alpha/every clojure.core/int?) (s/coll-of (s/tuple (s/tuple int?))) '(clojure.spec.alpha/coll-of (clojure.spec.alpha/tuple (clojure.spec.alpha/tuple clojure.core/int?))) (s/coll-of int? :kind vector?) '(clojure.spec.alpha/coll-of clojure.core/int? :kind clojure.core/vector?) (s/coll-of int? :gen #(gen/return [1 2])) '(clojure.spec.alpha/coll-of clojure.core/int? :gen (fn* [] (gen/return [1 2]))))) (deftest coll-conform-unform (check-conform-unform (s/coll-of (s/or :i int? :s string?)) [[1 "x"]] [[[:i 1] [:s "x"]]]) (check-conform-unform (s/every (s/or :i int? :s string?)) [[1 "x"]] [[1 "x"]]) (check-conform-unform (s/map-of int? (s/or :i int? :s string?)) [{10 10 20 "x"}] [{10 [:i 10] 20 [:s "x"]}]) (check-conform-unform (s/map-of (s/or :i int? :s string?) int? :conform-keys true) [{10 10 "x" 20}] [{[:i 10] 10 [:s "x"] 20}]) (check-conform-unform (s/every-kv int? (s/or :i int? :s string?)) [{10 10 20 "x"}] [{10 10 20 "x"}])) (deftest &-explain-pred (are [val expected] (= expected (-> (s/explain-data (s/& int? even?) val) ::s/problems first :pred)) [] 'clojure.core/int? [0 2] '(clojure.spec.alpha/& clojure.core/int? clojure.core/even?))) (deftest keys-explain-pred (is (= 'clojure.core/map? (-> (s/explain-data (s/keys :req [::x]) :a) ::s/problems first :pred)))) (deftest remove-def (is (= ::ABC (s/def ::ABC string?))) (is (= ::ABC (s/def ::ABC nil))) (is (nil? (s/get-spec ::ABC)))) ;; TODO replace this with a generative test once we have specs for s/keys (deftest map-spec-generators (s/def ::a nat-int?) (s/def ::b boolean?) (s/def ::c keyword?) (s/def ::d double?) (s/def ::e inst?) (is (= #{[::a] [::a ::b] [::a ::b ::c] [::a ::c]} (->> (s/exercise (s/keys :req [::a] :opt [::b ::c]) 100) (map (comp sort keys first)) (into #{})))) (is (= #{[:a] [:a :b] [:a :b :c] [:a :c]} (->> (s/exercise (s/keys :req-un [::a] :opt-un [::b ::c]) 100) (map (comp sort keys first)) (into #{})))) (is (= #{[::a ::b] [::a ::b ::c ::d] [::a ::b ::c ::d ::e] [::a ::b ::c ::e] [::a ::c ::d] [::a ::c ::d ::e] [::a ::c ::e]} (->> (s/exercise (s/keys :req [::a (or ::b (and ::c (or ::d ::e)))]) 200) (map (comp vec sort keys first)) (into #{})))) (is (= #{[:a :b] [:a :b :c :d] [:a :b :c :d :e] [:a :b :c :e] [:a :c :d] [:a :c :d :e] [:a :c :e]} (->> (s/exercise (s/keys :req-un [::a (or ::b (and ::c (or ::d ::e)))]) 200) (map (comp vec sort keys first)) (into #{}))))) (deftest tuple-explain-pred (are [val expected] (= expected (-> (s/explain-data (s/tuple int?) val) ::s/problems first :pred)) :a 'clojure.core/vector? [] '(clojure.core/= (clojure.core/count %) 1))) (comment (require '[clojure.test :refer (run-tests)]) (in-ns 'clojure.test-clojure.spec) (run-tests) )