├── VERSION_TEMPLATE
├── .gitignore
├── .github
    ├── workflows
    │   ├── snapshot.yml
    │   ├── release.yml
    │   └── test.yml
    └── PULL_REQUEST_TEMPLATE
├── script
    └── build
    │   ├── update_version
    │   ├── git_revision
    │   ├── branch_revision
    │   ├── trunk_revision
    │   └── revision
├── CONTRIBUTING.md
├── README.md
├── src
    ├── test
    │   └── clojure
    │   │   └── clojure
    │   │       └── test_clojure
    │   │           ├── multi_spec.clj
    │   │           ├── instr.clj
    │   │           └── spec.clj
    └── main
    │   └── clojure
    │       └── clojure
    │           └── spec
    │               ├── gen
    │                   └── alpha.clj
    │               ├── test
    │                   └── alpha.clj
    │               └── alpha.clj
├── pom.xml
├── CHANGES.md
├── LICENSE
└── epl-v10.html


/VERSION_TEMPLATE:
--------------------------------------------------------------------------------
1 | 0.5.GENERATED_VERSION
2 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | .idea
2 | *.jar
3 | *.iml
4 | /target/
5 | .lein*
6 | .nrepl-port
7 | 


--------------------------------------------------------------------------------
/.github/workflows/snapshot.yml:
--------------------------------------------------------------------------------
1 | name: Snapshot on demand
2 | 
3 | on: [workflow_dispatch]
4 | 
5 | jobs:
6 |   call-snapshot:
7 |     uses: clojure/build.ci/.github/workflows/snapshot.yml@master
8 |     secrets: inherit
9 | 


--------------------------------------------------------------------------------
/script/build/update_version:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env bash
2 | 
3 | set -e
4 | 
5 | mvn versions:set -DgenerateBackupPoms=false -DnewVersion=`script/build/revision`-SNAPSHOT
6 | git commit -m 'update version' pom.xml
7 | git push
8 | 


--------------------------------------------------------------------------------
/script/build/git_revision:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env bash
 2 | 
 3 | # Return the portion of the version number generated from git
 4 | # <trunk-basis>
 5 | 
 6 | set -e
 7 | 
 8 | trunk_basis=`script/build/trunk_revision`
 9 | sha=`git rev-parse HEAD`
10 | 
11 | sha=${sha:0:${#sha}-34} # drop the last 34 characters, keep 6
12 | 
13 | echo $trunk_basis
14 | 


--------------------------------------------------------------------------------
/script/build/branch_revision:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env bash
 2 | 
 3 | # If on a branch other than master, returns the number of commits made off of master
 4 | # If on master, returns 0
 5 | 
 6 | set -e
 7 | 
 8 | master_tag=`git rev-parse --abbrev-ref HEAD`
 9 | 
10 | if [ "$master_tag" == "master" ]; then
11 |     echo "0"
12 | else
13 |     last_commit=`git rev-parse HEAD`
14 |     revision=`git rev-list master..$last_commit | wc -l`
15 |     echo $revision
16 | fi
17 | 


--------------------------------------------------------------------------------
/script/build/trunk_revision:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env bash
 2 | 
 3 | # Returns the number of commits made since the v0.0 tag
 4 | 
 5 | set -e
 6 | 
 7 | REVISION=`git --no-replace-objects describe --match v0.0`
 8 | 
 9 | # Extract the version number from the string. Do this in two steps so
10 | # it is a little easier to understand.
11 | REVISION=${REVISION:5} # drop the first 5 characters
12 | REVISION=${REVISION:0:${#REVISION}-9} # drop the last 9 characters
13 | 
14 | echo $REVISION
15 | 


--------------------------------------------------------------------------------
/CONTRIBUTING.md:
--------------------------------------------------------------------------------
 1 | This is a [Clojure contrib] project.
 2 | 
 3 | Under the Clojure contrib [guidelines], this project cannot accept
 4 | pull requests. All patches must be submitted via [JIRA].
 5 | 
 6 | See [Contributing] on the Clojure website for
 7 | more information on how to contribute.
 8 | 
 9 | [Clojure contrib]: https://clojure.org/community/contrib_libs
10 | [Contributing]: https://clojure.org/community/contributing
11 | [JIRA]: https://clojure.atlassian.net/browse/CLJ
12 | [guidelines]: https://clojure.org/community/contrib_howto
13 | 


--------------------------------------------------------------------------------
/script/build/revision:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env bash
 2 | 
 3 | # Return the complete revision number
 4 | # <major>.<minor>.<trunk-basis>.<patch-or-0>-<sha>[-qualifier]
 5 | 
 6 | set -e
 7 | 
 8 | version_template=`cat VERSION_TEMPLATE`
 9 | 
10 | if [[ "$version_template" =~ ^[0-9]+\.[0-9]+\.GENERATED_VERSION(-[a-zA-Z0-9]+)?$ ]]; then
11 | 
12 |     git_revision=`script/build/git_revision`
13 |     echo ${version_template/GENERATED_VERSION/$git_revision}
14 | 
15 | else
16 |     echo "Invalid version template string: $version_template" >&2
17 |     exit -1
18 | fi
19 | 
20 | 


--------------------------------------------------------------------------------
/.github/workflows/release.yml:
--------------------------------------------------------------------------------
 1 | name: Release on demand
 2 | 
 3 | on:
 4 |   workflow_dispatch:
 5 |     inputs:
 6 |       releaseVersion:
 7 |         description: "Version to release"
 8 |         required: true
 9 |       snapshotVersion:
10 |         description: "Snapshot version after release"
11 |         required: true
12 | 
13 | jobs:
14 |   call-release:
15 |     uses: clojure/build.ci/.github/workflows/release.yml@master
16 |     with:
17 |       releaseVersion: ${{ github.event.inputs.releaseVersion }}
18 |       snapshotVersion: ${{ github.event.inputs.snapshotVersion }}
19 |     secrets: inherit


--------------------------------------------------------------------------------
/.github/workflows/test.yml:
--------------------------------------------------------------------------------
 1 | name: Test
 2 | 
 3 | on: [push]
 4 | 
 5 | jobs:
 6 |   test:
 7 |     strategy:
 8 |       matrix:
 9 |         os: [ubuntu-latest] # macOS-latest, windows-latest]
10 |         java-version: ["8", "11", "17"]
11 |         clojure-version: ["1.10.3", "1.11.1"]
12 |     runs-on: ${{ matrix.os }}
13 |     steps:
14 |     - uses: actions/checkout@v3
15 |     - name: Set up Java
16 |       uses: actions/setup-java@v3
17 |       with:
18 |         java-version: ${{ matrix.java-version }}
19 |         distribution: 'temurin'
20 |         cache: 'maven'
21 |     - name: Build with Maven
22 |       run: mvn -ntp -B -Dclojure.version=${{ matrix.clojure-version }} clean test
23 | 


--------------------------------------------------------------------------------
/.github/PULL_REQUEST_TEMPLATE:
--------------------------------------------------------------------------------
 1 | Hi! Thanks for your interest in contributing to this project.
 2 | 
 3 | Clojure contrib projects do not use GitHub issues or pull requests, and
 4 | require a signed Contributor Agreement. If you would like to contribute,
 5 | please read more about the CA and sign that first (this can be done online).
 6 | 
 7 | Then go to this project's issue tracker in JIRA to create tickets, update
 8 | tickets, or submit patches. For help in creating tickets and patches,
 9 | please see:
10 | 
11 | - Signing the CA: https://clojure.org/community/contributing
12 | - Creating Tickets: https://clojure.org/community/creating_tickets
13 | - Developing Patches: https://clojure.org/community/developing_patches
14 | - Contributing FAQ: https://clojure.org/community/contributing
15 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | spec.alpha
 2 | ========================================
 3 | 
 4 | 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.
 5 | 
 6 | 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.
 7 | 
 8 | NOTE: This library is alpha and subject to breaking changes. At a future point, there will be a non-alpha stable version of this library.
 9 | 
10 | For more information:
11 | 
12 | * Rationale - https://clojure.org/about/spec
13 | * Guide - https://clojure.org/guides/spec
14 | * Spec split notice - https://groups.google.com/forum/#!msg/clojure/10dbF7w2IQo/ec37TzP5AQAJ
15 | 
16 | Releases and Dependency Information
17 | ========================================
18 | 
19 | Latest stable release: 0.5.238
20 | 
21 | * [All Released Versions](https://search.maven.org/#search%7Cgav%7C1%7Cg%3A%22org.clojure%22%20AND%20a%3A%22spec.alpha%22)
22 | * [Development Snapshot Versions](https://oss.sonatype.org/index.html#nexus-search;gav~org.clojure~spec.alpha~~~)
23 | 
24 | [deps.edn](https://clojure.org/guides/deps_edn) dependency information:
25 | 
26 |     org.clojure/spec.alpha {:mvn/version "0.5.238"}
27 | 
28 | [Leiningen](https://github.com/technomancy/leiningen) dependency information:
29 | 
30 |     [org.clojure/spec.alpha "0.5.238"]
31 | 
32 | [Maven](https://maven.apache.org/) dependency information:
33 | 
34 |     <dependency>
35 |       <groupId>org.clojure</groupId>
36 |       <artifactId>spec.alpha</artifactId>
37 |       <version>0.5.238</version>
38 |     </dependency>
39 | 
40 | Developer Information
41 | ========================================
42 | 
43 | * [API docs](https://clojure.github.io/spec.alpha/)
44 | * [GitHub project](https://github.com/clojure/spec.alpha)
45 | * [Changelog](https://github.com/clojure/spec.alpha/blob/master/CHANGES.md)
46 | * [Bug Tracker](https://clojure.atlassian.net/browse/CLJ)
47 | * [Continuous Integration](https://github.com/clojure/spec.alpha/actions/workflows/test.yml)
48 | 
49 | Copyright and License
50 | ========================================
51 | 
52 | Copyright (c) Rich Hickey, and contributors, 2018-2023. All rights reserved.  The use and distribution terms for this software are covered by the Eclipse Public License 1.0 (https://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.
53 | 


--------------------------------------------------------------------------------
/src/test/clojure/clojure/test_clojure/multi_spec.clj:
--------------------------------------------------------------------------------
 1 | ;   Copyright (c) Rich Hickey. All rights reserved.
 2 | ;   The use and distribution terms for this software are covered by the
 3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
 4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
 5 | ;   By using this software in any fashion, you are agreeing to be bound by
 6 | ;   the terms of this license.
 7 | ;   You must not remove this notice, or any other, from this software.
 8 | 
 9 | (ns clojure.test-clojure.multi-spec
10 |   (:require [clojure.spec.alpha :as s]
11 |             [clojure.test :as test :refer [deftest is testing]]
12 |             [clojure.test-clojure.spec :refer [submap?]]))
13 | 
14 | (s/def :event/type keyword?)
15 | (s/def :event/timestamp int?)
16 | (s/def :search/url string?)
17 | (s/def :error/message string?)
18 | (s/def :error/code int?)
19 | 
20 | (defmulti event-type :event/type)
21 | (defmethod event-type :event/search [_]
22 |   (s/keys :req [:event/type :event/timestamp :search/url]))
23 | (defmethod event-type :event/error [_]
24 |   (s/keys :req [:event/type :event/timestamp :error/message :error/code]))
25 | 
26 | (s/def :event/event (s/multi-spec event-type :event/type))
27 | 
28 | (deftest multi-spec-test
29 |   (is (s/valid? :event/event
30 |         {:event/type :event/search
31 |          :event/timestamp 1463970123000
32 |          :search/url "https://clojure.org"}))
33 |   (is (s/valid? :event/event
34 |         {:event/type :event/error
35 |          :event/timestamp 1463970123000
36 |          :error/message "Invalid host"
37 |          :error/code 500}))
38 |   (is (submap?
39 |         '#:clojure.spec.alpha{:problems
40 |                               [{:path [:event/restart],
41 |                                 :pred clojure.test-clojure.multi-spec/event-type,
42 |                                 :val #:event{:type :event/restart}, :reason "no method", :via [:event/event], :in []}],
43 |                               :spec :event/event, :value #:event{:type :event/restart}}
44 |         (s/explain-data :event/event
45 |           {:event/type :event/restart})))
46 |   (is (submap?
47 |         '#:clojure.spec.alpha{:problems ({:path [:event/search],
48 |                                           :pred (clojure.core/fn [%] (clojure.core/contains? % :event/timestamp)),
49 |                                           :val {:event/type :event/search, :search/url 200},
50 |                                           :via [:event/event], :in []} {:path [:event/search :search/url],
51 |                                                                         :pred clojure.core/string?, :val 200,
52 |                                                                         :via [:event/event :search/url],
53 |                                                                         :in [:search/url]}), :spec
54 |                               :event/event, :value {:event/type :event/search, :search/url 200}}
55 |         (s/explain-data  :event/event
56 |           {:event/type :event/search
57 |            :search/url 200}))))


--------------------------------------------------------------------------------
/pom.xml:
--------------------------------------------------------------------------------
  1 | <?xml version="1.0" encoding="UTF-8"?>
  2 | <project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
  3 |   <modelVersion>4.0.0</modelVersion>
  4 |   <artifactId>spec.alpha</artifactId>
  5 |   <version>0.5.239-SNAPSHOT</version>
  6 |   <name>spec.alpha</name>
  7 |   <description>Specification of data and functions</description>
  8 | 
  9 |   <scm>
 10 |     <connection>scm:git:git://github.com/clojure/spec.alpha.git</connection>
 11 |     <developerConnection>scm:git:ssh://git@github.com/clojure/spec.alpha.git</developerConnection>
 12 |     <tag>HEAD</tag>
 13 |     <url>https://github.com/clojure/spec.alpha</url>
 14 |   </scm>
 15 | 
 16 |   <licenses>
 17 |     <license>
 18 |       <name>Eclipse Public License 1.0</name>
 19 |       <url>https://opensource.org/license/epl-1-0/</url>
 20 |       <distribution>repo</distribution>
 21 |     </license>
 22 |   </licenses>
 23 | 
 24 |   <parent>
 25 |     <groupId>org.clojure</groupId>
 26 |     <artifactId>pom.contrib</artifactId>
 27 |     <version>1.3.0</version>
 28 |   </parent>
 29 | 
 30 |   <developers>
 31 |     <developer>
 32 |       <id>richhickey</id>
 33 |       <name>Rich Hickey</name>
 34 |       <url>https://clojure.org</url>
 35 |     </developer>
 36 |   </developers>
 37 | 
 38 |   <properties>
 39 |     <clojure.version>1.11.4</clojure.version>
 40 |   </properties>
 41 | 
 42 |   <dependencies>
 43 |     <dependency>
 44 |       <groupId>org.clojure</groupId>
 45 |       <artifactId>clojure</artifactId>
 46 |       <version>${clojure.version}</version>
 47 |       <scope>provided</scope>
 48 |     </dependency>
 49 |     <dependency>
 50 |       <groupId>org.clojure</groupId>
 51 |       <artifactId>test.check</artifactId>
 52 |       <version>1.1.1</version>
 53 |       <scope>test</scope>
 54 |     </dependency>
 55 |   </dependencies>
 56 | 
 57 |   <build>
 58 |     <plugins>
 59 |       <plugin>
 60 |         <groupId>org.codehaus.mojo</groupId>
 61 |         <artifactId>exec-maven-plugin</artifactId>
 62 | 	<version>1.6.0</version>
 63 | 	<executions>
 64 |           <execution>
 65 |             <id>compile-clojure</id>
 66 |             <phase>compile</phase>
 67 |             <goals><goal>exec</goal></goals>
 68 |             <configuration>
 69 |               <executable>java</executable>
 70 |               <classpathScope>compile</classpathScope>
 71 |                 <arguments>
 72 |                 <argument>-Dclojure.compile.path=${project.build.directory}/classes</argument>
 73 |                 <argument>-Dclojure.spec.skip-macros=true</argument>
 74 |                 <argument>-classpath</argument>
 75 |                 <classpath />
 76 |                 <argument>clojure.lang.Compile</argument>
 77 |                 <argument>clojure.spec.alpha</argument>
 78 |                 <argument>clojure.spec.gen.alpha</argument>
 79 |                 <argument>clojure.spec.test.alpha</argument>
 80 |               </arguments>
 81 |             </configuration>
 82 |           </execution>
 83 |         </executions>
 84 |       </plugin>
 85 |       <plugin>
 86 |         <groupId>com.theoryinpractise</groupId>
 87 |         <artifactId>clojure-maven-plugin</artifactId>
 88 |         <version>1.7.1</version>
 89 |         <executions>
 90 |           <execution>
 91 |             <id>clojure-compile</id>
 92 |             <phase>none</phase>
 93 |           </execution>
 94 |           <execution>
 95 |             <id>clojure-test</id>
 96 |             <phase>test</phase>
 97 |           </execution>
 98 |         </executions>
 99 | 	<configuration>
100 |           <sourceDirectories>
101 |             <sourceDirectory>src/main/clojure</sourceDirectory>
102 |           </sourceDirectories>
103 |           <testSourceDirectories>
104 |             <testSourceDirectory>src/test/clojure</testSourceDirectory>
105 |           </testSourceDirectories>
106 |         </configuration>
107 |       </plugin>
108 |     </plugins>
109 |   </build>
110 | </project>
111 | 


--------------------------------------------------------------------------------
/CHANGES.md:
--------------------------------------------------------------------------------
 1 | # Change Log for spec.alpha
 2 | 
 3 | ## Version 0.5.238 on May 10, 2024
 4 | 
 5 | * Update dependency to Clojure 1.11.3
 6 | 
 7 | ## Version 0.4.233 on Feb 19, 2024
 8 | 
 9 | * Fix typo in docstring
10 | * Remove duplicated lazy combinator
11 | * Update parent pom and dependency to Clojure 1.11.1
12 | 
13 | ## Version 0.3.218 on Nov 26, 2021
14 | 
15 | * Update Clojure dependency to Clojure 1.10.3
16 | * Remove locking workaround
17 | * Add multi-spec tests
18 | 
19 | ## Version 0.3.214 on Nov 23, 2021
20 | 
21 | * [CLJ-2606](https://clojure.atlassian.net/browse/CLJ-2606) Add support to transform trailing maps on instrumented functions into kvs
22 | 
23 | ## Version 0.2.194 on Jan 5, 2021
24 | 
25 | * Type hint return value of s/explain-str
26 | * Update Clojure dependency to Clojure 1.10.1
27 | 
28 | ## Version 0.2.187 on Mar 3, 2020
29 | 
30 | * [CLJ-1472](https://clojure.atlassian.net/browse/CLJ-1472) Fix use of locking to be more amenable to Graal analyzer
31 | 
32 | ## Version 0.2.176 on Sept 4, 2018
33 | 
34 | * [CLJ-2373](https://clojure.atlassian.net/browse/CLJ-2373) Don't print ex-info into spec errors
35 | * [CLJ-2391](https://clojure.atlassian.net/browse/CLJ-2391) Change spec problem line print order
36 | * [CLJ-2392](https://clojure.atlassian.net/browse/CLJ-2392) Stop prepending :args to spec problem paths
37 | * [CLJ-2393](https://clojure.atlassian.net/browse/CLJ-2393) Sort on descending "in" length before "at" length
38 | 
39 | ## Version 0.2.168 on June 26, 2018
40 | 
41 | * [CLJ-2182](https://clojure.atlassian.net/browse/CLJ-2182) Always check preds for s/& on nil input
42 | * [CLJ-2178](https://clojure.atlassian.net/browse/CLJ-2178) Return resolved pred for s/& explain-data
43 | * [CLJ-2177](https://clojure.atlassian.net/browse/CLJ-2177) Return valid resolved pred in s/keys explain-data
44 | * [CLJ-2167](https://clojure.atlassian.net/browse/CLJ-2176) Properly check for int? in int-in-range?
45 | * [CLJ-2166](https://clojure.atlassian.net/browse/CLJ-2166) added function name to instrument exception map
46 | * [CLJ-2111](https://clojure.atlassian.net/browse/CLJ-2111) Clarify docstring for :kind in s/every
47 | * [CLJ-2068](https://clojure.atlassian.net/browse/CLJ-2068) Capture form of set and function instances in spec
48 | * [CLJ-2060](https://clojure.atlassian.net/browse/CLJ-2060) Remove a spec by s/def of nil
49 | * [CLJ-2046](https://clojure.atlassian.net/browse/CLJ-2046) gen random subsets of or'd req keys in map specs
50 | * [CLJ-2026](https://clojure.atlassian.net/browse/CLJ-2026) Prevent concurrent loads in dynaload
51 | * [CLJ-2176](https://clojure.atlassian.net/browse/CLJ-2176) s/tuple explain-data :pred problem
52 | 
53 | ## Version 0.1.143 on Oct 30, 2017
54 | 
55 | * [CLJ-2259](https://clojure.atlassian.net/browse/CLJ-2259) - map decimal? to big decimal generator (instead of bigdec?)
56 | 
57 | ## Version 0.1.134 on Oct 6, 2017
58 | 
59 | * [CLJ-2103](https://clojure.atlassian.net/browse/CLJ-2103) - s/coll-of and s/every gen is very slow if :kind specified without :into
60 | * [CLJ-2171](https://clojure.atlassian.net/browse/CLJ-2171) - Default explain printer shouldn't print root val and spec
61 | * Mark Clojure dependency as a provided dep so it's not transitively included
62 | 
63 | ## Version 0.1.123 on May 26, 2017
64 | 
65 | * No changes, just a rebuild
66 | 
67 | ## Version 0.1.109 on May 26, 2017
68 | 
69 | * [CLJ-2153](https://clojure.atlassian.net/browse/CLJ-2153) - Docstring for int-in-range? and int-in now mention fixed precision constraint
70 | * [CLJ-2085](https://clojure.atlassian.net/browse/CLJ-2085) - Add the top level spec and value to explain-data
71 | * [CLJ-2076](https://clojure.atlassian.net/browse/CLJ-2076) - coll-of and map-of should unform their elements
72 | * [CLJ-2063](https://clojure.atlassian.net/browse/CLJ-2063) - report explain errors in order from longest to shortest path
73 | * [CLJ-2061](https://clojure.atlassian.net/browse/CLJ-2061) - Better error message when exercise-fn called on fn without :args spec
74 | * [CLJ-2059](https://clojure.atlassian.net/browse/CLJ-2059) - explain-data should return resolved preds
75 | * [CLJ-2057](https://clojure.atlassian.net/browse/CLJ-2057) - If :ret spec is not supplied, use any?
76 | 
77 | ## Version 0.1.108 on May 2, 2017
78 | 
79 | * AOT compile the spec namespaces
80 | 
81 | ## Version 0.1.94 on Apr 26, 2017
82 | 
83 | * Moved spec namespaces from Clojure
84 | * Renamed spec namespaces to append ".alpha"
85 | 
86 | 


--------------------------------------------------------------------------------
/src/test/clojure/clojure/test_clojure/instr.clj:
--------------------------------------------------------------------------------
  1 | ;   Copyright (c) Rich Hickey. All rights reserved.
  2 | ;   The use and distribution terms for this software are covered by the
  3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
  5 | ;   By using this software in any fashion, you are agreeing to be bound by
  6 | ;   the terms of this license.
  7 | ;   You must not remove this notice, or any other, from this software.
  8 | 
  9 | (ns clojure.test-clojure.instr
 10 |   (:require [clojure.spec.alpha :as s]
 11 |             [clojure.spec.gen.alpha :as gen]
 12 |             [clojure.spec.test.alpha :as stest]
 13 |             [clojure.test :refer :all]))
 14 | 
 15 | (set! *warn-on-reflection* true)
 16 | 
 17 | ;; utils
 18 | 
 19 | (defmacro with-feature [feature & body]
 20 |   `(try ~feature
 21 |      ~@body
 22 |      (catch Exception ex#)))
 23 | 
 24 | ;; instrument tests
 25 | 
 26 | (defn kwargs-fn
 27 |   ([opts] opts)
 28 |   ([a b] [a b])
 29 |   ([a b & {:as m}] [a b m]))
 30 | 
 31 | (defn no-kwargs-fn
 32 |   ([opts] opts)
 33 |   ([a b] [a b])
 34 |   ([args inner & opts] [args inner opts]))
 35 | 
 36 | (defn no-kwargs-destruct-fn
 37 |   ([opts] opts)
 38 |   ([{:as a} b] [a b])
 39 |   ([{:as args} inner & opts] [args inner opts]))
 40 | 
 41 | (defn just-varargs [& args]
 42 |   (apply + args))
 43 | 
 44 | (defn add10 [n]
 45 |   (+ 10 n))
 46 | 
 47 | (alter-meta! #'add10 dissoc :arglists)
 48 | 
 49 | ;;; Specs
 50 | 
 51 | (s/def ::a any?)
 52 | (s/def ::b number?)
 53 | (s/def ::c any?)
 54 | (s/def ::m map?)
 55 | 
 56 | (s/fdef kwargs-fn
 57 |   :args (s/alt :unary  (s/cat :a ::a)
 58 |                :binary (s/cat :a ::a :b ::b)
 59 |                :variadic (s/cat :a ::a
 60 |                                 :b ::b
 61 |                                 :kwargs (s/keys* :opt-un [::a ::b ::c]))))
 62 | 
 63 | (s/fdef no-kwargs-fn
 64 |   :args (s/alt :unary  (s/cat :a ::a)
 65 |                :binary (s/cat :a ::a :b ::b)
 66 |                :variadic (s/cat :a ::a
 67 |                                 :b ::b
 68 |                                 :varargs (s/cat :numbers (s/* number?)))))
 69 | 
 70 | (s/fdef no-kwargs-destruct-fn
 71 |   :args (s/alt :unary  (s/cat :a ::a)
 72 |                :binary (s/cat :a ::a :m ::m)
 73 |                :variadic (s/cat :a ::a
 74 |                                 :b ::b
 75 |                                 :varargs (s/cat :numbers (s/* number?)))))
 76 | 
 77 | (s/fdef just-varargs
 78 |   :args (s/cat :numbers (s/* number?))
 79 |   :ret number?)
 80 | 
 81 | (s/fdef add10
 82 |   :args (s/cat :arg ::b)
 83 |   :ret number?)
 84 | 
 85 | (defn- fail-no-kwargs [& args] (apply no-kwargs-fn args))
 86 | (defn- fail-kwargs [& args] (apply kwargs-fn args))
 87 | 
 88 | (with-feature (kwargs-fn 1 2 {:a 1 :b 2})
 89 |   (deftest test-instrument
 90 |     (testing "that a function taking fixed args and varargs is spec'd and checked at runtime"
 91 |       (letfn [(test-varargs-raw []
 92 |                 (are [x y] (= x y)
 93 |                   1                         (no-kwargs-fn 1)
 94 |                   [1 2]                     (no-kwargs-fn 1 2)
 95 |                   [1 2 [3 4 5]]             (no-kwargs-fn 1 2 3 4 5)))]
 96 |         (testing "that the raw kwargs function operates as expected"
 97 |           (test-varargs-raw))
 98 | 
 99 |         (testing "that the instrumented kwargs function operates as expected"
100 |           (stest/instrument `no-kwargs-fn {})
101 | 
102 |           (test-varargs-raw)
103 |           (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (no-kwargs-fn 1 :not-num)))
104 |           (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (no-kwargs-fn 1 2 :not-num 3)))
105 | 
106 |           (testing "that the ex-info data looks correct"
107 |             (try (fail-no-kwargs 1 :not-num)
108 |                  (catch Exception ei
109 |                    (is (= 'clojure.test-clojure.instr/fail-no-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope)))))
110 | 
111 |             (try (fail-no-kwargs 1 2 :not-num 3)
112 |                  (catch Exception ei
113 |                    (is (= 'clojure.test-clojure.instr/fail-no-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope)))))))
114 | 
115 |         (testing "that the uninstrumented kwargs function operates as the raw function"
116 |           (stest/unstrument `no-kwargs-fn)
117 |           (test-varargs-raw))))
118 | 
119 |     (testing "that a function taking only varargs is spec'd and checked at runtime"
120 |       (letfn [(test-varargs-raw []
121 |                 (are [x y] (= x y)
122 |                   1                         (just-varargs 1)
123 |                   3                         (just-varargs 1 2)
124 |                   15                        (just-varargs 1 2 3 4 5)))]
125 |         (testing "that the raw varargs function operates as expected"
126 |           (test-varargs-raw))
127 | 
128 |         (testing "that the instrumented varargs function operates as expected"
129 |           (stest/instrument `just-varargs {})
130 | 
131 |           (test-varargs-raw)
132 |           (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (just-varargs 1 :not-num)))
133 |           (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (just-varargs 1 2 :not-num 3))))
134 | 
135 |         (testing "that the uninstrumented kwargs function operates as the raw function"
136 |           (stest/unstrument `just-varargs)
137 |           (test-varargs-raw))))
138 | 
139 |     (testing "that a function taking keyword args is spec'd and checked at runtime"
140 |       (letfn [(test-kwargs-baseline []
141 |                 (are [x y] (= x y)
142 |                   1                         (kwargs-fn 1)
143 |                   [1 2]                     (kwargs-fn 1 2)
144 |                   [1 2 {:a 1}]              (kwargs-fn 1 2 :a 1)
145 |                   [1 2 {:a 1}]              (kwargs-fn 1 2 {:a 1})
146 |                   [1 2 {:a 1 :b 2}]         (kwargs-fn 1 2 :a 1 {:b 2})))
147 |               (test-kwargs-extended []
148 |                 (are [x y] (= x y)
149 |                   [1 :not-num]              (kwargs-fn 1 :not-num)
150 |                   [1 2 {:a 1 :b :not-num}]  (kwargs-fn 1 2 :a 1 {:b :not-num})))]
151 |         (testing "that the raw kwargs function operates as expected"
152 |           (test-kwargs-baseline)
153 |           (test-kwargs-extended))
154 | 
155 |         (testing "that the instrumented kwargs function operates as expected"
156 |           (stest/instrument `kwargs-fn {})
157 | 
158 |           (test-kwargs-baseline)
159 |           (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (kwargs-fn 1 :not-num)))
160 |           (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (kwargs-fn 1 2 :a 1 {:b :not-num})))
161 | 
162 |           (testing "that the ex-info data looks correct"
163 |             (try (fail-kwargs 1 :not-num)
164 |                  (catch Exception ei
165 |                    (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope)))))
166 | 
167 |             (try (fail-kwargs 1 2 :a 1 {:b :not-num})
168 |                  (catch Exception ei
169 |                    (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope)))))))
170 | 
171 |         (testing "that the uninstrumented kwargs function operates as the raw function"
172 |           (stest/unstrument `kwargs-fn)
173 |           (test-kwargs-baseline)
174 |           (test-kwargs-extended))))
175 | 
176 |     (testing "that a var with no arglists meta is spec'd and checked at runtime"
177 |       (stest/instrument `add10 {})
178 |       (is (= 11 (add10 1)))
179 |       (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (add10 :not-num)))
180 |       (is (= 11 (add10 1))))
181 | 
182 |     (testing "that a function with positional destructuring in its parameter list is spec'd and checked at runtime"
183 |       (stest/instrument `no-kwargs-destruct-fn {})
184 | 
185 |       (is (= [{:a 1} {}]         (no-kwargs-destruct-fn {:a 1} {})))
186 |       (is (= [{:a 1} 2 [3 4 5]]  (no-kwargs-destruct-fn {:a 1} 2 3 4 5))))))
187 | 


--------------------------------------------------------------------------------
/src/main/clojure/clojure/spec/gen/alpha.clj:
--------------------------------------------------------------------------------
  1 | ;   Copyright (c) Rich Hickey. All rights reserved.
  2 | ;   The use and distribution terms for this software are covered by the
  3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
  5 | ;   By using this software in any fashion, you are agreeing to be bound by
  6 | ;   the terms of this license.
  7 | ;   You must not remove this notice, or any other, from this software.
  8 | 
  9 | (ns clojure.spec.gen.alpha
 10 |     (:refer-clojure :exclude [boolean bytes cat hash-map list map not-empty set vector
 11 |                               char double int keyword symbol string uuid delay shuffle]))
 12 | 
 13 | (alias 'c 'clojure.core)
 14 | 
 15 | (defonce ^:private dynalock (Object.))
 16 | 
 17 | (defn- dynaload
 18 |   [s]
 19 |   (let [ns (namespace s)]
 20 |     (assert ns)
 21 |     (locking dynalock
 22 |       (require (c/symbol ns)))
 23 |     (let [v (resolve s)]
 24 |       (if v
 25 |         @v
 26 |         (throw (RuntimeException. (str "Var " s " is not on the classpath")))))))
 27 | 
 28 | (def ^:private quick-check-ref
 29 |      (c/delay (dynaload 'clojure.test.check/quick-check)))
 30 | (defn quick-check
 31 |   [& args]
 32 |   (apply @quick-check-ref args))
 33 | 
 34 | (def ^:private for-all*-ref
 35 |      (c/delay (dynaload 'clojure.test.check.properties/for-all*)))
 36 | (defn for-all*
 37 |   "Dynamically loaded clojure.test.check.properties/for-all*."
 38 |   [& args]
 39 |   (apply @for-all*-ref args))
 40 | 
 41 | (let [g? (c/delay (dynaload 'clojure.test.check.generators/generator?))
 42 |       g (c/delay (dynaload 'clojure.test.check.generators/generate))
 43 |       mkg (c/delay (dynaload 'clojure.test.check.generators/->Generator))]
 44 |   (defn- generator?
 45 |     [x]
 46 |     (@g? x))
 47 |   (defn- generator
 48 |     [gfn]
 49 |     (@mkg gfn))
 50 |   (defn generate
 51 |     "Generate a single value using generator."
 52 |     [generator]
 53 |     (@g generator)))
 54 | 
 55 | (defn ^:skip-wiki delay-impl
 56 |   [gfnd]
 57 |   ;;N.B. depends on test.check impl details
 58 |   (generator (fn [rnd size]
 59 |                ((:gen @gfnd) rnd size))))
 60 | 
 61 | (defmacro delay
 62 |   "given body that returns a generator, returns a
 63 |   generator that delegates to that, but delays
 64 |   creation until used."
 65 |   [& body]
 66 |   `(delay-impl (c/delay ~@body)))
 67 | 
 68 | (defn gen-for-name
 69 |   "Dynamically loads test.check generator named s."
 70 |   [s]
 71 |   (let [g (dynaload s)]
 72 |     (if (generator? g)
 73 |       g
 74 |       (throw (RuntimeException. (str "Var " s " is not a generator"))))))
 75 | 
 76 | (defmacro ^:skip-wiki lazy-combinator
 77 |   "Implementation macro, do not call directly."
 78 |   [s]
 79 |   (let [fqn (c/symbol "clojure.test.check.generators" (name s))
 80 |         doc (str "Lazy loaded version of " fqn)]
 81 |     `(let [g# (c/delay (dynaload '~fqn))]
 82 |        (defn ~s
 83 |          ~doc
 84 |          [& ~'args]
 85 |          (apply @g# ~'args)))))
 86 | 
 87 | (defmacro ^:skip-wiki lazy-combinators
 88 |   "Implementation macro, do not call directly."
 89 |   [& syms]
 90 |   `(do
 91 |      ~@(c/map
 92 |         (fn [s] (c/list 'lazy-combinator s))
 93 |         syms)))
 94 | 
 95 | (lazy-combinators hash-map list map not-empty set vector vector-distinct elements
 96 |                   bind choose fmap one-of such-that tuple sample return
 97 |                   large-integer* double* frequency shuffle)
 98 | 
 99 | (defmacro ^:skip-wiki lazy-prim
100 |   "Implementation macro, do not call directly."
101 |   [s]
102 |   (let [fqn (c/symbol "clojure.test.check.generators" (name s))
103 |         doc (str "Fn returning " fqn)]
104 |     `(let [g# (c/delay (dynaload '~fqn))]
105 |        (defn ~s
106 |          ~doc
107 |          [& ~'args]
108 |          @g#))))
109 | 
110 | (defmacro ^:skip-wiki lazy-prims
111 |   "Implementation macro, do not call directly."
112 |   [& syms]
113 |   `(do
114 |      ~@(c/map
115 |         (fn [s] (c/list 'lazy-prim s))
116 |         syms)))
117 | 
118 | (lazy-prims any any-printable boolean bytes char char-alpha char-alphanumeric char-ascii double
119 |             int keyword keyword-ns large-integer ratio simple-type simple-type-printable
120 |             string string-ascii string-alphanumeric symbol symbol-ns uuid)
121 | 
122 | (defn cat
123 |   "Returns a generator of a sequence catenated from results of
124 | gens, each of which should generate something sequential."
125 |   [& gens]
126 |   (fmap #(apply concat %)
127 |         (apply tuple gens)))
128 | 
129 | (defn- qualified? [ident] (not (nil? (namespace ident))))
130 | 
131 | (def ^:private
132 |   gen-builtins
133 |   (c/delay
134 |    (let [simple (simple-type-printable)]
135 |      {any? (one-of [(return nil) (any-printable)])
136 |       some? (such-that some? (any-printable))
137 |       number? (one-of [(large-integer) (double)])
138 |       integer? (large-integer)
139 |       int? (large-integer)
140 |       pos-int? (large-integer* {:min 1})
141 |       neg-int? (large-integer* {:max -1})
142 |       nat-int? (large-integer* {:min 0})
143 |       float? (double)
144 |       double? (double)
145 |       boolean? (boolean)
146 |       string? (string-alphanumeric)
147 |       ident? (one-of [(keyword-ns) (symbol-ns)])
148 |       simple-ident? (one-of [(keyword) (symbol)])
149 |       qualified-ident? (such-that qualified? (one-of [(keyword-ns) (symbol-ns)]))
150 |       keyword? (keyword-ns)
151 |       simple-keyword? (keyword)
152 |       qualified-keyword? (such-that qualified? (keyword-ns))
153 |       symbol? (symbol-ns)
154 |       simple-symbol? (symbol)
155 |       qualified-symbol? (such-that qualified? (symbol-ns))
156 |       uuid? (uuid)
157 |       uri? (fmap #(java.net.URI/create (str "http://" % ".com")) (uuid))
158 |       decimal? (fmap #(BigDecimal/valueOf %)
159 |                     (double* {:infinite? false :NaN? false}))
160 |       inst? (fmap #(java.util.Date. %)
161 |                   (large-integer))
162 |       seqable? (one-of [(return nil)
163 |                         (list simple)
164 |                         (vector simple)
165 |                         (map simple simple)
166 |                         (set simple)
167 |                         (string-alphanumeric)])
168 |       indexed? (vector simple)
169 |       map? (map simple simple)
170 |       vector? (vector simple)
171 |       list? (list simple)
172 |       seq? (list simple)
173 |       char? (char)
174 |       set? (set simple)
175 |       nil? (return nil)
176 |       false? (return false)
177 |       true? (return true)
178 |       zero? (return 0)
179 |       rational? (one-of [(large-integer) (ratio)])
180 |       coll? (one-of [(map simple simple)
181 |                      (list simple)
182 |                      (vector simple)
183 |                      (set simple)])
184 |       empty? (elements [nil '() [] {} #{}])
185 |       associative? (one-of [(map simple simple) (vector simple)])
186 |       sequential? (one-of [(list simple) (vector simple)])
187 |       ratio? (such-that ratio? (ratio))
188 |       bytes? (bytes)})))
189 | 
190 | (defn gen-for-pred
191 |   "Given a predicate, returns a built-in generator if one exists."
192 |   [pred]
193 |   (if (set? pred)
194 |     (elements pred)
195 |     (get @gen-builtins pred)))
196 | 
197 | (comment
198 |   (require :reload 'clojure.spec.gen.alpha)
199 |   (in-ns 'clojure.spec.gen.alpha)
200 | 
201 |   ;; combinators, see call to lazy-combinators above for complete list
202 |   (generate (one-of [(gen-for-pred integer?) (gen-for-pred string?)]))
203 |   (generate (such-that #(< 10000 %) (gen-for-pred integer?)))
204 |   (let [reqs {:a (gen-for-pred number?)
205 |               :b (gen-for-pred ratio?)}
206 |         opts {:c (gen-for-pred string?)}]
207 |     (generate (bind (choose 0 (count opts))
208 |                     #(let [args (concat (seq reqs) (c/shuffle (seq opts)))]
209 |                        (->> args
210 |                             (take (+ % (count reqs)))
211 |                             (mapcat identity)
212 |                             (apply hash-map))))))
213 |   (generate (cat (list (gen-for-pred string?))
214 |                  (list (gen-for-pred ratio?))))
215 |   
216 |   ;; load your own generator
217 |   (gen-for-name 'clojure.test.check.generators/int)
218 |   
219 |   ;; failure modes
220 |   (gen-for-name 'unqualified)
221 |   (gen-for-name 'clojure.core/+)
222 |   (gen-for-name 'clojure.core/name-does-not-exist)
223 |   (gen-for-name 'ns.does.not.exist/f)
224 |   
225 |   )
226 | 
227 | 
228 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
  1 | Eclipse Public License - v 1.0
  2 | 
  3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC
  4 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM
  5 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.
  6 | 
  7 | 1. DEFINITIONS
  8 | 
  9 | "Contribution" means:
 10 | 
 11 | a) in the case of the initial Contributor, the initial code and documentation
 12 |    distributed under this Agreement, and
 13 | b) in the case of each subsequent Contributor:
 14 |     i) changes to the Program, and
 15 |    ii) additions to the Program;
 16 | 
 17 |    where such changes and/or additions to the Program originate from and are
 18 |    distributed by that particular Contributor. A Contribution 'originates'
 19 |    from a Contributor if it was added to the Program by such Contributor
 20 |    itself or anyone acting on such Contributor's behalf. Contributions do not
 21 |    include additions to the Program which: (i) are separate modules of
 22 |    software distributed in conjunction with the Program under their own
 23 |    license agreement, and (ii) are not derivative works of the Program.
 24 | 
 25 | "Contributor" means any person or entity that distributes the Program.
 26 | 
 27 | "Licensed Patents" mean patent claims licensable by a Contributor which are
 28 | necessarily infringed by the use or sale of its Contribution alone or when
 29 | combined with the Program.
 30 | 
 31 | "Program" means the Contributions distributed in accordance with this
 32 | Agreement.
 33 | 
 34 | "Recipient" means anyone who receives the Program under this Agreement,
 35 | including all Contributors.
 36 | 
 37 | 2. GRANT OF RIGHTS
 38 |   a) Subject to the terms of this Agreement, each Contributor hereby grants
 39 |      Recipient a non-exclusive, worldwide, royalty-free copyright license to
 40 |      reproduce, prepare derivative works of, publicly display, publicly
 41 |      perform, distribute and sublicense the Contribution of such Contributor,
 42 |      if any, and such derivative works, in source code and object code form.
 43 |   b) Subject to the terms of this Agreement, each Contributor hereby grants
 44 |      Recipient a non-exclusive, worldwide, royalty-free patent license under
 45 |      Licensed Patents to make, use, sell, offer to sell, import and otherwise
 46 |      transfer the Contribution of such Contributor, if any, in source code and
 47 |      object code form. This patent license shall apply to the combination of
 48 |      the Contribution and the Program if, at the time the Contribution is
 49 |      added by the Contributor, such addition of the Contribution causes such
 50 |      combination to be covered by the Licensed Patents. The patent license
 51 |      shall not apply to any other combinations which include the Contribution.
 52 |      No hardware per se is licensed hereunder.
 53 |   c) Recipient understands that although each Contributor grants the licenses
 54 |      to its Contributions set forth herein, no assurances are provided by any
 55 |      Contributor that the Program does not infringe the patent or other
 56 |      intellectual property rights of any other entity. Each Contributor
 57 |      disclaims any liability to Recipient for claims brought by any other
 58 |      entity based on infringement of intellectual property rights or
 59 |      otherwise. As a condition to exercising the rights and licenses granted
 60 |      hereunder, each Recipient hereby assumes sole responsibility to secure
 61 |      any other intellectual property rights needed, if any. For example, if a
 62 |      third party patent license is required to allow Recipient to distribute
 63 |      the Program, it is Recipient's responsibility to acquire that license
 64 |      before distributing the Program.
 65 |   d) Each Contributor represents that to its knowledge it has sufficient
 66 |      copyright rights in its Contribution, if any, to grant the copyright
 67 |      license set forth in this Agreement.
 68 | 
 69 | 3. REQUIREMENTS
 70 | 
 71 | A Contributor may choose to distribute the Program in object code form under
 72 | its own license agreement, provided that:
 73 | 
 74 |   a) it complies with the terms and conditions of this Agreement; and
 75 |   b) its license agreement:
 76 |       i) effectively disclaims on behalf of all Contributors all warranties
 77 |          and conditions, express and implied, including warranties or
 78 |          conditions of title and non-infringement, and implied warranties or
 79 |          conditions of merchantability and fitness for a particular purpose;
 80 |      ii) effectively excludes on behalf of all Contributors all liability for
 81 |          damages, including direct, indirect, special, incidental and
 82 |          consequential damages, such as lost profits;
 83 |     iii) states that any provisions which differ from this Agreement are
 84 |          offered by that Contributor alone and not by any other party; and
 85 |      iv) states that source code for the Program is available from such
 86 |          Contributor, and informs licensees how to obtain it in a reasonable
 87 |          manner on or through a medium customarily used for software exchange.
 88 | 
 89 | When the Program is made available in source code form:
 90 | 
 91 |   a) it must be made available under this Agreement; and
 92 |   b) a copy of this Agreement must be included with each copy of the Program.
 93 |      Contributors may not remove or alter any copyright notices contained
 94 |      within the Program.
 95 | 
 96 | Each Contributor must identify itself as the originator of its Contribution,
 97 | if
 98 | any, in a manner that reasonably allows subsequent Recipients to identify the
 99 | originator of the Contribution.
100 | 
101 | 4. COMMERCIAL DISTRIBUTION
102 | 
103 | Commercial distributors of software may accept certain responsibilities with
104 | respect to end users, business partners and the like. While this license is
105 | intended to facilitate the commercial use of the Program, the Contributor who
106 | includes the Program in a commercial product offering should do so in a manner
107 | which does not create potential liability for other Contributors. Therefore,
108 | if a Contributor includes the Program in a commercial product offering, such
109 | Contributor ("Commercial Contributor") hereby agrees to defend and indemnify
110 | every other Contributor ("Indemnified Contributor") against any losses,
111 | damages and costs (collectively "Losses") arising from claims, lawsuits and
112 | other legal actions brought by a third party against the Indemnified
113 | Contributor to the extent caused by the acts or omissions of such Commercial
114 | Contributor in connection with its distribution of the Program in a commercial
115 | product offering. The obligations in this section do not apply to any claims
116 | or Losses relating to any actual or alleged intellectual property
117 | infringement. In order to qualify, an Indemnified Contributor must:
118 | a) promptly notify the Commercial Contributor in writing of such claim, and
119 | b) allow the Commercial Contributor to control, and cooperate with the
120 | Commercial Contributor in, the defense and any related settlement
121 | negotiations. The Indemnified Contributor may participate in any such claim at
122 | its own expense.
123 | 
124 | For example, a Contributor might include the Program in a commercial product
125 | offering, Product X. That Contributor is then a Commercial Contributor. If
126 | that Commercial Contributor then makes performance claims, or offers
127 | warranties related to Product X, those performance claims and warranties are
128 | such Commercial Contributor's responsibility alone. Under this section, the
129 | Commercial Contributor would have to defend claims against the other
130 | Contributors related to those performance claims and warranties, and if a
131 | court requires any other Contributor to pay any damages as a result, the
132 | Commercial Contributor must pay those damages.
133 | 
134 | 5. NO WARRANTY
135 | 
136 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN
137 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR
138 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE,
139 | NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each
140 | Recipient is solely responsible for determining the appropriateness of using
141 | and distributing the Program and assumes all risks associated with its
142 | exercise of rights under this Agreement , including but not limited to the
143 | risks and costs of program errors, compliance with applicable laws, damage to
144 | or loss of data, programs or equipment, and unavailability or interruption of
145 | operations.
146 | 
147 | 6. DISCLAIMER OF LIABILITY
148 | 
149 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY
150 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL,
151 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION
152 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
153 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
154 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE
155 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY
156 | OF SUCH DAMAGES.
157 | 
158 | 7. GENERAL
159 | 
160 | If any provision of this Agreement is invalid or unenforceable under
161 | applicable law, it shall not affect the validity or enforceability of the
162 | remainder of the terms of this Agreement, and without further action by the
163 | parties hereto, such provision shall be reformed to the minimum extent
164 | necessary to make such provision valid and enforceable.
165 | 
166 | If Recipient institutes patent litigation against any entity (including a
167 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself
168 | (excluding combinations of the Program with other software or hardware)
169 | infringes such Recipient's patent(s), then such Recipient's rights granted
170 | under Section 2(b) shall terminate as of the date such litigation is filed.
171 | 
172 | All Recipient's rights under this Agreement shall terminate if it fails to
173 | comply with any of the material terms or conditions of this Agreement and does
174 | not cure such failure in a reasonable period of time after becoming aware of
175 | such noncompliance. If all Recipient's rights under this Agreement terminate,
176 | Recipient agrees to cease use and distribution of the Program as soon as
177 | reasonably practicable. However, Recipient's obligations under this Agreement
178 | and any licenses granted by Recipient relating to the Program shall continue
179 | and survive.
180 | 
181 | Everyone is permitted to copy and distribute copies of this Agreement, but in
182 | order to avoid inconsistency the Agreement is copyrighted and may only be
183 | modified in the following manner. The Agreement Steward reserves the right to
184 | publish new versions (including revisions) of this Agreement from time to
185 | time. No one other than the Agreement Steward has the right to modify this
186 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The
187 | Eclipse Foundation may assign the responsibility to serve as the Agreement
188 | Steward to a suitable separate entity. Each new version of the Agreement will
189 | be given a distinguishing version number. The Program (including
190 | Contributions) may always be distributed subject to the version of the
191 | Agreement under which it was received. In addition, after a new version of the
192 | Agreement is published, Contributor may elect to distribute the Program
193 | (including its Contributions) under the new version. Except as expressly
194 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or
195 | licenses to the intellectual property of any Contributor under this Agreement,
196 | whether expressly, by implication, estoppel or otherwise. All rights in the
197 | Program not expressly granted under this Agreement are reserved.
198 | 
199 | This Agreement is governed by the laws of the State of New York and the
200 | intellectual property laws of the United States of America. No party to this
201 | Agreement will bring a legal action under this Agreement more than one year
202 | after the cause of action arose. Each party waives its rights to a jury trial in
203 | any resulting litigation.
204 | 
205 | 
206 | 


--------------------------------------------------------------------------------
/epl-v10.html:
--------------------------------------------------------------------------------
  1 | <?xml version="1.0" encoding="ISO-8859-1" ?>
  2 | <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
  3 | <html xmlns="http://www.w3.org/1999/xhtml">
  4 | 
  5 | <head>
  6 | <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />
  7 | <title>Eclipse Public License - Version 1.0</title>
  8 | <style type="text/css">
  9 |   body {
 10 |     size: 8.5in 11.0in;
 11 |     margin: 0.25in 0.5in 0.25in 0.5in;
 12 |     tab-interval: 0.5in;
 13 |     }
 14 |   p {  	
 15 |     margin-left: auto;
 16 |     margin-top:  0.5em;
 17 |     margin-bottom: 0.5em;
 18 |     }
 19 |   p.list {
 20 |   	margin-left: 0.5in;
 21 |     margin-top:  0.05em;
 22 |     margin-bottom: 0.05em;
 23 |     }
 24 |   </style>
 25 | 
 26 | </head>
 27 | 
 28 | <body lang="EN-US">
 29 | 
 30 | <p align=center><b>Eclipse Public License - v 1.0</b></p>
 31 | 
 32 | <p>THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE
 33 | PUBLIC LICENSE (&quot;AGREEMENT&quot;). ANY USE, REPRODUCTION OR
 34 | DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS
 35 | AGREEMENT.</p>
 36 | 
 37 | <p><b>1. DEFINITIONS</b></p>
 38 | 
 39 | <p>&quot;Contribution&quot; means:</p>
 40 | 
 41 | <p class="list">a) in the case of the initial Contributor, the initial
 42 | code and documentation distributed under this Agreement, and</p>
 43 | <p class="list">b) in the case of each subsequent Contributor:</p>
 44 | <p class="list">i) changes to the Program, and</p>
 45 | <p class="list">ii) additions to the Program;</p>
 46 | <p class="list">where such changes and/or additions to the Program
 47 | originate from and are distributed by that particular Contributor. A
 48 | Contribution 'originates' from a Contributor if it was added to the
 49 | Program by such Contributor itself or anyone acting on such
 50 | Contributor's behalf. Contributions do not include additions to the
 51 | Program which: (i) are separate modules of software distributed in
 52 | conjunction with the Program under their own license agreement, and (ii)
 53 | are not derivative works of the Program.</p>
 54 | 
 55 | <p>&quot;Contributor&quot; means any person or entity that distributes
 56 | the Program.</p>
 57 | 
 58 | <p>&quot;Licensed Patents&quot; mean patent claims licensable by a
 59 | Contributor which are necessarily infringed by the use or sale of its
 60 | Contribution alone or when combined with the Program.</p>
 61 | 
 62 | <p>&quot;Program&quot; means the Contributions distributed in accordance
 63 | with this Agreement.</p>
 64 | 
 65 | <p>&quot;Recipient&quot; means anyone who receives the Program under
 66 | this Agreement, including all Contributors.</p>
 67 | 
 68 | <p><b>2. GRANT OF RIGHTS</b></p>
 69 | 
 70 | <p class="list">a) Subject to the terms of this Agreement, each
 71 | Contributor hereby grants Recipient a non-exclusive, worldwide,
 72 | royalty-free copyright license to reproduce, prepare derivative works
 73 | of, publicly display, publicly perform, distribute and sublicense the
 74 | Contribution of such Contributor, if any, and such derivative works, in
 75 | source code and object code form.</p>
 76 | 
 77 | <p class="list">b) Subject to the terms of this Agreement, each
 78 | Contributor hereby grants Recipient a non-exclusive, worldwide,
 79 | royalty-free patent license under Licensed Patents to make, use, sell,
 80 | offer to sell, import and otherwise transfer the Contribution of such
 81 | Contributor, if any, in source code and object code form. This patent
 82 | license shall apply to the combination of the Contribution and the
 83 | Program if, at the time the Contribution is added by the Contributor,
 84 | such addition of the Contribution causes such combination to be covered
 85 | by the Licensed Patents. The patent license shall not apply to any other
 86 | combinations which include the Contribution. No hardware per se is
 87 | licensed hereunder.</p>
 88 | 
 89 | <p class="list">c) Recipient understands that although each Contributor
 90 | grants the licenses to its Contributions set forth herein, no assurances
 91 | are provided by any Contributor that the Program does not infringe the
 92 | patent or other intellectual property rights of any other entity. Each
 93 | Contributor disclaims any liability to Recipient for claims brought by
 94 | any other entity based on infringement of intellectual property rights
 95 | or otherwise. As a condition to exercising the rights and licenses
 96 | granted hereunder, each Recipient hereby assumes sole responsibility to
 97 | secure any other intellectual property rights needed, if any. For
 98 | example, if a third party patent license is required to allow Recipient
 99 | to distribute the Program, it is Recipient's responsibility to acquire
100 | that license before distributing the Program.</p>
101 | 
102 | <p class="list">d) Each Contributor represents that to its knowledge it
103 | has sufficient copyright rights in its Contribution, if any, to grant
104 | the copyright license set forth in this Agreement.</p>
105 | 
106 | <p><b>3. REQUIREMENTS</b></p>
107 | 
108 | <p>A Contributor may choose to distribute the Program in object code
109 | form under its own license agreement, provided that:</p>
110 | 
111 | <p class="list">a) it complies with the terms and conditions of this
112 | Agreement; and</p>
113 | 
114 | <p class="list">b) its license agreement:</p>
115 | 
116 | <p class="list">i) effectively disclaims on behalf of all Contributors
117 | all warranties and conditions, express and implied, including warranties
118 | or conditions of title and non-infringement, and implied warranties or
119 | conditions of merchantability and fitness for a particular purpose;</p>
120 | 
121 | <p class="list">ii) effectively excludes on behalf of all Contributors
122 | all liability for damages, including direct, indirect, special,
123 | incidental and consequential damages, such as lost profits;</p>
124 | 
125 | <p class="list">iii) states that any provisions which differ from this
126 | Agreement are offered by that Contributor alone and not by any other
127 | party; and</p>
128 | 
129 | <p class="list">iv) states that source code for the Program is available
130 | from such Contributor, and informs licensees how to obtain it in a
131 | reasonable manner on or through a medium customarily used for software
132 | exchange.</p>
133 | 
134 | <p>When the Program is made available in source code form:</p>
135 | 
136 | <p class="list">a) it must be made available under this Agreement; and</p>
137 | 
138 | <p class="list">b) a copy of this Agreement must be included with each
139 | copy of the Program.</p>
140 | 
141 | <p>Contributors may not remove or alter any copyright notices contained
142 | within the Program.</p>
143 | 
144 | <p>Each Contributor must identify itself as the originator of its
145 | Contribution, if any, in a manner that reasonably allows subsequent
146 | Recipients to identify the originator of the Contribution.</p>
147 | 
148 | <p><b>4. COMMERCIAL DISTRIBUTION</b></p>
149 | 
150 | <p>Commercial distributors of software may accept certain
151 | responsibilities with respect to end users, business partners and the
152 | like. While this license is intended to facilitate the commercial use of
153 | the Program, the Contributor who includes the Program in a commercial
154 | product offering should do so in a manner which does not create
155 | potential liability for other Contributors. Therefore, if a Contributor
156 | includes the Program in a commercial product offering, such Contributor
157 | (&quot;Commercial Contributor&quot;) hereby agrees to defend and
158 | indemnify every other Contributor (&quot;Indemnified Contributor&quot;)
159 | against any losses, damages and costs (collectively &quot;Losses&quot;)
160 | arising from claims, lawsuits and other legal actions brought by a third
161 | party against the Indemnified Contributor to the extent caused by the
162 | acts or omissions of such Commercial Contributor in connection with its
163 | distribution of the Program in a commercial product offering. The
164 | obligations in this section do not apply to any claims or Losses
165 | relating to any actual or alleged intellectual property infringement. In
166 | order to qualify, an Indemnified Contributor must: a) promptly notify
167 | the Commercial Contributor in writing of such claim, and b) allow the
168 | Commercial Contributor to control, and cooperate with the Commercial
169 | Contributor in, the defense and any related settlement negotiations. The
170 | Indemnified Contributor may participate in any such claim at its own
171 | expense.</p>
172 | 
173 | <p>For example, a Contributor might include the Program in a commercial
174 | product offering, Product X. That Contributor is then a Commercial
175 | Contributor. If that Commercial Contributor then makes performance
176 | claims, or offers warranties related to Product X, those performance
177 | claims and warranties are such Commercial Contributor's responsibility
178 | alone. Under this section, the Commercial Contributor would have to
179 | defend claims against the other Contributors related to those
180 | performance claims and warranties, and if a court requires any other
181 | Contributor to pay any damages as a result, the Commercial Contributor
182 | must pay those damages.</p>
183 | 
184 | <p><b>5. NO WARRANTY</b></p>
185 | 
186 | <p>EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS
187 | PROVIDED ON AN &quot;AS IS&quot; BASIS, WITHOUT WARRANTIES OR CONDITIONS
188 | OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION,
189 | ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY
190 | OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely
191 | responsible for determining the appropriateness of using and
192 | distributing the Program and assumes all risks associated with its
193 | exercise of rights under this Agreement , including but not limited to
194 | the risks and costs of program errors, compliance with applicable laws,
195 | damage to or loss of data, programs or equipment, and unavailability or
196 | interruption of operations.</p>
197 | 
198 | <p><b>6. DISCLAIMER OF LIABILITY</b></p>
199 | 
200 | <p>EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT
201 | NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT,
202 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING
203 | WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF
204 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
205 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR
206 | DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED
207 | HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.</p>
208 | 
209 | <p><b>7. GENERAL</b></p>
210 | 
211 | <p>If any provision of this Agreement is invalid or unenforceable under
212 | applicable law, it shall not affect the validity or enforceability of
213 | the remainder of the terms of this Agreement, and without further action
214 | by the parties hereto, such provision shall be reformed to the minimum
215 | extent necessary to make such provision valid and enforceable.</p>
216 | 
217 | <p>If Recipient institutes patent litigation against any entity
218 | (including a cross-claim or counterclaim in a lawsuit) alleging that the
219 | Program itself (excluding combinations of the Program with other
220 | software or hardware) infringes such Recipient's patent(s), then such
221 | Recipient's rights granted under Section 2(b) shall terminate as of the
222 | date such litigation is filed.</p>
223 | 
224 | <p>All Recipient's rights under this Agreement shall terminate if it
225 | fails to comply with any of the material terms or conditions of this
226 | Agreement and does not cure such failure in a reasonable period of time
227 | after becoming aware of such noncompliance. If all Recipient's rights
228 | under this Agreement terminate, Recipient agrees to cease use and
229 | distribution of the Program as soon as reasonably practicable. However,
230 | Recipient's obligations under this Agreement and any licenses granted by
231 | Recipient relating to the Program shall continue and survive.</p>
232 | 
233 | <p>Everyone is permitted to copy and distribute copies of this
234 | Agreement, but in order to avoid inconsistency the Agreement is
235 | copyrighted and may only be modified in the following manner. The
236 | Agreement Steward reserves the right to publish new versions (including
237 | revisions) of this Agreement from time to time. No one other than the
238 | Agreement Steward has the right to modify this Agreement. The Eclipse
239 | Foundation is the initial Agreement Steward. The Eclipse Foundation may
240 | assign the responsibility to serve as the Agreement Steward to a
241 | suitable separate entity. Each new version of the Agreement will be
242 | given a distinguishing version number. The Program (including
243 | Contributions) may always be distributed subject to the version of the
244 | Agreement under which it was received. In addition, after a new version
245 | of the Agreement is published, Contributor may elect to distribute the
246 | Program (including its Contributions) under the new version. Except as
247 | expressly stated in Sections 2(a) and 2(b) above, Recipient receives no
248 | rights or licenses to the intellectual property of any Contributor under
249 | this Agreement, whether expressly, by implication, estoppel or
250 | otherwise. All rights in the Program not expressly granted under this
251 | Agreement are reserved.</p>
252 | 
253 | <p>This Agreement is governed by the laws of the State of New York and
254 | the intellectual property laws of the United States of America. No party
255 | to this Agreement will bring a legal action under this Agreement more
256 | than one year after the cause of action arose. Each party waives its
257 | rights to a jury trial in any resulting litigation.</p>
258 | 
259 | </body>
260 | 
261 | </html>
262 | 


--------------------------------------------------------------------------------
/src/test/clojure/clojure/test_clojure/spec.clj:
--------------------------------------------------------------------------------
  1 | ;   Copyright (c) Rich Hickey. All rights reserved.
  2 | ;   The use and distribution terms for this software are covered by the
  3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
  5 | ;   By using this software in any fashion, you are agreeing to be bound by
  6 | ;   the terms of this license.
  7 | ;   You must not remove this notice, or any other, from this software.
  8 | 
  9 | (ns clojure.test-clojure.spec
 10 |   (:require [clojure.spec.alpha :as s]
 11 |             [clojure.spec.gen.alpha :as gen]
 12 |             [clojure.spec.test.alpha :as stest]
 13 |             [clojure.test :refer :all]))
 14 | 
 15 | (set! *warn-on-reflection* true)
 16 | 
 17 | (defmacro result-or-ex [x]
 18 |   `(try
 19 |      ~x
 20 |      (catch Throwable t#
 21 |        (.getName (class t#)))))
 22 | 
 23 | (def even-count? #(even? (count %)))
 24 | 
 25 | (defn submap?
 26 |   "Is m1 a subset of m2?"
 27 |   [m1 m2]
 28 |   (if (and (map? m1) (map? m2))
 29 |     (every? (fn [[k v]] (and (contains? m2 k)
 30 |                           (submap? v (get m2 k))))
 31 |       m1)
 32 |     (= m1 m2)))
 33 | 
 34 | (deftest conform-explain
 35 |   (let [a (s/and #(> % 5) #(< % 10))
 36 |         o (s/or :s string? :k keyword?)
 37 |         c (s/cat :a string? :b keyword?)
 38 |         either (s/alt :a string? :b keyword?)
 39 |         star (s/* keyword?)
 40 |         plus (s/+ keyword?)
 41 |         opt (s/? keyword?)
 42 |         andre (s/& (s/* keyword?) even-count?)
 43 |         andre2 (s/& (s/* keyword?) #{[:a]})
 44 |         m (s/map-of keyword? string?)
 45 |         mkeys (s/map-of (s/and keyword? (s/conformer name)) any?)
 46 |         mkeys2 (s/map-of (s/and keyword? (s/conformer name)) any? :conform-keys true)
 47 |         s (s/coll-of (s/spec (s/cat :tag keyword? :val any?)) :kind list?)
 48 |         v (s/coll-of keyword? :kind vector?)
 49 |         coll (s/coll-of keyword?)
 50 |         lrange (s/int-in 7 42)
 51 |         drange (s/double-in :infinite? false :NaN? false :min 3.1 :max 3.2)
 52 |         irange (s/inst-in #inst "1939" #inst "1946")
 53 |         ]
 54 |     (are [spec x conformed ed]
 55 |       (let [co (result-or-ex (s/conform spec x))
 56 |             e (result-or-ex (::s/problems (s/explain-data spec x)))]
 57 |         (when (not= conformed co) (println "conform fail\n\texpect=" conformed "\n\tactual=" co))
 58 |         (when (not (every? true? (map submap? ed e)))
 59 |           (println "explain failures\n\texpect=" ed "\n\tactual failures=" e "\n\tsubmap?=" (map submap? ed e)))
 60 |         (and (= conformed co) (every? true? (map submap? ed e))))
 61 | 
 62 |       lrange 7 7 nil
 63 |       lrange 8 8 nil
 64 |       lrange 42 ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.spec.alpha/int-in-range? 7 42 %)), :val 42}]
 65 | 
 66 |       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"}]
 67 |       irange #inst "1942" #inst "1942" nil
 68 |       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"}]
 69 | 
 70 |       drange 3.0 ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.core/<= 3.1 %)), :val 3.0}]
 71 |       drange 3.1 3.1 nil
 72 |       drange 3.2 3.2 nil
 73 |       drange Double/POSITIVE_INFINITY ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.core/not (Double/isInfinite %))), :val Double/POSITIVE_INFINITY}]
 74 |       ;; can't use equality-based test for Double/NaN
 75 |       ;; drange Double/NaN ::s/invalid {[] {:pred '(clojure.core/fn [%] (clojure.core/not (Double/isNaN %))), :val Double/NaN}}
 76 | 
 77 |       keyword? :k :k nil
 78 |       keyword? nil ::s/invalid [{:pred `keyword? :val nil}]
 79 |       keyword? "abc" ::s/invalid [{:pred `keyword? :val "abc"}]
 80 | 
 81 |       a 6 6 nil
 82 |       a 3 ::s/invalid '[{:pred (clojure.core/fn [%] (clojure.core/> % 5)), :val 3}]
 83 |       a 20 ::s/invalid '[{:pred (clojure.core/fn [%] (clojure.core/< % 10)), :val 20}]
 84 |       a nil "java.lang.NullPointerException" "java.lang.NullPointerException"
 85 |       a :k "java.lang.ClassCastException" "java.lang.ClassCastException"
 86 | 
 87 |       o "a" [:s "a"] nil
 88 |       o :a [:k :a] nil
 89 |       o 'a ::s/invalid '[{:pred clojure.core/string?, :val a, :path [:s]} {:pred clojure.core/keyword?, :val a :path [:k]}]
 90 | 
 91 |       c nil ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/string?, :val (), :path [:a]}]
 92 |       c [] ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/string?, :val (), :path [:a]}]
 93 |       c [:a] ::s/invalid '[{:pred clojure.core/string?, :val :a, :path [:a], :in [0]}]
 94 |       c ["a"] ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/keyword?, :val (), :path [:b]}]
 95 |       c ["s" :k] '{:a "s" :b :k} nil
 96 |       c ["s" :k 5] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/cat :a clojure.core/string? :b clojure.core/keyword?), :val (5)}]
 97 |       (s/cat) nil {} nil
 98 |       (s/cat) [5] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/cat), :val (5), :in [0]}]
 99 | 
100 |       either nil ::s/invalid '[{:reason "Insufficient input", :pred (clojure.spec.alpha/alt :a clojure.core/string? :b clojure.core/keyword?), :val () :via []}]
101 |       either [] ::s/invalid '[{:reason "Insufficient input", :pred (clojure.spec.alpha/alt :a clojure.core/string? :b clojure.core/keyword?), :val () :via []}]
102 |       either [:k] [:b :k] nil
103 |       either ["s"] [:a "s"] nil
104 |       either [:b "s"] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/alt :a clojure.core/string? :b clojure.core/keyword?), :val ("s") :via []}]
105 | 
106 |       star nil [] nil
107 |       star [] [] nil
108 |       star [:k] [:k] nil
109 |       star [:k1 :k2] [:k1 :k2] nil
110 |       star [:k1 :k2 "x"] ::s/invalid '[{:pred clojure.core/keyword?, :val "x" :via []}]
111 |       star ["a"] ::s/invalid '[{:pred clojure.core/keyword?, :val "a" :via []}]
112 | 
113 |       plus nil ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/keyword?, :val () :via []}]
114 |       plus [] ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/keyword?, :val () :via []}]
115 |       plus [:k] [:k] nil
116 |       plus [:k1 :k2] [:k1 :k2] nil
117 |       plus [:k1 :k2 "x"] ::s/invalid '[{:pred clojure.core/keyword?, :val "x", :in [2]}]
118 |       plus ["a"] ::s/invalid '[{:pred clojure.core/keyword?, :val "a" :via []}]
119 | 
120 |       opt nil nil nil
121 |       opt [] nil nil
122 |       opt :k ::s/invalid '[{:pred (clojure.core/fn [%] (clojure.core/or (clojure.core/nil? %) (clojure.core/sequential? %))), :val :k}]
123 |       opt [:k] :k nil
124 |       opt [:k1 :k2] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/? clojure.core/keyword?), :val (:k2)}]
125 |       opt [:k1 :k2 "x"] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/? clojure.core/keyword?), :val (:k2 "x")}]
126 |       opt ["a"] ::s/invalid '[{:pred clojure.core/keyword?, :val "a"}]
127 | 
128 |       andre nil nil nil
129 |       andre [] nil nil
130 |       andre :k :clojure.spec.alpha/invalid '[{:pred (clojure.core/fn [%] (clojure.core/or (clojure.core/nil? %) (clojure.core/sequential? %))), :val :k}]
131 |       andre [:k] ::s/invalid '[{:pred clojure.test-clojure.spec/even-count?, :val [:k]}]
132 |       andre [:j :k] [:j :k] nil
133 | 
134 |       andre2 nil :clojure.spec.alpha/invalid [{:pred #{[:a]}, :val []}]
135 |       andre2 [] :clojure.spec.alpha/invalid [{:pred #{[:a]}, :val []}]
136 |       andre2 [:a] [:a] nil
137 | 
138 |       m nil ::s/invalid '[{:pred clojure.core/map?, :val nil}]
139 |       m {} {} nil
140 |       m {:a "b"} {:a "b"} nil
141 | 
142 |       mkeys nil ::s/invalid '[{:pred clojure.core/map?, :val nil}]
143 |       mkeys {} {} nil
144 |       mkeys {:a 1 :b 2} {:a 1 :b 2} nil
145 | 
146 |       mkeys2 nil ::s/invalid '[{:pred clojure.core/map?, :val nil}]
147 |       mkeys2 {} {} nil
148 |       mkeys2 {:a 1 :b 2} {"a" 1 "b" 2} nil
149 | 
150 |       s '([:a 1] [:b "2"]) '({:tag :a :val 1} {:tag :b :val "2"}) nil
151 | 
152 |       v [:a :b] [:a :b] nil
153 |       v '(:a :b) ::s/invalid '[{:pred clojure.core/vector? :val (:a :b)}]
154 | 
155 |       coll nil ::s/invalid '[{:path [], :pred clojure.core/coll?, :val nil, :via [], :in []}]
156 |       coll [] [] nil
157 |       coll [:a] [:a] nil
158 |       coll [:a :b] [:a :b] nil
159 |       coll (map identity [:a :b]) '(:a :b) nil
160 |       ;;coll [:a "b"] ::s/invalid '[{:pred (coll-checker keyword?), :val [:a b]}]
161 |       )))
162 | 
163 | (deftest describing-evaled-specs
164 |   (let [sp #{1 2}]
165 |     (is (= (s/describe sp) (s/form sp) sp)))
166 | 
167 |   (is (= (s/describe odd?) 'odd?))
168 |   (is (= (s/form odd?) 'clojure.core/odd?))
169 | 
170 |   (is (= (s/describe #(odd? %)) ::s/unknown))
171 |   (is (= (s/form #(odd? %)) ::s/unknown)))
172 | 
173 | (defn check-conform-unform [spec vals expected-conforms]
174 |   (let [actual-conforms (map #(s/conform spec %) vals)
175 |         unforms (map #(s/unform spec %) actual-conforms)]
176 |     (is (= actual-conforms expected-conforms))
177 |     (is (= vals unforms))))
178 | 
179 | (deftest nilable-conform-unform
180 |   (check-conform-unform
181 |     (s/nilable int?)
182 |     [5 nil]
183 |     [5 nil])
184 |   (check-conform-unform
185 |     (s/nilable (s/or :i int? :s string?))
186 |     [5 "x" nil]
187 |     [[:i 5] [:s "x"] nil]))
188 | 
189 | (deftest nonconforming-conform-unform
190 |   (check-conform-unform
191 |     (s/nonconforming (s/or :i int? :s string?))
192 |     [5 "x"]
193 |     [5 "x"]))
194 | 
195 | (deftest coll-form
196 |   (are [spec form]
197 |     (= (s/form spec) form)
198 |     (s/map-of int? any?)
199 |     '(clojure.spec.alpha/map-of clojure.core/int? clojure.core/any?)
200 | 
201 |     (s/coll-of int?)
202 |     '(clojure.spec.alpha/coll-of clojure.core/int?)
203 | 
204 |     (s/every-kv int? int?)
205 |     '(clojure.spec.alpha/every-kv clojure.core/int? clojure.core/int?)
206 | 
207 |     (s/every int?)
208 |     '(clojure.spec.alpha/every clojure.core/int?)
209 | 
210 |     (s/coll-of (s/tuple (s/tuple int?)))
211 |     '(clojure.spec.alpha/coll-of (clojure.spec.alpha/tuple (clojure.spec.alpha/tuple clojure.core/int?)))
212 | 
213 |     (s/coll-of int? :kind vector?)
214 |     '(clojure.spec.alpha/coll-of clojure.core/int? :kind clojure.core/vector?)
215 | 
216 |     (s/coll-of int? :gen #(gen/return [1 2]))
217 |     '(clojure.spec.alpha/coll-of clojure.core/int? :gen (fn* [] (gen/return [1 2])))))
218 | 
219 | (deftest coll-conform-unform
220 |   (check-conform-unform
221 |     (s/coll-of (s/or :i int? :s string?))
222 |     [[1 "x"]]
223 |     [[[:i 1] [:s "x"]]])
224 |   (check-conform-unform
225 |     (s/every (s/or :i int? :s string?))
226 |     [[1 "x"]]
227 |     [[1 "x"]])
228 |   (check-conform-unform
229 |     (s/map-of int? (s/or :i int? :s string?))
230 |     [{10 10 20 "x"}]
231 |     [{10 [:i 10] 20 [:s "x"]}])
232 |   (check-conform-unform
233 |     (s/map-of (s/or :i int? :s string?) int? :conform-keys true)
234 |     [{10 10 "x" 20}]
235 |     [{[:i 10] 10 [:s "x"] 20}])
236 |   (check-conform-unform
237 |     (s/every-kv int? (s/or :i int? :s string?))
238 |     [{10 10 20 "x"}]
239 |     [{10 10 20 "x"}]))
240 | 
241 | (deftest &-explain-pred
242 |   (are [val expected]
243 |     (= expected (-> (s/explain-data (s/& int? even?) val) ::s/problems first :pred))
244 |     [] 'clojure.core/int?
245 |     [0 2] '(clojure.spec.alpha/& clojure.core/int? clojure.core/even?)))
246 | 
247 | (deftest keys-explain-pred
248 |   (is (= 'clojure.core/map? (-> (s/explain-data (s/keys :req [::x]) :a) ::s/problems first :pred))))
249 | 
250 | (deftest remove-def
251 |   (is (= ::ABC (s/def ::ABC string?)))
252 |   (is (= ::ABC (s/def ::ABC nil)))
253 |   (is (nil? (s/get-spec ::ABC))))
254 | 
255 | ;; TODO replace this with a generative test once we have specs for s/keys
256 | (deftest map-spec-generators
257 |   (s/def ::a nat-int?)
258 |   (s/def ::b boolean?)
259 |   (s/def ::c keyword?)
260 |   (s/def ::d double?)
261 |   (s/def ::e inst?)
262 | 
263 |   (is (= #{[::a]
264 |            [::a ::b]
265 |            [::a ::b ::c]
266 |            [::a ::c]}
267 |          (->> (s/exercise (s/keys :req [::a] :opt [::b ::c]) 100)
268 |               (map (comp sort keys first))
269 |               (into #{}))))
270 | 
271 |   (is (= #{[:a]
272 |            [:a :b]
273 |            [:a :b :c]
274 |            [:a :c]}
275 |          (->> (s/exercise (s/keys :req-un [::a] :opt-un [::b ::c]) 100)
276 |               (map (comp sort keys first))
277 |               (into #{}))))
278 | 
279 |   (is (= #{[::a ::b]
280 |            [::a ::b ::c ::d]
281 |            [::a ::b ::c ::d ::e]
282 |            [::a ::b ::c ::e]
283 |            [::a ::c ::d]
284 |            [::a ::c ::d ::e]
285 |            [::a ::c ::e]}
286 |          (->> (s/exercise (s/keys :req [::a (or ::b (and ::c (or ::d ::e)))]) 200)
287 |               (map (comp vec sort keys first))
288 |               (into #{}))))
289 | 
290 |   (is (= #{[:a :b]
291 |            [:a :b :c :d]
292 |            [:a :b :c :d :e]
293 |            [:a :b :c :e]
294 |            [:a :c :d]
295 |            [:a :c :d :e]
296 |            [:a :c :e]}
297 |          (->> (s/exercise (s/keys :req-un [::a (or ::b (and ::c (or ::d ::e)))]) 200)
298 |               (map (comp vec sort keys first))
299 |               (into #{})))))
300 | 
301 | (deftest tuple-explain-pred
302 |   (are [val expected]
303 |     (= expected (-> (s/explain-data (s/tuple int?) val) ::s/problems first :pred))
304 |     :a 'clojure.core/vector?
305 |     [] '(clojure.core/= (clojure.core/count %) 1)))
306 | 
307 | (comment
308 |   (require '[clojure.test :refer (run-tests)])
309 |   (in-ns 'clojure.test-clojure.spec)
310 |   (run-tests)
311 | 
312 |   )
313 | 


--------------------------------------------------------------------------------
/src/main/clojure/clojure/spec/test/alpha.clj:
--------------------------------------------------------------------------------
  1 | ;   Copyright (c) Rich Hickey. All rights reserved.
  2 | ;   The use and distribution terms for this software are covered by the
  3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
  5 | ;   By using this software in any fashion, you are agreeing to be bound by
  6 | ;   the terms of this license.
  7 | ;   You must not remove this notice, or any other, from this software.
  8 | 
  9 | (ns clojure.spec.test.alpha
 10 |   (:refer-clojure :exclude [test])
 11 |   (:require
 12 |    [clojure.pprint :as pp]
 13 |    [clojure.spec.alpha :as s]
 14 |    [clojure.spec.gen.alpha :as gen]
 15 |    [clojure.string :as str]))
 16 | 
 17 | (in-ns 'clojure.spec.test.check)
 18 | (in-ns 'clojure.spec.test.alpha)
 19 | (alias 'stc 'clojure.spec.test.check)
 20 | 
 21 | (defn- throwable?
 22 |   [x]
 23 |   (instance? Throwable x))
 24 | 
 25 | (defn ->sym
 26 |   [x]
 27 |   (@#'s/->sym x))
 28 | 
 29 | (defn- ->var
 30 |   [s-or-v]
 31 |   (if (var? s-or-v)
 32 |     s-or-v
 33 |     (let [v (and (symbol? s-or-v) (resolve s-or-v))]
 34 |       (if (var? v)
 35 |         v
 36 |         (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var")))))))
 37 | 
 38 | (defn- collectionize
 39 |   [x]
 40 |   (if (symbol? x)
 41 |     (list x)
 42 |     x))
 43 | 
 44 | (defn enumerate-namespace
 45 |   "Given a symbol naming an ns, or a collection of such symbols,
 46 | returns the set of all symbols naming vars in those nses."
 47 |   [ns-sym-or-syms]
 48 |   (into
 49 |    #{}
 50 |    (mapcat (fn [ns-sym]
 51 |              (map
 52 |               (fn [name-sym]
 53 |                 (symbol (name ns-sym) (name name-sym)))
 54 |               (keys (ns-interns ns-sym)))))
 55 |    (collectionize ns-sym-or-syms)))
 56 | 
 57 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 58 | 
 59 | (def ^:private ^:dynamic *instrument-enabled*
 60 |   "if false, instrumented fns call straight through"
 61 |   true)
 62 | 
 63 | (defn- fn-spec?
 64 |   "Fn-spec must include at least :args or :ret specs."
 65 |   [m]
 66 |   (or (:args m) (:ret m)))
 67 | 
 68 | (defmacro with-instrument-disabled
 69 |   "Disables instrument's checking of calls, within a scope."
 70 |   [& body]
 71 |   `(binding [*instrument-enabled* nil]
 72 |      ~@body))
 73 | 
 74 | (defn- thunk-frame? [s]
 75 |   (str/includes? s "--KVS--EMULATION--THUNK--"))
 76 | 
 77 | (defn- interpret-stack-trace-element
 78 |   "Given the vector-of-syms form of a stacktrace element produced
 79 | by e.g. Throwable->map, returns a map form that adds some keys
 80 | guessing the original Clojure names. Returns a map with
 81 | 
 82 |   :class         class name symbol from stack trace
 83 |   :method        method symbol from stack trace
 84 |   :file          filename from stack trace
 85 |   :line          line number from stack trace
 86 |   :var-scope     optional Clojure var symbol scoping fn def
 87 |   :local-fn      optional local Clojure symbol scoping fn def
 88 | 
 89 | For non-Clojure fns, :scope and :local-fn will be absent."
 90 |   [[cls method file line]]
 91 |   (let [clojure? (contains? '#{invoke invokeStatic} method)
 92 |         demunge #(clojure.lang.Compiler/demunge %)
 93 |         degensym #(str/replace % #"--.*" "")
 94 |         [ns-sym name-sym local] (when clojure?
 95 |                                   (->> (str/split (str cls) #"\$" 3)
 96 |                                        (map demunge)))]
 97 |     (merge {:file file
 98 |             :line line
 99 |             :method method
100 |             :class cls}
101 |            (when (and ns-sym name-sym)
102 |              {:var-scope (symbol ns-sym name-sym)})
103 |            (when local
104 |              {:local-fn (symbol (degensym local))
105 |               :thunk? (thunk-frame? local)}))))
106 | 
107 | (defn- stacktrace-relevant-to-instrument
108 |   "Takes a coll of stack trace elements (as returned by
109 | StackTraceElement->vec) and returns a coll of maps as per
110 | interpret-stack-trace-element that are relevant to a
111 | failure in instrument."
112 |   [elems]
113 |   (let [plumbing? (fn [{:keys [var-scope thunk?]}]
114 |                     (or thunk?
115 |                         (contains? '#{clojure.spec.test.alpha/spec-checking-fn
116 |                                       clojure.core/apply}
117 |                                    var-scope)))]
118 |     (sequence (comp (map StackTraceElement->vec)
119 |                     (map interpret-stack-trace-element)
120 |                     (filter :var-scope)
121 |                     (drop-while plumbing?))
122 |               elems)))
123 | 
124 | (defn- spec-checking-fn
125 |   "Takes a function name, a function f, and an fspec and returns a thunk that
126 |   first conforms the arguments given then calls f with those arguments if
127 |   the conform succeeds. Otherwise, an exception is thrown containing information
128 |   about the conform failure."
129 |   [fn-name f fn-spec]
130 |   (let [fn-spec (@#'s/maybe-spec fn-spec)
131 |         conform! (fn [fn-name role spec data args]
132 |                    (let [conformed (s/conform spec data)]
133 |                      (if (= ::s/invalid conformed)
134 |                        (let [caller (->> (.getStackTrace (Thread/currentThread))
135 |                                          stacktrace-relevant-to-instrument
136 |                                          first)
137 |                              ed (merge (assoc (s/explain-data* spec [] [] [] data)
138 |                                          ::s/fn fn-name
139 |                                          ::s/args args
140 |                                          ::s/failure :instrument)
141 |                                        (when caller
142 |                                          {::caller (dissoc caller :class :method)}))]
143 |                          (throw (ex-info
144 |                                  (str "Call to " fn-name " did not conform to spec.")
145 |                                  ed)))
146 |                        conformed)))]
147 |     (fn
148 |      [& args]
149 |      (if *instrument-enabled*
150 |        (with-instrument-disabled
151 |          (when (:args fn-spec) (conform! fn-name :args (:args fn-spec) args args))
152 |          (binding [*instrument-enabled* true]
153 |            (.applyTo ^clojure.lang.IFn f args)))
154 |        (.applyTo ^clojure.lang.IFn f args)))))
155 | 
156 | (defn- no-fspec
157 |   [v spec]
158 |   (ex-info (str "Fn at " v " is not spec'ed.")
159 |            {:var v :spec spec ::s/failure :no-fspec}))
160 | 
161 | (defonce ^:private instrumented-vars (atom {}))
162 | 
163 | (defn- find-varargs-decl
164 |   "Takes an arglist and returns the restargs binding form if found, else nil."
165 |   [arglist]
166 |   (let [[_ decl :as restargs] (->> arglist
167 |                                    (split-with (complement #{'&}))
168 |                                    second)]
169 |     (and (= 2 (count restargs))
170 |          decl)))
171 | 
172 | (defn- has-kwargs? [arglists]
173 |   (->> arglists (some find-varargs-decl) map?))
174 | 
175 | (defn- kwargs->kvs
176 |   "Takes the restargs of a kwargs function call and checks for a trailing element.
177 |   If found, that element is flattened into a sequence of key->value pairs and
178 |   concatenated onto the preceding arguments."
179 |   [args]
180 |   (if (even? (count args))
181 |      args
182 |      (concat (butlast args)
183 |              (reduce-kv (fn [acc k v] (->> acc (cons v) (cons k)))
184 |                         ()
185 |                         (last args)))))
186 | 
187 | (defn- gen-fixed-args-syms
188 |   "Takes an arglist and generates a vector of names corresponding to the fixed
189 |   args found."
190 |   [arglist]
191 |   (->> arglist (take-while (complement #{'&})) (map (fn [_] (gensym))) vec))
192 | 
193 | (defn- build-kwargs-body
194 |   "Takes a function name fn-name and arglist and returns code for a function body that
195 |   handles kwargs by calling fn-name with any fixed followed by its restargs transformed
196 |   from kwargs to kvs."
197 |   [fn-name arglist]
198 |   (let [alias (gensym "kwargs")
199 |         head-args (gen-fixed-args-syms arglist)]
200 |     (list (conj head-args '& alias)
201 |           `(apply ~fn-name ~@head-args (@#'kwargs->kvs ~alias)))))
202 | 
203 | (defn- build-varargs-body
204 |   "Takes a function name fn-name and arglist and returns code for a function body that
205 |   handles varargs by calling fn-name with any fixed args followed by its rest args."
206 |   [fn-name arglist]
207 |   (let [head-args (gen-fixed-args-syms arglist)
208 |         alias  (gensym "restargs")]
209 |     (list (conj head-args '& alias)
210 |           `(apply ~fn-name ~@head-args ~alias))))
211 | 
212 | (defn- build-fixed-args-body
213 |   "Takes a function name fn-name and arglist and returns code for a function body that
214 |   handles fixed args by calling fn-name with its fixed args."
215 |   [fn-name arglist]
216 |   (let [arglist (gen-fixed-args-syms arglist)]
217 |     (list arglist
218 |           `(~fn-name ~@arglist))))
219 | 
220 | (defn- build-flattener-code
221 |   "Takes argslists and generates code for a HOF that given a function, returns a forwarding thunk
222 |   of analogous arglists that ensures that kwargs are passed as kvs to the original function."
223 |   [arglists]
224 |   (let [closed-over-name (gensym "inner")]
225 |     `(fn [~closed-over-name]
226 |        (fn ~'--KVS--EMULATION--THUNK--
227 |          ~@(map (fn [arglist]
228 |                   (let [varargs-decl (find-varargs-decl arglist)]
229 |                     (cond (map? varargs-decl) (build-kwargs-body     closed-over-name arglist)
230 |                           varargs-decl        (build-varargs-body    closed-over-name arglist)
231 |                           :default            (build-fixed-args-body closed-over-name arglist))))
232 |                 (or arglists
233 |                     '([& args])))))))
234 | 
235 | (comment
236 |   ;; Given a function with the arglists (([a]) ([a b]) ([a b & kvs]))
237 |   ;; the flattener generated is below (with some gensym name cleanup for readability)
238 |   (fn [inner]
239 |     (fn
240 |       ([G__a] (inner G__a))
241 |       ([G__a G__b] (inner G__a G__b))
242 |       ([G__a G__b & G__kvs]
243 |        (apply inner G__a G__b (if (even? (count G__kvs))
244 |                                 G__kvs
245 |                                 (reduce-kv (fn [acc k v]
246 |                                              (->> acc (cons v) (cons k)))
247 |                                                   (butlast G__kvs)
248 |                                                   (last G__kvs)))))))
249 | )
250 | 
251 | (defn- maybe-wrap-kvs-emulation
252 |   "Takes an argslist and function f and returns f except when arglists
253 |   contains a kwargs binding, else wraps f with a forwarding thunk that
254 |   flattens a trailing map into kvs if present in the kwargs call."
255 |   [f arglists]
256 |   (if (has-kwargs? arglists)
257 |     (let [flattener-code (build-flattener-code arglists)
258 |           kvs-emu (eval flattener-code)]
259 |       (kvs-emu f))
260 |     f))
261 | 
262 | (defn- instrument-choose-fn
263 |   "Helper for instrument."
264 |   [f spec sym {over :gen :keys [stub replace]}]
265 |   (if (some #{sym} stub)
266 |     (-> spec (s/gen over) gen/generate)
267 |     (get replace sym f)))
268 | 
269 | (defn- instrument-choose-spec
270 |   "Helper for instrument"
271 |   [spec sym {overrides :spec}]
272 |   (get overrides sym spec))
273 | 
274 | (defn- instrument-1
275 |   [s opts]
276 |   (when-let [v (resolve s)]
277 |     (when-not (-> v meta :macro)
278 |       (let [spec (s/get-spec v)
279 |             {:keys [raw wrapped]} (get @instrumented-vars v)
280 |             current @v
281 |             to-wrap (if (= wrapped current) raw current)
282 |             ospec (or (instrument-choose-spec spec s opts)
283 |                       (throw (no-fspec v spec)))
284 |             ofn (instrument-choose-fn to-wrap ospec s opts)
285 |             checked (spec-checking-fn (->sym v) ofn ospec)
286 |             arglists (->> v meta :arglists (sort-by count) seq)
287 |             wrapped (maybe-wrap-kvs-emulation checked arglists)]
288 |         (alter-var-root v (constantly wrapped))
289 |         (swap! instrumented-vars assoc v {:raw to-wrap :wrapped wrapped})
290 |         (->sym v)))))
291 | 
292 | (defn- unstrument-1
293 |   [s]
294 |   (when-let [v (resolve s)]
295 |     (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)]
296 |       (swap! instrumented-vars dissoc v)
297 |       (let [current @v]
298 |         (when (= wrapped current)
299 |           (alter-var-root v (constantly raw))
300 |           (->sym v))))))
301 | 
302 | (defn- opt-syms
303 |   "Returns set of symbols referenced by 'instrument' opts map"
304 |   [opts]
305 |   (reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))]))
306 | 
307 | (defn- fn-spec-name?
308 |   [s]
309 |   (and (symbol? s)
310 |        (not (some-> (resolve s) meta :macro))))
311 | 
312 | (defn instrumentable-syms
313 |   "Given an opts map as per instrument, returns the set of syms
314 | that can be instrumented."
315 |   ([] (instrumentable-syms nil))
316 |   ([opts]
317 |      (assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys")
318 |      (reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
319 |                        (keys (:spec opts))
320 |                        (:stub opts)
321 |                        (keys (:replace opts))])))
322 | 
323 | (defn instrument
324 |   "Instruments the vars named by sym-or-syms, a symbol or collection
325 | of symbols, or all instrumentable vars if sym-or-syms is not
326 | specified.
327 | 
328 | If a var has an :args fn-spec, sets the var's root binding to a
329 | fn that checks arg conformance (throwing an exception on failure)
330 | before delegating to the original fn.
331 | 
332 | The opts map can be used to override registered specs, and/or to
333 | replace fn implementations entirely. Opts for symbols not included
334 | in sym-or-syms are ignored. This facilitates sharing a common
335 | options map across many different calls to instrument.
336 | 
337 | The opts map may have the following keys:
338 | 
339 |   :spec     a map from var-name symbols to override specs
340 |   :stub     a set of var-name symbols to be replaced by stubs
341 |   :gen      a map from spec names to generator overrides
342 |   :replace  a map from var-name symbols to replacement fns
343 | 
344 | :spec overrides registered fn-specs with specs your provide. Use
345 | :spec overrides to provide specs for libraries that do not have
346 | them, or to constrain your own use of a fn to a subset of its
347 | spec'ed contract.
348 | 
349 | :stub replaces a fn with a stub that checks :args, then uses the
350 | :ret spec to generate a return value.
351 | 
352 | :gen overrides are used only for :stub generation.
353 | 
354 | :replace replaces a fn with a fn that checks args conformance, then
355 | invokes the fn you provide, enabling arbitrary stubbing and mocking.
356 | 
357 | :spec can be used in combination with :stub or :replace.
358 | 
359 | Returns a collection of syms naming the vars instrumented."
360 |   ([] (instrument (instrumentable-syms)))
361 |   ([sym-or-syms] (instrument sym-or-syms nil))
362 |   ([sym-or-syms opts]
363 |      (locking instrumented-vars
364 |        (into
365 |         []
366 |         (comp (filter (instrumentable-syms opts))
367 |               (distinct)
368 |               (map #(instrument-1 % opts))
369 |               (remove nil?))
370 |         (collectionize sym-or-syms)))))
371 | 
372 | (defn unstrument
373 |   "Undoes instrument on the vars named by sym-or-syms, specified
374 | as in instrument. With no args, unstruments all instrumented vars.
375 | Returns a collection of syms naming the vars unstrumented."
376 |   ([] (unstrument (map ->sym (keys @instrumented-vars))))
377 |   ([sym-or-syms]
378 |      (locking instrumented-vars
379 |        (into
380 |         []
381 |         (comp (filter symbol?)
382 |               (map unstrument-1)
383 |               (remove nil?))
384 |         (collectionize sym-or-syms)))))
385 | 
386 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; testing  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
387 | 
388 | (defn- explain-check
389 |   [args spec v role]
390 |   (ex-info
391 |    "Specification-based check failed"
392 |    (when-not (s/valid? spec v nil)
393 |      (assoc (s/explain-data* spec [role] [] [] v)
394 |        ::args args
395 |        ::val v
396 |        ::s/failure :check-failed))))
397 | 
398 | (defn- check-call
399 |   "Returns true if call passes specs, otherwise *returns* an exception
400 | with explain-data + ::s/failure."
401 |   [f specs args]
402 |   (let [cargs (when (:args specs) (s/conform (:args specs) args))]
403 |     (if (= cargs ::s/invalid)
404 |       (explain-check args (:args specs) args :args)
405 |       (let [ret (apply f args)
406 |             cret (when (:ret specs) (s/conform (:ret specs) ret))]
407 |         (if (= cret ::s/invalid)
408 |           (explain-check args (:ret specs) ret :ret)
409 |           (if (and (:args specs) (:ret specs) (:fn specs))
410 |             (if (s/valid? (:fn specs) {:args cargs :ret cret})
411 |               true
412 |               (explain-check args (:fn specs) {:args cargs :ret cret} :fn))
413 |             true))))))
414 | 
415 | (defn- quick-check
416 |   [f specs {gen :gen opts ::stc/opts}]
417 |   (let [{:keys [num-tests] :or {num-tests 1000}} opts
418 |         g (try (s/gen (:args specs) gen) (catch Throwable t t))]
419 |     (if (throwable? g)
420 |       {:result g}
421 |       (let [prop (gen/for-all* [g] #(check-call f specs %))]
422 |         (apply gen/quick-check num-tests prop (mapcat identity opts))))))
423 | 
424 | (defn- make-check-result
425 |   "Builds spec result map."
426 |   [check-sym spec test-check-ret]
427 |   (merge {:spec spec
428 |           ::stc/ret test-check-ret}
429 |          (when check-sym
430 |            {:sym check-sym})
431 |          (when-let [result (-> test-check-ret :result)]
432 |            (when-not (true? result) {:failure result}))
433 |          (when-let [shrunk (-> test-check-ret :shrunk)]
434 |            {:failure (:result shrunk)})))
435 | 
436 | (defn- check-1
437 |   [{:keys [s f v spec]} opts]
438 |   (let [re-inst? (and v (seq (unstrument s)) true)
439 |         f (or f (when v @v))
440 |         specd (s/spec spec)]
441 |     (try
442 |      (cond
443 |       (or (nil? f) (some-> v meta :macro))
444 |       {:failure (ex-info "No fn to spec" {::s/failure :no-fn})
445 |        :sym s :spec spec}
446 |     
447 |       (:args specd)
448 |       (let [tcret (quick-check f specd opts)]
449 |         (make-check-result s spec tcret))
450 |     
451 |       :default
452 |       {:failure (ex-info "No :args spec" {::s/failure :no-args-spec})
453 |        :sym s :spec spec})
454 |      (finally
455 |       (when re-inst? (instrument s))))))
456 | 
457 | (defn- sym->check-map
458 |   [s]
459 |   (let [v (resolve s)]
460 |     {:s s
461 |      :v v
462 |      :spec (when v (s/get-spec v))}))
463 | 
464 | (defn- validate-check-opts
465 |   [opts]
466 |   (assert (every? ident? (keys (:gen opts))) "check :gen expects ident keys"))
467 | 
468 | (defn check-fn
469 |   "Runs generative tests for fn f using spec and opts. See
470 | 'check' for options and return."
471 |   ([f spec] (check-fn f spec nil))
472 |   ([f spec opts]
473 |      (validate-check-opts opts)
474 |      (check-1 {:f f :spec spec} opts)))
475 | 
476 | (defn checkable-syms
477 |   "Given an opts map as per check, returns the set of syms that
478 | can be checked."
479 |   ([] (checkable-syms nil))
480 |   ([opts]
481 |      (validate-check-opts opts)
482 |      (reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
483 |                        (keys (:spec opts))])))
484 | 
485 | (defn check
486 |   "Run generative tests for spec conformance on vars named by
487 | sym-or-syms, a symbol or collection of symbols. If sym-or-syms
488 | is not specified, check all checkable vars.
489 | 
490 | The opts map includes the following optional keys, where stc
491 | aliases clojure.spec.test.check: 
492 | 
493 | ::stc/opts  opts to flow through test.check/quick-check
494 | :gen        map from spec names to generator overrides
495 | 
496 | The ::stc/opts include :num-tests in addition to the keys
497 | documented by test.check. Generator overrides are passed to
498 | spec/gen when generating function args.
499 | 
500 | Returns a lazy sequence of check result maps with the following
501 | keys
502 | 
503 | :spec       the spec tested
504 | :sym        optional symbol naming the var tested
505 | :failure    optional test failure
506 | ::stc/ret   optional value returned by test.check/quick-check
507 | 
508 | The value for :failure can be any exception. Exceptions thrown by
509 | spec itself will have an ::s/failure value in ex-data:
510 | 
511 | :check-failed   at least one checked return did not conform
512 | :no-args-spec   no :args spec provided
513 | :no-fn          no fn provided
514 | :no-fspec       no fspec provided
515 | :no-gen         unable to generate :args
516 | :instrument     invalid args detected by instrument
517 | "
518 |   ([] (check (checkable-syms)))
519 |   ([sym-or-syms] (check sym-or-syms nil))
520 |   ([sym-or-syms opts]
521 |      (->> (collectionize sym-or-syms)
522 |           (filter (checkable-syms opts))
523 |           (pmap
524 |            #(check-1 (sym->check-map %) opts)))))
525 | 
526 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check reporting  ;;;;;;;;;;;;;;;;;;;;;;;;
527 | 
528 | (defn- failure-type
529 |   [x]
530 |   (::s/failure (ex-data x)))
531 | 
532 | (defn- unwrap-failure
533 |   [x]
534 |   (if (failure-type x)
535 |     (ex-data x)
536 |     x))
537 | 
538 | (defn- result-type
539 |   "Returns the type of the check result. This can be any of the
540 | ::s/failure keywords documented in 'check', or:
541 | 
542 |   :check-passed   all checked fn returns conformed
543 |   :check-threw    checked fn threw an exception"
544 |   [ret]
545 |   (let [failure (:failure ret)]
546 |     (cond
547 |      (nil? failure) :check-passed
548 |      (failure-type failure) (failure-type failure)
549 |      :default :check-threw)))
550 | 
551 | (defn abbrev-result
552 |   "Given a check result, returns an abbreviated version
553 | suitable for summary use."
554 |   [x]
555 |   (if (:failure x)
556 |     (-> (dissoc x ::stc/ret)
557 |         (update :spec s/describe)
558 |         (update :failure unwrap-failure))
559 |     (dissoc x :spec ::stc/ret)))
560 | 
561 | (defn summarize-results
562 |   "Given a collection of check-results, e.g. from 'check', pretty
563 | prints the summary-result (default abbrev-result) of each.
564 | 
565 | Returns a map with :total, the total number of results, plus a
566 | key with a count for each different :type of result."
567 |   ([check-results] (summarize-results check-results abbrev-result))
568 |   ([check-results summary-result]
569 |      (reduce
570 |       (fn [summary result]
571 |         (pp/pprint (summary-result result))
572 |         (-> summary
573 |             (update :total inc)
574 |             (update (result-type result) (fnil inc 0))))
575 |       {:total 0}
576 |        check-results)))
577 | 
578 | 
579 | 
580 | 


--------------------------------------------------------------------------------
/src/main/clojure/clojure/spec/alpha.clj:
--------------------------------------------------------------------------------
   1 | ;   Copyright (c) Rich Hickey. All rights reserved.
   2 | ;   The use and distribution terms for this software are covered by the
   3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
   5 | ;   By using this software in any fashion, you are agreeing to be bound by
   6 | ;   the terms of this license.
   7 | ;   You must not remove this notice, or any other, from this software.
   8 | 
   9 | (ns
  10 |  ^{:doc "The spec library specifies the structure of data or functions and provides
  11 |   operations to validate, conform, explain, describe, and generate data based on
  12 |   the specs.
  13 | 
  14 |   Rationale: https://clojure.org/about/spec
  15 |   Guide: https://clojure.org/guides/spec"}
  16 |   clojure.spec.alpha
  17 |   (:refer-clojure :exclude [+ * and assert or cat def keys merge])
  18 |   (:require [clojure.walk :as walk]
  19 |             [clojure.spec.gen.alpha :as gen]
  20 |             [clojure.string :as str]))
  21 | 
  22 | (alias 'c 'clojure.core)
  23 | 
  24 | (set! *warn-on-reflection* true)
  25 | 
  26 | (def ^:dynamic *recursion-limit*
  27 |   "A soft limit on how many times a branching spec (or/alt/*/opt-keys/multi-spec)
  28 |   can be recursed through during generation. After this a
  29 |   non-recursive branch will be chosen."
  30 |   4)
  31 | 
  32 | (def ^:dynamic *fspec-iterations*
  33 |   "The number of times an anonymous fn specified by fspec will be (generatively) tested during conform"
  34 |   21)
  35 | 
  36 | (def ^:dynamic *coll-check-limit*
  37 |   "The number of elements validated in a collection spec'ed with 'every'"
  38 |   101)
  39 | 
  40 | (def ^:dynamic *coll-error-limit*
  41 |   "The number of errors reported by explain in a collection spec'ed with 'every'"
  42 |   20)
  43 | 
  44 | (defprotocol Spec
  45 |   (conform* [spec x])
  46 |   (unform* [spec y])
  47 |   (explain* [spec path via in x])
  48 |   (gen* [spec overrides path rmap])
  49 |   (with-gen* [spec gfn])
  50 |   (describe* [spec]))
  51 | 
  52 | (defonce ^:private registry-ref (atom {}))
  53 | 
  54 | (defn- deep-resolve [reg k]
  55 |   (loop [spec k]
  56 |     (if (ident? spec)
  57 |       (recur (get reg spec))
  58 |       spec)))
  59 | 
  60 | (defn- reg-resolve
  61 |   "returns the spec/regex at end of alias chain starting with k, nil if not found, k if k not ident"
  62 |   [k]
  63 |   (if (ident? k)
  64 |     (let [reg @registry-ref
  65 |           spec (get reg k)]
  66 |       (if-not (ident? spec)
  67 |         spec
  68 |         (deep-resolve reg spec)))
  69 |     k))
  70 | 
  71 | (defn- reg-resolve!
  72 |   "returns the spec/regex at end of alias chain starting with k, throws if not found, k if k not ident"
  73 |   [k]
  74 |   (if (ident? k)
  75 |     (c/or (reg-resolve k)
  76 |           (throw (Exception. (str "Unable to resolve spec: " k))))
  77 |     k))
  78 | 
  79 | (defn spec?
  80 |   "returns x if x is a spec object, else logical false"
  81 |   [x]
  82 |   (when (instance? clojure.spec.alpha.Spec x)
  83 |     x))
  84 | 
  85 | (defn regex?
  86 |   "returns x if x is a (clojure.spec) regex op, else logical false"
  87 |   [x]
  88 |   (c/and (::op x) x))
  89 | 
  90 | (defn- with-name [spec name]
  91 |   (cond
  92 |    (ident? spec) spec
  93 |    (regex? spec) (assoc spec ::name name)
  94 | 
  95 |    (instance? clojure.lang.IObj spec)
  96 |    (with-meta spec (assoc (meta spec) ::name name))))
  97 | 
  98 | (defn- spec-name [spec]
  99 |   (cond
 100 |    (ident? spec) spec
 101 | 
 102 |    (regex? spec) (::name spec)
 103 |    
 104 |    (instance? clojure.lang.IObj spec)
 105 |    (-> (meta spec) ::name)))
 106 | 
 107 | (declare spec-impl)
 108 | (declare regex-spec-impl)
 109 | 
 110 | (defn- maybe-spec
 111 |   "spec-or-k must be a spec, regex or resolvable kw/sym, else returns nil."
 112 |   [spec-or-k]
 113 |   (let [s (c/or (c/and (ident? spec-or-k) (reg-resolve spec-or-k))
 114 |                 (spec? spec-or-k)
 115 |                 (regex? spec-or-k)
 116 |                 nil)]
 117 |     (if (regex? s)
 118 |       (with-name (regex-spec-impl s nil) (spec-name s))
 119 |       s)))
 120 | 
 121 | (defn- the-spec
 122 |   "spec-or-k must be a spec, regex or kw/sym, else returns nil. Throws if unresolvable kw/sym"
 123 |   [spec-or-k]
 124 |   (c/or (maybe-spec spec-or-k)
 125 |         (when (ident? spec-or-k)
 126 |           (throw (Exception. (str "Unable to resolve spec: " spec-or-k))))))
 127 | 
 128 | (defprotocol Specize
 129 |   (specize* [_] [_ form]))
 130 | 
 131 | (defn- fn-sym [^Object f]
 132 |   (let [[_ f-ns f-n] (re-matches #"(.*)\$(.*?)(__[0-9]+)?" (.. f getClass getName))]
 133 |     ;; check for anonymous function
 134 |     (when (not= "fn" f-n)
 135 |       (symbol (clojure.lang.Compiler/demunge f-ns) (clojure.lang.Compiler/demunge f-n)))))
 136 | 
 137 | (extend-protocol Specize
 138 |   clojure.lang.Keyword
 139 |   (specize* ([k] (specize* (reg-resolve! k)))
 140 |             ([k _] (specize* (reg-resolve! k))))
 141 | 
 142 |   clojure.lang.Symbol
 143 |   (specize* ([s] (specize* (reg-resolve! s)))
 144 |             ([s _] (specize* (reg-resolve! s))))
 145 | 
 146 |   clojure.lang.IPersistentSet
 147 |   (specize* ([s] (spec-impl s s nil nil))
 148 |             ([s form] (spec-impl form s nil nil)))
 149 | 
 150 |   Object
 151 |   (specize* ([o] (if (c/and (not (map? o)) (ifn? o))
 152 |                    (if-let [s (fn-sym o)]
 153 |                      (spec-impl s o nil nil)
 154 |                      (spec-impl ::unknown o nil nil))
 155 |                    (spec-impl ::unknown o nil nil)))
 156 |             ([o form] (spec-impl form o nil nil))))
 157 | 
 158 | (defn- specize
 159 |   ([s] (c/or (spec? s) (specize* s)))
 160 |   ([s form] (c/or (spec? s) (specize* s form))))
 161 | 
 162 | (defn invalid?
 163 |   "tests the validity of a conform return value"
 164 |   [ret]
 165 |   (identical? ::invalid ret))
 166 | 
 167 | (defn conform
 168 |   "Given a spec and a value, returns :clojure.spec.alpha/invalid 
 169 | 	if value does not match spec, else the (possibly destructured) value."
 170 |   [spec x]
 171 |   (conform* (specize spec) x))
 172 | 
 173 | (defn unform
 174 |   "Given a spec and a value created by or compliant with a call to
 175 |   'conform' with the same spec, returns a value with all conform
 176 |   destructuring undone."
 177 |   [spec x]
 178 |   (unform* (specize spec) x))
 179 | 
 180 | (defn form
 181 |   "returns the spec as data"
 182 |   [spec]
 183 |   ;;TODO - incorporate gens
 184 |   (describe* (specize spec)))
 185 | 
 186 | (defn abbrev [form]
 187 |   (cond
 188 |    (seq? form)
 189 |    (walk/postwalk (fn [form]
 190 |                     (cond
 191 |                      (c/and (symbol? form) (namespace form))
 192 |                      (-> form name symbol)
 193 | 
 194 |                      (c/and (seq? form) (= 'fn (first form)) (= '[%] (second form)))
 195 |                      (last form)
 196 |                      
 197 |                      :else form))
 198 |                   form)
 199 | 
 200 |    (c/and (symbol? form) (namespace form))
 201 |    (-> form name symbol)
 202 | 
 203 |    :else form))
 204 | 
 205 | (defn describe
 206 |   "returns an abbreviated description of the spec as data"
 207 |   [spec]
 208 |   (abbrev (form spec)))
 209 | 
 210 | (defn with-gen
 211 |   "Takes a spec and a no-arg, generator-returning fn and returns a version of that spec that uses that generator"
 212 |   [spec gen-fn]
 213 |   (let [spec (reg-resolve spec)]
 214 |     (if (regex? spec)
 215 |       (assoc spec ::gfn gen-fn)
 216 |       (with-gen* (specize spec) gen-fn))))
 217 | 
 218 | (defn explain-data* [spec path via in x]
 219 |   (let [probs (explain* (specize spec) path via in x)]
 220 |     (when-not (empty? probs)
 221 |       {::problems probs
 222 |        ::spec spec
 223 |        ::value x})))
 224 | 
 225 | (defn explain-data
 226 |   "Given a spec and a value x which ought to conform, returns nil if x
 227 |   conforms, else a map with at least the key ::problems whose value is
 228 |   a collection of problem-maps, where problem-map has at least :path :pred and :val
 229 |   keys describing the predicate and the value that failed at that
 230 |   path."
 231 |   [spec x]
 232 |   (explain-data* spec [] (if-let [name (spec-name spec)] [name] []) [] x))
 233 | 
 234 | (defn explain-printer
 235 |   "Default printer for explain-data. nil indicates a successful validation."
 236 |   [ed]
 237 |   (if ed
 238 |     (let [problems (->> (::problems ed)
 239 |                      (sort-by #(- (count (:in %))))
 240 |                      (sort-by #(- (count (:path %)))))]
 241 |       ;;(prn {:ed ed})
 242 |       (doseq [{:keys [path pred val reason via in] :as prob} problems]
 243 |         (pr val)
 244 |         (print " - failed: ")
 245 |         (if reason (print reason) (pr (abbrev pred)))
 246 |         (when-not (empty? in)
 247 |           (print (str " in: " (pr-str in))))
 248 |         (when-not (empty? path)
 249 |           (print (str " at: " (pr-str path))))
 250 |         (when-not (empty? via)
 251 |           (print (str " spec: " (pr-str (last via)))))
 252 |         (doseq [[k v] prob]
 253 |           (when-not (#{:path :pred :val :reason :via :in} k)
 254 |             (print "\n\t" (pr-str k) " ")
 255 |             (pr v)))
 256 |         (newline)))
 257 |     (println "Success!")))
 258 | 
 259 | (def ^:dynamic *explain-out* explain-printer)
 260 | 
 261 | (defn explain-out
 262 |   "Prints explanation data (per 'explain-data') to *out* using the printer in *explain-out*,
 263 |    by default explain-printer."
 264 |   [ed]
 265 |   (*explain-out* ed))
 266 | 
 267 | (defn explain
 268 |   "Given a spec and a value that fails to conform, prints an explanation to *out*."
 269 |   [spec x]
 270 |   (explain-out (explain-data spec x)))
 271 | 
 272 | (defn explain-str
 273 |   "Given a spec and a value that fails to conform, returns an explanation as a string."
 274 |   ^String [spec x]
 275 |   (with-out-str (explain spec x)))
 276 | 
 277 | (declare valid?)
 278 | 
 279 | (defn- gensub
 280 |   [spec overrides path rmap form]
 281 |   ;;(prn {:spec spec :over overrides :path path :form form})
 282 |   (let [spec (specize spec)]
 283 |     (if-let [g (c/or (when-let [gfn (c/or (get overrides (c/or (spec-name spec) spec))
 284 |                                           (get overrides path))]
 285 |                        (gfn))
 286 |                      (gen* spec overrides path rmap))]
 287 |       (gen/such-that #(valid? spec %) g 100)
 288 |       (let [abbr (abbrev form)]
 289 |         (throw (ex-info (str "Unable to construct gen at: " path " for: " abbr)
 290 |                         {::path path ::form form ::failure :no-gen}))))))
 291 | 
 292 | (defn gen
 293 |   "Given a spec, returns the generator for it, or throws if none can
 294 |   be constructed. Optionally an overrides map can be provided which
 295 |   should map spec names or paths (vectors of keywords) to no-arg
 296 |   generator-creating fns. These will be used instead of the generators at those
 297 |   names/paths. Note that parent generator (in the spec or overrides
 298 |   map) will supersede those of any subtrees. A generator for a regex
 299 |   op must always return a sequential collection (i.e. a generator for
 300 |   s/? should return either an empty sequence/vector or a
 301 |   sequence/vector with one item in it)"
 302 |   ([spec] (gen spec nil))
 303 |   ([spec overrides] (gensub spec overrides [] {::recursion-limit *recursion-limit*} spec)))
 304 | 
 305 | (defn- ->sym
 306 |   "Returns a symbol from a symbol or var"
 307 |   [x]
 308 |   (if (var? x)
 309 |     (symbol x)
 310 |     x))
 311 | 
 312 | (defn- unfn [expr]
 313 |   (if (c/and (seq? expr)
 314 |              (symbol? (first expr))
 315 |              (= "fn*" (name (first expr))))
 316 |     (let [[[s] & form] (rest expr)]
 317 |       (conj (walk/postwalk-replace {s '%} form) '[%] 'fn))
 318 |     expr))
 319 | 
 320 | (defn- res [form]
 321 |   (cond
 322 |    (keyword? form) form
 323 |    (symbol? form) (c/or (-> form resolve ->sym) form)   
 324 |    (sequential? form) (walk/postwalk #(if (symbol? %) (res %) %) (unfn form))
 325 |    :else form))
 326 | 
 327 | (defn ^:skip-wiki def-impl
 328 |   "Do not call this directly, use 'def'"
 329 |   [k form spec]
 330 |   (c/assert (c/and (ident? k) (namespace k)) "k must be namespaced keyword or resolvable symbol")
 331 |   (if (nil? spec)
 332 |     (swap! registry-ref dissoc k)
 333 |     (let [spec (if (c/or (spec? spec) (regex? spec) (get @registry-ref spec))
 334 |                  spec
 335 |                  (spec-impl form spec nil nil))]
 336 |       (swap! registry-ref assoc k (with-name spec k))))
 337 |   k)
 338 | 
 339 | (defn- ns-qualify
 340 |   "Qualify symbol s by resolving it or using the current *ns*."
 341 |   [s]
 342 |   (if-let [ns-sym (some-> s namespace symbol)]
 343 |     (c/or (some-> (get (ns-aliases *ns*) ns-sym) str (symbol (name s)))
 344 |           s)
 345 |     (symbol (str (.name *ns*)) (str s))))
 346 | 
 347 | (defmacro def
 348 |   "Given a namespace-qualified keyword or resolvable symbol k, and a
 349 |   spec, spec-name, predicate or regex-op makes an entry in the
 350 |   registry mapping k to the spec. Use nil to remove an entry in
 351 |   the registry for k."
 352 |   [k spec-form]
 353 |   (let [k (if (symbol? k) (ns-qualify k) k)]
 354 |     `(def-impl '~k '~(res spec-form) ~spec-form)))
 355 | 
 356 | (defn registry
 357 |   "returns the registry map, prefer 'get-spec' to lookup a spec by name"
 358 |   []
 359 |   @registry-ref)
 360 | 
 361 | (defn get-spec
 362 |   "Returns spec registered for keyword/symbol/var k, or nil."
 363 |   [k]
 364 |   (get (registry) (if (keyword? k) k (->sym k))))
 365 | 
 366 | (defmacro spec
 367 |   "Takes a single predicate form, e.g. can be the name of a predicate,
 368 |   like even?, or a fn literal like #(< % 42). Note that it is not
 369 |   generally necessary to wrap predicates in spec when using the rest
 370 |   of the spec macros, only to attach a unique generator
 371 | 
 372 |   Can also be passed the result of one of the regex ops -
 373 |   cat, alt, *, +, ?, in which case it will return a regex-conforming
 374 |   spec, useful when nesting an independent regex.
 375 |   ---
 376 | 
 377 |   Optionally takes :gen generator-fn, which must be a fn of no args that
 378 |   returns a test.check generator.
 379 | 
 380 |   Returns a spec."
 381 |   [form & {:keys [gen]}]
 382 |   (when form
 383 |     `(spec-impl '~(res form) ~form ~gen nil)))
 384 | 
 385 | (defmacro multi-spec
 386 |   "Takes the name of a spec/predicate-returning multimethod and a
 387 |   tag-restoring keyword or fn (retag).  Returns a spec that when
 388 |   conforming or explaining data will pass it to the multimethod to get
 389 |   an appropriate spec. You can e.g. use multi-spec to dynamically and
 390 |   extensibly associate specs with 'tagged' data (i.e. data where one
 391 |   of the fields indicates the shape of the rest of the structure).
 392 | 
 393 |   (defmulti mspec :tag)
 394 | 
 395 |   The methods should ignore their argument and return a predicate/spec:
 396 |   (defmethod mspec :int [_] (s/keys :req-un [::tag ::i]))
 397 | 
 398 |   retag is used during generation to retag generated values with
 399 |   matching tags. retag can either be a keyword, at which key the
 400 |   dispatch-tag will be assoc'ed, or a fn of generated value and
 401 |   dispatch-tag that should return an appropriately retagged value.
 402 | 
 403 |   Note that because the tags themselves comprise an open set,
 404 |   the tag key spec cannot enumerate the values, but can e.g.
 405 |   test for keyword?.
 406 | 
 407 |   Note also that the dispatch values of the multimethod will be
 408 |   included in the path, i.e. in reporting and gen overrides, even
 409 |   though those values are not evident in the spec.
 410 | "
 411 |   [mm retag]
 412 |   `(multi-spec-impl '~(res mm) (var ~mm) ~retag))
 413 | 
 414 | (defmacro keys
 415 |   "Creates and returns a map validating spec. :req and :opt are both
 416 |   vectors of namespaced-qualified keywords. The validator will ensure
 417 |   the :req keys are present. The :opt keys serve as documentation and
 418 |   may be used by the generator.
 419 | 
 420 |   The :req key vector supports 'and' and 'or' for key groups:
 421 | 
 422 |   (s/keys :req [::x ::y (or ::secret (and ::user ::pwd))] :opt [::z])
 423 | 
 424 |   There are also -un versions of :req and :opt. These allow
 425 |   you to connect unqualified keys to specs.  In each case, fully
 426 |   qualified keywords are passed, which name the specs, but unqualified
 427 |   keys (with the same name component) are expected and checked at
 428 |   conform-time, and generated during gen:
 429 | 
 430 |   (s/keys :req-un [:my.ns/x :my.ns/y])
 431 | 
 432 |   The above says keys :x and :y are required, and will be validated
 433 |   and generated by specs (if they exist) named :my.ns/x :my.ns/y 
 434 |   respectively.
 435 | 
 436 |   In addition, the values of *all* namespace-qualified keys will be validated
 437 |   (and possibly destructured) by any registered specs. Note: there is
 438 |   no support for inline value specification, by design.
 439 | 
 440 |   Optionally takes :gen generator-fn, which must be a fn of no args that
 441 |   returns a test.check generator."
 442 |   [& {:keys [req req-un opt opt-un gen]}]
 443 |   (let [unk #(-> % name keyword)
 444 |         req-keys (filterv keyword? (flatten req))
 445 |         req-un-specs (filterv keyword? (flatten req-un))
 446 |         _ (c/assert (every? #(c/and (keyword? %) (namespace %)) (concat req-keys req-un-specs opt opt-un))
 447 |                     "all keys must be namespace-qualified keywords")
 448 |         req-specs (into req-keys req-un-specs)
 449 |         req-keys (into req-keys (map unk req-un-specs))
 450 |         opt-keys (into (vec opt) (map unk opt-un))
 451 |         opt-specs (into (vec opt) opt-un)
 452 |         gx (gensym)
 453 |         parse-req (fn [rk f]
 454 |                     (map (fn [x]
 455 |                            (if (keyword? x)
 456 |                              `(contains? ~gx ~(f x))
 457 |                              (walk/postwalk
 458 |                                (fn [y] (if (keyword? y) `(contains? ~gx ~(f y)) y))
 459 |                                x)))
 460 |                          rk))
 461 |         pred-exprs [`(map? ~gx)]
 462 |         pred-exprs (into pred-exprs (parse-req req identity))
 463 |         pred-exprs (into pred-exprs (parse-req req-un unk))
 464 |         keys-pred `(fn* [~gx] (c/and ~@pred-exprs))
 465 |         pred-exprs (mapv (fn [e] `(fn* [~gx] ~e)) pred-exprs)
 466 |         pred-forms (walk/postwalk res pred-exprs)]
 467 |     ;; `(map-spec-impl ~req-keys '~req ~opt '~pred-forms ~pred-exprs ~gen)
 468 |     `(map-spec-impl {:req '~req :opt '~opt :req-un '~req-un :opt-un '~opt-un
 469 |                      :req-keys '~req-keys :req-specs '~req-specs
 470 |                      :opt-keys '~opt-keys :opt-specs '~opt-specs
 471 |                      :pred-forms '~pred-forms
 472 |                      :pred-exprs ~pred-exprs
 473 |                      :keys-pred ~keys-pred
 474 |                      :gfn ~gen})))
 475 | 
 476 | (defmacro or
 477 |   "Takes key+pred pairs, e.g.
 478 | 
 479 |   (s/or :even even? :small #(< % 42))
 480 | 
 481 |   Returns a destructuring spec that returns a map entry containing the
 482 |   key of the first matching pred and the corresponding value. Thus the
 483 |   'key' and 'val' functions can be used to refer generically to the
 484 |   components of the tagged return."
 485 |   [& key-pred-forms]
 486 |   (let [pairs (partition 2 key-pred-forms)
 487 |         keys (mapv first pairs)
 488 |         pred-forms (mapv second pairs)
 489 |         pf (mapv res pred-forms)]
 490 |     (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "spec/or expects k1 p1 k2 p2..., where ks are keywords")
 491 |     `(or-spec-impl ~keys '~pf ~pred-forms nil)))
 492 | 
 493 | (defmacro and
 494 |   "Takes predicate/spec-forms, e.g.
 495 | 
 496 |   (s/and even? #(< % 42))
 497 | 
 498 |   Returns a spec that returns the conformed value. Successive
 499 |   conformed values propagate through rest of predicates."
 500 |   [& pred-forms]
 501 |   `(and-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil))
 502 | 
 503 | (defmacro merge
 504 |   "Takes map-validating specs (e.g. 'keys' specs) and
 505 |   returns a spec that returns a conformed map satisfying all of the
 506 |   specs.  Unlike 'and', merge can generate maps satisfying the
 507 |   union of the predicates."
 508 |   [& pred-forms]
 509 |   `(merge-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil))
 510 | 
 511 | (defn- res-kind
 512 |   [opts]
 513 |   (let [{kind :kind :as mopts} opts]
 514 |     (->>
 515 |       (if kind
 516 |         (assoc mopts :kind `~(res kind))
 517 |         mopts)
 518 |       (mapcat identity))))
 519 | 
 520 | (defmacro every
 521 |   "takes a pred and validates collection elements against that pred.
 522 | 
 523 |   Note that 'every' does not do exhaustive checking, rather it samples
 524 |   *coll-check-limit* elements. Nor (as a result) does it do any
 525 |   conforming of elements. 'explain' will report at most *coll-error-limit*
 526 |   problems.  Thus 'every' should be suitable for potentially large
 527 |   collections.
 528 | 
 529 |   Takes several kwargs options that further constrain the collection:
 530 | 
 531 |   :kind - a pred that the collection type must satisfy, e.g. vector?
 532 |         (default nil) Note that if :kind is specified and :into is
 533 |         not, this pred must generate in order for every to generate.
 534 |   :count - specifies coll has exactly this count (default nil)
 535 |   :min-count, :max-count - coll has count (<= min-count count max-count) (defaults nil)
 536 |   :distinct - all the elements are distinct (default nil)
 537 | 
 538 |   And additional args that control gen
 539 | 
 540 |   :gen-max - the maximum coll size to generate (default 20)
 541 |   :into - one of [], (), {}, #{} - the default collection to generate into
 542 |       (default: empty coll as generated by :kind pred if supplied, else [])
 543 |   
 544 |   Optionally takes :gen generator-fn, which must be a fn of no args that
 545 |   returns a test.check generator
 546 | 
 547 |   See also - coll-of, every-kv
 548 | "
 549 |   [pred & {:keys [into kind count max-count min-count distinct gen-max gen] :as opts}]
 550 |   (let [desc (::describe opts)
 551 |         nopts (-> opts
 552 |                 (dissoc :gen ::describe)
 553 |                 (assoc ::kind-form `'~(res (:kind opts))
 554 |                        ::describe (c/or desc `'(every ~(res pred) ~@(res-kind opts)))))
 555 |         gx (gensym)
 556 |         cpreds (cond-> [(list (c/or kind `coll?) gx)]
 557 |                        count (conj `(= ~count (bounded-count ~count ~gx)))
 558 |                        
 559 |                        (c/or min-count max-count)
 560 |                        (conj `(<= (c/or ~min-count 0)
 561 |                                    (bounded-count (if ~max-count (inc ~max-count) ~min-count) ~gx)
 562 |                                    (c/or ~max-count Integer/MAX_VALUE)))
 563 | 
 564 |                        distinct
 565 |                        (conj `(c/or (empty? ~gx) (apply distinct? ~gx))))]
 566 |     `(every-impl '~pred ~pred ~(assoc nopts ::cpred `(fn* [~gx] (c/and ~@cpreds))) ~gen)))
 567 | 
 568 | (defmacro every-kv
 569 |   "like 'every' but takes separate key and val preds and works on associative collections.
 570 | 
 571 |   Same options as 'every', :into defaults to {}
 572 | 
 573 |   See also - map-of"
 574 | 
 575 |   [kpred vpred & opts]
 576 |   (let [desc `(every-kv ~(res kpred) ~(res vpred) ~@(res-kind opts))]
 577 |     `(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (nth v# 0)) :into {} ::describe '~desc ~@opts)))
 578 | 
 579 | (defmacro coll-of
 580 |   "Returns a spec for a collection of items satisfying pred. Unlike
 581 |   'every', coll-of will exhaustively conform every value.
 582 | 
 583 |   Same options as 'every'. conform will produce a collection
 584 |   corresponding to :into if supplied, else will match the input collection,
 585 |   avoiding rebuilding when possible.
 586 | 
 587 |   See also - every, map-of"
 588 |   [pred & opts]
 589 |   (let [desc `(coll-of ~(res pred) ~@(res-kind opts))]
 590 |     `(every ~pred ::conform-all true ::describe '~desc ~@opts)))
 591 | 
 592 | (defmacro map-of
 593 |   "Returns a spec for a map whose keys satisfy kpred and vals satisfy
 594 |   vpred. Unlike 'every-kv', map-of will exhaustively conform every
 595 |   value.
 596 | 
 597 |   Same options as 'every', :kind defaults to map?, with the addition of:
 598 | 
 599 |   :conform-keys - conform keys as well as values (default false)
 600 | 
 601 |   See also - every-kv"
 602 |   [kpred vpred & opts]
 603 |   (let [desc `(map-of ~(res kpred) ~(res vpred) ~@(res-kind opts))]
 604 |     `(every-kv ~kpred ~vpred ::conform-all true :kind map? ::describe '~desc ~@opts)))
 605 | 
 606 | 
 607 | (defmacro *
 608 |   "Returns a regex op that matches zero or more values matching
 609 |   pred. Produces a vector of matches iff there is at least one match"
 610 |   [pred-form]
 611 |   `(rep-impl '~(res pred-form) ~pred-form))
 612 | 
 613 | (defmacro +
 614 |   "Returns a regex op that matches one or more values matching
 615 |   pred. Produces a vector of matches"
 616 |   [pred-form]
 617 |   `(rep+impl '~(res pred-form) ~pred-form))
 618 | 
 619 | (defmacro ?
 620 |   "Returns a regex op that matches zero or one value matching
 621 |   pred. Produces a single value (not a collection) if matched."
 622 |   [pred-form]
 623 |   `(maybe-impl ~pred-form '~(res pred-form)))
 624 | 
 625 | (defmacro alt
 626 |   "Takes key+pred pairs, e.g.
 627 | 
 628 |   (s/alt :even even? :small #(< % 42))
 629 | 
 630 |   Returns a regex op that returns a map entry containing the key of the
 631 |   first matching pred and the corresponding value. Thus the
 632 |   'key' and 'val' functions can be used to refer generically to the
 633 |   components of the tagged return"
 634 |   [& key-pred-forms]
 635 |   (let [pairs (partition 2 key-pred-forms)
 636 |         keys (mapv first pairs)
 637 |         pred-forms (mapv second pairs)
 638 |         pf (mapv res pred-forms)]
 639 |     (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "alt expects k1 p1 k2 p2..., where ks are keywords")
 640 |     `(alt-impl ~keys ~pred-forms '~pf)))
 641 | 
 642 | (defmacro cat
 643 |   "Takes key+pred pairs, e.g.
 644 | 
 645 |   (s/cat :e even? :o odd?)
 646 | 
 647 |   Returns a regex op that matches (all) values in sequence, returning a map
 648 |   containing the keys of each pred and the corresponding value."
 649 |   [& key-pred-forms]
 650 |   (let [pairs (partition 2 key-pred-forms)
 651 |         keys (mapv first pairs)
 652 |         pred-forms (mapv second pairs)
 653 |         pf (mapv res pred-forms)]
 654 |     ;;(prn key-pred-forms)
 655 |     (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "cat expects k1 p1 k2 p2..., where ks are keywords")
 656 |     `(cat-impl ~keys ~pred-forms '~pf)))
 657 | 
 658 | (defmacro &
 659 |   "takes a regex op re, and predicates. Returns a regex-op that consumes
 660 |   input as per re but subjects the resulting value to the
 661 |   conjunction of the predicates, and any conforming they might perform."
 662 |   [re & preds]
 663 |   (let [pv (vec preds)]
 664 |     `(amp-impl ~re '~(res re) ~pv '~(mapv res pv))))
 665 | 
 666 | (defmacro conformer
 667 |   "takes a predicate function with the semantics of conform i.e. it should return either a
 668 |   (possibly converted) value or :clojure.spec.alpha/invalid, and returns a
 669 |   spec that uses it as a predicate/conformer. Optionally takes a
 670 |   second fn that does unform of result of first"
 671 |   ([f] `(spec-impl '(conformer ~(res f)) ~f nil true))
 672 |   ([f unf] `(spec-impl '(conformer ~(res f) ~(res unf)) ~f nil true ~unf)))
 673 | 
 674 | (defmacro fspec
 675 |   "takes :args :ret and (optional) :fn kwargs whose values are preds
 676 |   and returns a spec whose conform/explain take a fn and validates it
 677 |   using generative testing. The conformed value is always the fn itself.
 678 | 
 679 |   See 'fdef' for a single operation that creates an fspec and
 680 |   registers it, as well as a full description of :args, :ret and :fn
 681 | 
 682 |   fspecs can generate functions that validate the arguments and
 683 |   fabricate a return value compliant with the :ret spec, ignoring
 684 |   the :fn spec if present.
 685 | 
 686 |   Optionally takes :gen generator-fn, which must be a fn of no args
 687 |   that returns a test.check generator."
 688 |   
 689 |   [& {:keys [args ret fn gen] :or {ret `any?}}]
 690 |   `(fspec-impl (spec ~args) '~(res args)
 691 |                (spec ~ret) '~(res ret)
 692 |                (spec ~fn) '~(res fn) ~gen))
 693 | 
 694 | (defmacro tuple
 695 |   "takes one or more preds and returns a spec for a tuple, a vector
 696 |   where each element conforms to the corresponding pred. Each element
 697 |   will be referred to in paths using its ordinal."
 698 |   [& preds]
 699 |   (c/assert (not (empty? preds)))
 700 |   `(tuple-impl '~(mapv res preds) ~(vec preds)))
 701 | 
 702 | (defn- macroexpand-check
 703 |   [v args]
 704 |   (let [fn-spec (get-spec v)]
 705 |     (when-let [arg-spec (:args fn-spec)]
 706 |       (when (invalid? (conform arg-spec args))
 707 |         (let [ed (assoc (explain-data* arg-spec []
 708 |                                        (if-let [name (spec-name arg-spec)] [name] []) [] args)
 709 |                    ::args args)]
 710 |           (throw (ex-info
 711 |                    (str "Call to " (->sym v) " did not conform to spec.")
 712 |                    ed)))))))
 713 | 
 714 | (defmacro fdef
 715 |   "Takes a symbol naming a function, and one or more of the following:
 716 | 
 717 |   :args A regex spec for the function arguments as they were a list to be
 718 |     passed to apply - in this way, a single spec can handle functions with
 719 |     multiple arities
 720 |   :ret A spec for the function's return value
 721 |   :fn A spec of the relationship between args and ret - the
 722 |     value passed is {:args conformed-args :ret conformed-ret} and is
 723 |     expected to contain predicates that relate those values
 724 | 
 725 |   Qualifies fn-sym with resolve, or using *ns* if no resolution found.
 726 |   Registers an fspec in the global registry, where it can be retrieved
 727 |   by calling get-spec with the var or fully-qualified symbol.
 728 | 
 729 |   Once registered, function specs are included in doc, checked by
 730 |   instrument, tested by the runner clojure.spec.test.alpha/check, and (if
 731 |   a macro) used to explain errors during macroexpansion.
 732 | 
 733 |   Note that :fn specs require the presence of :args and :ret specs to
 734 |   conform values, and so :fn specs will be ignored if :args or :ret
 735 |   are missing.
 736 | 
 737 |   Returns the qualified fn-sym.
 738 | 
 739 |   For example, to register function specs for the symbol function:
 740 | 
 741 |   (s/fdef clojure.core/symbol
 742 |     :args (s/alt :separate (s/cat :ns string? :n string?)
 743 |                  :str string?
 744 |                  :sym symbol?)
 745 |     :ret symbol?)"
 746 |   [fn-sym & specs]
 747 |   `(clojure.spec.alpha/def ~fn-sym (clojure.spec.alpha/fspec ~@specs)))
 748 | 
 749 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; impl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 750 | (defn- recur-limit? [rmap id path k]
 751 |   (c/and (> (get rmap id) (::recursion-limit rmap))
 752 |          (contains? (set path) k)))
 753 | 
 754 | (defn- inck [m k]
 755 |   (assoc m k (inc (c/or (get m k) 0))))
 756 | 
 757 | (defn- dt
 758 |   ([pred x form] (dt pred x form nil))
 759 |   ([pred x form cpred?]
 760 |      (if pred
 761 |        (if-let [spec (the-spec pred)]
 762 |          (conform spec x)
 763 |          (if (ifn? pred)
 764 |            (if cpred?
 765 |              (pred x)
 766 |              (if (pred x) x ::invalid))
 767 |            (throw (Exception. (str (pr-str form) " is not a fn, expected predicate fn")))))
 768 |        x)))
 769 | 
 770 | (defn valid?
 771 |   "Helper function that returns true when x is valid for spec."
 772 |   ([spec x]
 773 |      (let [spec (specize spec)]
 774 |        (not (invalid? (conform* spec x)))))
 775 |   ([spec x form]
 776 |      (let [spec (specize spec form)]
 777 |        (not (invalid? (conform* spec x))))))
 778 | 
 779 | (defn- pvalid?
 780 |   "internal helper function that returns true when x is valid for spec."
 781 |   ([pred x]
 782 |      (not (invalid? (dt pred x ::unknown))))
 783 |   ([pred x form]
 784 |      (not (invalid? (dt pred x form)))))
 785 | 
 786 | (defn- explain-1 [form pred path via in v]
 787 |   ;;(prn {:form form :pred pred :path path :in in :v v})
 788 |   (let [pred (maybe-spec pred)]
 789 |     (if (spec? pred)
 790 |       (explain* pred path (if-let [name (spec-name pred)] (conj via name) via) in v)
 791 |       [{:path path :pred form :val v :via via :in in}])))
 792 | 
 793 | (declare or-k-gen and-k-gen)
 794 | 
 795 | (defn- k-gen
 796 |   "returns a generator for form f, which can be a keyword or a list
 797 |   starting with 'or or 'and."
 798 |   [f]
 799 |   (cond
 800 |     (keyword? f)       (gen/return f)
 801 |     (= 'or  (first f)) (or-k-gen 1 (rest f))
 802 |     (= 'and (first f)) (and-k-gen (rest f))))
 803 | 
 804 | (defn- or-k-gen
 805 |   "returns a tuple generator made up of generators for a random subset
 806 |   of min-count (default 0) to all elements in s."
 807 |   ([s] (or-k-gen 0 s))
 808 |   ([min-count s]
 809 |    (gen/bind (gen/tuple
 810 |               (gen/choose min-count (count s))
 811 |               (gen/shuffle (map k-gen s)))
 812 |              (fn [[n gens]]
 813 |                (apply gen/tuple (take n gens))))))
 814 | 
 815 | (defn- and-k-gen
 816 |   "returns a tuple generator made up of generators for every element
 817 |   in s."
 818 |   [s]
 819 |   (apply gen/tuple (map k-gen s)))
 820 | 
 821 | 
 822 | (defn ^:skip-wiki map-spec-impl
 823 |   "Do not call this directly, use 'spec' with a map argument"
 824 |   [{:keys [req-un opt-un keys-pred pred-exprs opt-keys req-specs req req-keys opt-specs pred-forms opt gfn]
 825 |     :as argm}]
 826 |   (let [k->s (zipmap (concat req-keys opt-keys) (concat req-specs opt-specs))
 827 |         keys->specnames #(c/or (k->s %) %)
 828 |         id (java.util.UUID/randomUUID)]
 829 |     (reify
 830 |      Specize
 831 |      (specize* [s] s)
 832 |      (specize* [s _] s)
 833 |      
 834 |      Spec
 835 |      (conform* [_ m]
 836 |                (if (keys-pred m)
 837 |                  (let [reg (registry)]
 838 |                    (loop [ret m, [[k v] & ks :as keys] m]
 839 |                      (if keys
 840 |                        (let [sname (keys->specnames k)]
 841 |                          (if-let [s (get reg sname)]
 842 |                            (let [cv (conform s v)]
 843 |                              (if (invalid? cv)
 844 |                                ::invalid
 845 |                                (recur (if (identical? cv v) ret (assoc ret k cv))
 846 |                                       ks)))
 847 |                            (recur ret ks)))
 848 |                        ret)))
 849 |                  ::invalid))
 850 |      (unform* [_ m]
 851 |               (let [reg (registry)]
 852 |                 (loop [ret m, [k & ks :as keys] (c/keys m)]
 853 |                   (if keys
 854 |                     (if (contains? reg (keys->specnames k))
 855 |                       (let [cv (get m k)
 856 |                             v (unform (keys->specnames k) cv)]
 857 |                         (recur (if (identical? cv v) ret (assoc ret k v))
 858 |                                ks))
 859 |                       (recur ret ks))
 860 |                     ret))))
 861 |      (explain* [_ path via in x]
 862 |                (if-not (map? x)
 863 |                  [{:path path :pred `map? :val x :via via :in in}]
 864 |                  (let [reg (registry)]
 865 |                    (apply concat
 866 |                           (when-let [probs (->> (map (fn [pred form] (when-not (pred x) form))
 867 |                                                      pred-exprs pred-forms)
 868 |                                                 (keep identity)
 869 |                                                 seq)]
 870 |                             (map
 871 |                              #(identity {:path path :pred % :val x :via via :in in})
 872 |                              probs))
 873 |                           (map (fn [[k v]]
 874 |                                  (when-not (c/or (not (contains? reg (keys->specnames k)))
 875 |                                                  (pvalid? (keys->specnames k) v k))
 876 |                                    (explain-1 (keys->specnames k) (keys->specnames k) (conj path k) via (conj in k) v)))
 877 |                                (seq x))))))
 878 |       (gen* [_ overrides path rmap]
 879 |         (if gfn
 880 |           (gfn)
 881 |           (let [rmap (inck rmap id)
 882 |                 rgen (fn [k s] [k (gensub s overrides (conj path k) rmap k)])
 883 |                 ogen (fn [k s]
 884 |                        (when-not (recur-limit? rmap id path k)
 885 |                          [k (gen/delay (gensub s overrides (conj path k) rmap k))]))
 886 |                 reqs (map rgen req-keys req-specs)
 887 |                 opts (remove nil? (map ogen opt-keys opt-specs))]
 888 |             (when (every? identity (concat (map second reqs) (map second opts)))
 889 |               (gen/bind
 890 |                (gen/tuple
 891 |                 (and-k-gen req)
 892 |                 (or-k-gen opt)
 893 |                 (and-k-gen req-un)
 894 |                 (or-k-gen opt-un))
 895 |                (fn [[req-ks opt-ks req-un-ks opt-un-ks]]
 896 |                  (let [qks (flatten (concat req-ks opt-ks))
 897 |                        unqks (map (comp keyword name) (flatten (concat req-un-ks opt-un-ks)))]
 898 |                    (->> (into reqs opts)
 899 |                         (filter #((set (concat qks unqks)) (first %)))
 900 |                         (apply concat)
 901 |                         (apply gen/hash-map)))))))))
 902 |      (with-gen* [_ gfn] (map-spec-impl (assoc argm :gfn gfn)))
 903 |      (describe* [_] (cons `keys
 904 |                           (cond-> []
 905 |                                   req (conj :req req)
 906 |                                   opt (conj :opt opt)
 907 |                                   req-un (conj :req-un req-un)
 908 |                                   opt-un (conj :opt-un opt-un)))))))
 909 | 
 910 | 
 911 | 
 912 | 
 913 | (defn ^:skip-wiki spec-impl
 914 |   "Do not call this directly, use 'spec'"
 915 |   ([form pred gfn cpred?] (spec-impl form pred gfn cpred? nil))
 916 |   ([form pred gfn cpred? unc]
 917 |      (cond
 918 |       (spec? pred) (cond-> pred gfn (with-gen gfn))
 919 |       (regex? pred) (regex-spec-impl pred gfn)
 920 |       (ident? pred) (cond-> (the-spec pred) gfn (with-gen gfn))
 921 |       :else
 922 |       (reify
 923 |        Specize
 924 |        (specize* [s] s)
 925 |        (specize* [s _] s)
 926 |        
 927 |        Spec
 928 |        (conform* [_ x] (let [ret (pred x)]
 929 |                          (if cpred?
 930 |                            ret
 931 |                            (if ret x ::invalid))))
 932 |        (unform* [_ x] (if cpred?
 933 |                         (if unc
 934 |                           (unc x)
 935 |                           (throw (IllegalStateException. "no unform fn for conformer")))
 936 |                         x))
 937 |        (explain* [_ path via in x]
 938 |                  (when (invalid? (dt pred x form cpred?))
 939 |                    [{:path path :pred form :val x :via via :in in}]))
 940 |        (gen* [_ _ _ _] (if gfn
 941 |                          (gfn)
 942 |                          (gen/gen-for-pred pred)))
 943 |        (with-gen* [_ gfn] (spec-impl form pred gfn cpred? unc))
 944 |        (describe* [_] form)))))
 945 | 
 946 | (defn ^:skip-wiki multi-spec-impl
 947 |   "Do not call this directly, use 'multi-spec'"
 948 |   ([form mmvar retag] (multi-spec-impl form mmvar retag nil))
 949 |   ([form mmvar retag gfn]
 950 |      (let [id (java.util.UUID/randomUUID)
 951 |            predx #(let [^clojure.lang.MultiFn mm @mmvar]
 952 |                     (c/and (.getMethod mm ((.dispatchFn mm) %))
 953 |                            (mm %)))
 954 |            dval #((.dispatchFn ^clojure.lang.MultiFn @mmvar) %)
 955 |            tag (if (keyword? retag)
 956 |                  #(assoc %1 retag %2)
 957 |                  retag)]
 958 |        (reify
 959 |         Specize
 960 |         (specize* [s] s)
 961 |         (specize* [s _] s)
 962 |         
 963 |         Spec
 964 |         (conform* [_ x] (if-let [pred (predx x)]
 965 |                           (dt pred x form)
 966 |                           ::invalid))
 967 |         (unform* [_ x] (if-let [pred (predx x)]
 968 |                          (unform pred x)
 969 |                          (throw (IllegalStateException. (str "No method of: " form " for dispatch value: " (dval x))))))
 970 |         (explain* [_ path via in x]
 971 |                   (let [dv (dval x)
 972 |                         path (conj path dv)]
 973 |                     (if-let [pred (predx x)]
 974 |                       (explain-1 form pred path via in x)
 975 |                       [{:path path :pred form :val x :reason "no method" :via via :in in}])))
 976 |         (gen* [_ overrides path rmap]
 977 |               (if gfn
 978 |                 (gfn)
 979 |                 (let [gen (fn [[k f]]
 980 |                             (let [p (f nil)]
 981 |                               (let [rmap (inck rmap id)]
 982 |                                 (when-not (recur-limit? rmap id path k)
 983 |                                   (gen/delay
 984 |                                    (gen/fmap
 985 |                                     #(tag % k)
 986 |                                     (gensub p overrides (conj path k) rmap (list 'method form k))))))))
 987 |                       gs (->> (methods @mmvar)
 988 |                               (remove (fn [[k]] (invalid? k)))
 989 |                               (map gen)
 990 |                               (remove nil?))]
 991 |                   (when (every? identity gs)
 992 |                     (gen/one-of gs)))))
 993 |         (with-gen* [_ gfn] (multi-spec-impl form mmvar retag gfn))
 994 |         (describe* [_] `(multi-spec ~form ~retag))))))
 995 | 
 996 | (defn ^:skip-wiki tuple-impl
 997 |   "Do not call this directly, use 'tuple'"
 998 |   ([forms preds] (tuple-impl forms preds nil))
 999 |   ([forms preds gfn]
1000 |      (let [specs (delay (mapv specize preds forms))
1001 |            cnt (count preds)]
1002 |        (reify
1003 |         Specize
1004 |         (specize* [s] s)
1005 |         (specize* [s _] s)
1006 |         
1007 |         Spec
1008 |         (conform* [_ x]
1009 |                   (let [specs @specs]
1010 |                     (if-not (c/and (vector? x)
1011 |                                    (= (count x) cnt))
1012 |                       ::invalid
1013 |                       (loop [ret x, i 0]
1014 |                         (if (= i cnt)
1015 |                           ret
1016 |                           (let [v (x i)
1017 |                                 cv (conform* (specs i) v)]
1018 |                             (if (invalid? cv)
1019 |                               ::invalid
1020 |                               (recur (if (identical? cv v) ret (assoc ret i cv))
1021 |                                      (inc i)))))))))
1022 |         (unform* [_ x]
1023 |                  (c/assert (c/and (vector? x)
1024 |                                   (= (count x) (count preds))))
1025 |                  (loop [ret x, i 0]
1026 |                    (if (= i (count x))
1027 |                      ret
1028 |                      (let [cv (x i)
1029 |                            v (unform (preds i) cv)]
1030 |                        (recur (if (identical? cv v) ret (assoc ret i v))
1031 |                               (inc i))))))
1032 |         (explain* [_ path via in x]
1033 |                   (cond
1034 |                    (not (vector? x))
1035 |                    [{:path path :pred `vector? :val x :via via :in in}]
1036 | 
1037 |                    (not= (count x) (count preds))
1038 |                    [{:path path :pred `(= (count ~'%) ~(count preds)) :val x :via via :in in}]
1039 | 
1040 |                    :else
1041 |                    (apply concat
1042 |                           (map (fn [i form pred]
1043 |                                  (let [v (x i)]
1044 |                                    (when-not (pvalid? pred v)
1045 |                                      (explain-1 form pred (conj path i) via (conj in i) v))))
1046 |                                (range (count preds)) forms preds))))
1047 |         (gen* [_ overrides path rmap]
1048 |               (if gfn
1049 |                 (gfn)
1050 |                 (let [gen (fn [i p f]
1051 |                             (gensub p overrides (conj path i) rmap f))
1052 |                       gs (map gen (range (count preds)) preds forms)]
1053 |                   (when (every? identity gs)
1054 |                     (apply gen/tuple gs)))))
1055 |         (with-gen* [_ gfn] (tuple-impl forms preds gfn))
1056 |         (describe* [_] `(tuple ~@forms))))))
1057 | 
1058 | (defn- tagged-ret [tag ret]
1059 |   (clojure.lang.MapEntry. tag ret))
1060 | 
1061 | (defn ^:skip-wiki or-spec-impl
1062 |   "Do not call this directly, use 'or'"
1063 |   [keys forms preds gfn]
1064 |   (let [id (java.util.UUID/randomUUID)
1065 |         kps (zipmap keys preds)
1066 |         specs (delay (mapv specize preds forms))
1067 |         cform (case (count preds)
1068 |                     2 (fn [x]
1069 |                         (let [specs @specs
1070 |                               ret (conform* (specs 0) x)]
1071 |                           (if (invalid? ret)
1072 |                             (let [ret (conform* (specs 1) x)]
1073 |                               (if (invalid? ret)
1074 |                                 ::invalid
1075 |                                 (tagged-ret (keys 1) ret)))
1076 |                             (tagged-ret (keys 0) ret))))
1077 |                     3 (fn [x]
1078 |                         (let [specs @specs
1079 |                               ret (conform* (specs 0) x)]
1080 |                           (if (invalid? ret)
1081 |                             (let [ret (conform* (specs 1) x)]
1082 |                               (if (invalid? ret)
1083 |                                 (let [ret (conform* (specs 2) x)]
1084 |                                   (if (invalid? ret)
1085 |                                     ::invalid
1086 |                                     (tagged-ret (keys 2) ret)))
1087 |                                 (tagged-ret (keys 1) ret)))
1088 |                             (tagged-ret (keys 0) ret))))
1089 |                     (fn [x]
1090 |                       (let [specs @specs]
1091 |                         (loop [i 0]
1092 |                           (if (< i (count specs))
1093 |                             (let [spec (specs i)]
1094 |                               (let [ret (conform* spec x)]
1095 |                                 (if (invalid? ret)
1096 |                                   (recur (inc i))
1097 |                                   (tagged-ret (keys i) ret))))
1098 |                             ::invalid)))))]
1099 |     (reify
1100 |      Specize
1101 |      (specize* [s] s)
1102 |      (specize* [s _] s)
1103 |        
1104 |      Spec
1105 |      (conform* [_ x] (cform x))
1106 |      (unform* [_ [k x]] (unform (kps k) x))
1107 |      (explain* [this path via in x]
1108 |                (when-not (pvalid? this x)
1109 |                  (apply concat
1110 |                         (map (fn [k form pred]
1111 |                                (when-not (pvalid? pred x)
1112 |                                  (explain-1 form pred (conj path k) via in x)))
1113 |                              keys forms preds))))
1114 |      (gen* [_ overrides path rmap]
1115 |            (if gfn
1116 |              (gfn)
1117 |              (let [gen (fn [k p f]
1118 |                          (let [rmap (inck rmap id)]
1119 |                            (when-not (recur-limit? rmap id path k)
1120 |                              (gen/delay
1121 |                               (gensub p overrides (conj path k) rmap f)))))
1122 |                    gs (remove nil? (map gen keys preds forms))]
1123 |                (when-not (empty? gs)
1124 |                  (gen/one-of gs)))))
1125 |      (with-gen* [_ gfn] (or-spec-impl keys forms preds gfn))
1126 |      (describe* [_] `(or ~@(mapcat vector keys forms))))))
1127 | 
1128 | (defn- and-preds [x preds forms]
1129 |   (loop [ret x
1130 |          [pred & preds] preds
1131 |          [form & forms] forms]
1132 |     (if pred
1133 |       (let [nret (dt pred ret form)]
1134 |         (if (invalid? nret)
1135 |           ::invalid
1136 |           ;;propagate conformed values
1137 |           (recur nret preds forms)))
1138 |       ret)))
1139 | 
1140 | (defn- explain-pred-list
1141 |   [forms preds path via in x]
1142 |   (loop [ret x
1143 |          [form & forms] forms
1144 |          [pred & preds] preds]
1145 |     (when pred
1146 |       (let [nret (dt pred ret form)]
1147 |         (if (invalid? nret)
1148 |           (explain-1 form pred path via in ret)
1149 |           (recur nret forms preds))))))
1150 | 
1151 | (defn ^:skip-wiki and-spec-impl
1152 |   "Do not call this directly, use 'and'"
1153 |   [forms preds gfn]
1154 |   (let [specs (delay (mapv specize preds forms))
1155 |         cform
1156 |         (case (count preds)
1157 |               2 (fn [x]
1158 |                   (let [specs @specs
1159 |                         ret (conform* (specs 0) x)]
1160 |                     (if (invalid? ret)
1161 |                       ::invalid
1162 |                       (conform* (specs 1) ret))))
1163 |               3 (fn [x]
1164 |                   (let [specs @specs
1165 |                         ret (conform* (specs 0) x)]
1166 |                     (if (invalid? ret)
1167 |                       ::invalid
1168 |                       (let [ret (conform* (specs 1) ret)]
1169 |                         (if (invalid? ret)
1170 |                           ::invalid
1171 |                           (conform* (specs 2) ret))))))
1172 |               (fn [x]
1173 |                 (let [specs @specs]
1174 |                   (loop [ret x i 0]
1175 |                     (if (< i (count specs))
1176 |                       (let [nret (conform* (specs i) ret)]
1177 |                         (if (invalid? nret)
1178 |                           ::invalid
1179 |                           ;;propagate conformed values
1180 |                           (recur nret (inc i))))
1181 |                       ret)))))]
1182 |     (reify
1183 |      Specize
1184 |      (specize* [s] s)
1185 |      (specize* [s _] s)
1186 |      
1187 |      Spec
1188 |      (conform* [_ x] (cform x))
1189 |      (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds)))
1190 |      (explain* [_ path via in x] (explain-pred-list forms preds path via in x))
1191 |      (gen* [_ overrides path rmap] (if gfn (gfn) (gensub (first preds) overrides path rmap (first forms))))
1192 |      (with-gen* [_ gfn] (and-spec-impl forms preds gfn))
1193 |      (describe* [_] `(and ~@forms)))))
1194 | 
1195 | (defn ^:skip-wiki merge-spec-impl
1196 |   "Do not call this directly, use 'merge'"
1197 |   [forms preds gfn]
1198 |   (reify
1199 |    Specize
1200 |    (specize* [s] s)
1201 |    (specize* [s _] s)
1202 |    
1203 |    Spec
1204 |    (conform* [_ x] (let [ms (map #(dt %1 x %2) preds forms)]
1205 |                      (if (some invalid? ms)
1206 |                        ::invalid
1207 |                        (apply c/merge ms))))
1208 |    (unform* [_ x] (apply c/merge (map #(unform % x) (reverse preds))))
1209 |    (explain* [_ path via in x]
1210 |              (apply concat
1211 |                     (map #(explain-1 %1 %2 path via in x)
1212 |                          forms preds)))
1213 |    (gen* [_ overrides path rmap]
1214 |          (if gfn
1215 |            (gfn)
1216 |            (gen/fmap
1217 |             #(apply c/merge %)
1218 |             (apply gen/tuple (map #(gensub %1 overrides path rmap %2)
1219 |                                   preds forms)))))
1220 |    (with-gen* [_ gfn] (merge-spec-impl forms preds gfn))
1221 |    (describe* [_] `(merge ~@forms))))
1222 | 
1223 | (defn- coll-prob [x kfn kform distinct count min-count max-count
1224 |                   path via in]
1225 |   (let [pred (c/or kfn coll?)
1226 |         kform (c/or kform `coll?)]
1227 |     (cond
1228 |      (not (pvalid? pred x))
1229 |      (explain-1 kform pred path via in x)
1230 | 
1231 |      (c/and count (not= count (bounded-count count x)))
1232 |      [{:path path :pred `(= ~count (c/count ~'%)) :val x :via via :in in}]
1233 | 
1234 |      (c/and (c/or min-count max-count)
1235 |             (not (<= (c/or min-count 0)
1236 |                      (bounded-count (if max-count (inc max-count) min-count) x)
1237 |                      (c/or max-count Integer/MAX_VALUE))))
1238 |      [{:path path :pred `(<= ~(c/or min-count 0) (c/count ~'%) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}]
1239 |      
1240 |      (c/and distinct (not (empty? x)) (not (apply distinct? x)))
1241 |      [{:path path :pred 'distinct? :val x :via via :in in}])))
1242 | 
1243 | (def ^:private empty-coll {`vector? [], `set? #{}, `list? (), `map? {}})
1244 | 
1245 | (defn ^:skip-wiki every-impl
1246 |   "Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'"
1247 |   ([form pred opts] (every-impl form pred opts nil))
1248 |   ([form pred {conform-into :into
1249 |                describe-form ::describe
1250 |                :keys [kind ::kind-form count max-count min-count distinct gen-max ::kfn ::cpred
1251 |                       conform-keys ::conform-all]
1252 |                :or {gen-max 20}
1253 |                :as opts}
1254 |     gfn]
1255 |      (let [gen-into (if conform-into (empty conform-into) (get empty-coll kind-form))
1256 |            spec (delay (specize pred))
1257 |            check? #(valid? @spec %)
1258 |            kfn (c/or kfn (fn [i v] i))
1259 |            addcv (fn [ret i v cv] (conj ret cv))
1260 |            cfns (fn [x]
1261 |                   ;;returns a tuple of [init add complete] fns
1262 |                   (cond
1263 |                    (c/and (vector? x) (c/or (not conform-into) (vector? conform-into)))
1264 |                    [identity
1265 |                     (fn [ret i v cv]
1266 |                       (if (identical? v cv)
1267 |                         ret
1268 |                         (assoc ret i cv)))
1269 |                     identity]
1270 | 
1271 |                    (c/and (map? x) (c/or (c/and kind (not conform-into)) (map? conform-into)))
1272 |                    [(if conform-keys empty identity)
1273 |                     (fn [ret i v cv]
1274 |                       (if (c/and (identical? v cv) (not conform-keys))
1275 |                         ret
1276 |                         (assoc ret (nth (if conform-keys cv v) 0) (nth cv 1))))
1277 |                     identity]
1278 | 
1279 |                    (c/or (list? conform-into) (seq? conform-into) (c/and (not conform-into) (c/or (list? x) (seq? x))))
1280 |                    [(constantly ()) addcv reverse]
1281 | 
1282 |                    :else [#(empty (c/or conform-into %)) addcv identity]))]
1283 |        (reify
1284 |         Specize
1285 |         (specize* [s] s)
1286 |         (specize* [s _] s)
1287 |         
1288 |         Spec
1289 |         (conform* [_ x]
1290 |                   (let [spec @spec]
1291 |                     (cond
1292 |                      (not (cpred x)) ::invalid
1293 | 
1294 |                      conform-all
1295 |                      (let [[init add complete] (cfns x)]
1296 |                        (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)]
1297 |                          (if vseq
1298 |                            (let [cv (conform* spec v)]
1299 |                              (if (invalid? cv)
1300 |                                ::invalid
1301 |                                (recur (add ret i v cv) (inc i) vs)))
1302 |                            (complete ret))))
1303 |                      
1304 |                      
1305 |                      :else
1306 |                      (if (indexed? x)
1307 |                        (let [step (max 1 (long (/ (c/count x) *coll-check-limit*)))]
1308 |                          (loop [i 0]
1309 |                            (if (>= i (c/count x))
1310 |                              x
1311 |                              (if (valid? spec (nth x i))
1312 |                                (recur (c/+ i step))
1313 |                                ::invalid))))
1314 |                        (let [limit *coll-check-limit*]
1315 |                          (loop [i 0 [v & vs :as vseq] (seq x)]
1316 |                            (cond
1317 |                             (c/or (nil? vseq) (= i limit)) x
1318 |                             (valid? spec v) (recur (inc i) vs)
1319 |                             :else ::invalid)))))))
1320 |         (unform* [_ x]
1321 |                  (if conform-all
1322 |                    (let [spec @spec
1323 |                          [init add complete] (cfns x)]
1324 |                      (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)]
1325 |                        (if (>= i (c/count x))
1326 |                          (complete ret)
1327 |                          (recur (add ret i v (unform* spec v)) (inc i) vs))))
1328 |                    x))
1329 |         (explain* [_ path via in x]
1330 |                   (c/or (coll-prob x kind kind-form distinct count min-count max-count
1331 |                                    path via in)
1332 |                         (apply concat
1333 |                                ((if conform-all identity (partial take *coll-error-limit*))
1334 |                                 (keep identity
1335 |                                       (map (fn [i v]
1336 |                                              (let [k (kfn i v)]
1337 |                                                (when-not (check? v)
1338 |                                                  (let [prob (explain-1 form pred path via (conj in k) v)]
1339 |                                                    prob))))
1340 |                                            (range) x))))))
1341 |         (gen* [_ overrides path rmap]
1342 |               (if gfn
1343 |                 (gfn)
1344 |                 (let [pgen (gensub pred overrides path rmap form)]
1345 |                   (gen/bind
1346 |                    (cond
1347 |                     gen-into (gen/return gen-into)
1348 |                     kind (gen/fmap #(if (empty? %) % (empty %))
1349 |                                    (gensub kind overrides path rmap form))
1350 |                     :else (gen/return []))
1351 |                    (fn [init]
1352 |                      (gen/fmap
1353 |                       #(if (vector? init) % (into init %))
1354 |                       (cond
1355 |                        distinct
1356 |                        (if count
1357 |                          (gen/vector-distinct pgen {:num-elements count :max-tries 100})
1358 |                          (gen/vector-distinct pgen {:min-elements (c/or min-count 0)
1359 |                                                     :max-elements (c/or max-count (max gen-max (c/* 2 (c/or min-count 0))))
1360 |                                                     :max-tries 100}))
1361 | 
1362 |                        count
1363 |                        (gen/vector pgen count)
1364 | 
1365 |                        (c/or min-count max-count)
1366 |                        (gen/vector pgen (c/or min-count 0) (c/or max-count (max gen-max (c/* 2 (c/or min-count 0)))))
1367 | 
1368 |                        :else
1369 |                        (gen/vector pgen 0 gen-max))))))))
1370 |         
1371 |         (with-gen* [_ gfn] (every-impl form pred opts gfn))
1372 |         (describe* [_] (c/or describe-form `(every ~(res form) ~@(mapcat identity opts))))))))
1373 | 
1374 | ;;;;;;;;;;;;;;;;;;;;;;; regex ;;;;;;;;;;;;;;;;;;;
1375 | ;;See:
1376 | ;; http://matt.might.net/articles/implementation-of-regular-expression-matching-in-scheme-with-derivatives/
1377 | ;; http://www.ccs.neu.edu/home/turon/re-deriv.pdf
1378 | 
1379 | ;;ctors
1380 | (defn- accept [x] {::op ::accept :ret x})
1381 | 
1382 | (defn- accept? [{:keys [::op]}]
1383 |   (= ::accept op))
1384 | 
1385 | (defn- pcat* [{[p1 & pr :as ps] :ps,  [k1 & kr :as ks] :ks, [f1 & fr :as forms] :forms, ret :ret, rep+ :rep+}]
1386 |   (when (every? identity ps)
1387 |     (if (accept? p1)
1388 |       (let [rp (:ret p1)
1389 |             ret (conj ret (if ks {k1 rp} rp))]
1390 |         (if pr
1391 |           (pcat* {:ps pr :ks kr :forms fr :ret ret})
1392 |           (accept ret)))
1393 |       {::op ::pcat, :ps ps, :ret ret, :ks ks, :forms forms :rep+ rep+})))
1394 | 
1395 | (defn- pcat [& ps] (pcat* {:ps ps :ret []}))
1396 | 
1397 | (defn ^:skip-wiki cat-impl
1398 |   "Do not call this directly, use 'cat'"
1399 |   [ks ps forms]
1400 |   (pcat* {:ks ks, :ps ps, :forms forms, :ret {}}))
1401 | 
1402 | (defn- rep* [p1 p2 ret splice form]
1403 |   (when p1
1404 |     (let [r {::op ::rep, :p2 p2, :splice splice, :forms form :id (java.util.UUID/randomUUID)}]
1405 |       (if (accept? p1)
1406 |         (assoc r :p1 p2 :ret (conj ret (:ret p1)))
1407 |         (assoc r :p1 p1, :ret ret)))))
1408 | 
1409 | (defn ^:skip-wiki rep-impl
1410 |   "Do not call this directly, use '*'"
1411 |   [form p] (rep* p p [] false form))
1412 | 
1413 | (defn ^:skip-wiki rep+impl
1414 |   "Do not call this directly, use '+'"
1415 |   [form p]
1416 |   (pcat* {:ps [p (rep* p p [] true form)] :forms `[~form (* ~form)] :ret [] :rep+ form}))
1417 | 
1418 | (defn ^:skip-wiki amp-impl
1419 |   "Do not call this directly, use '&'"
1420 |   [re re-form preds pred-forms]
1421 |   {::op ::amp :p1 re :amp re-form :ps preds :forms pred-forms})
1422 | 
1423 | (defn- filter-alt [ps ks forms f]
1424 |   (if (c/or ks forms)
1425 |     (let [pks (->> (map vector ps
1426 |                         (c/or (seq ks) (repeat nil))
1427 |                         (c/or (seq forms) (repeat nil)))
1428 |                    (filter #(-> % first f)))]
1429 |       [(seq (map first pks)) (when ks (seq (map second pks))) (when forms (seq (map #(nth % 2) pks)))])
1430 |     [(seq (filter f ps)) ks forms]))
1431 | 
1432 | (defn- alt* [ps ks forms]
1433 |   (let [[[p1 & pr :as ps] [k1 :as ks] forms] (filter-alt ps ks forms identity)]
1434 |     (when ps
1435 |       (let [ret {::op ::alt, :ps ps, :ks ks :forms forms}]
1436 |         (if (nil? pr) 
1437 |           (if k1
1438 |             (if (accept? p1)
1439 |               (accept (tagged-ret k1 (:ret p1)))
1440 |               ret)
1441 |             p1)
1442 |           ret)))))
1443 | 
1444 | (defn- alts [& ps] (alt* ps nil nil))
1445 | (defn- alt2 [p1 p2] (if (c/and p1 p2) (alts p1 p2) (c/or p1 p2)))
1446 | 
1447 | (defn ^:skip-wiki alt-impl
1448 |   "Do not call this directly, use 'alt'"
1449 |   [ks ps forms] (assoc (alt* ps ks forms) :id (java.util.UUID/randomUUID)))
1450 | 
1451 | (defn ^:skip-wiki maybe-impl
1452 |   "Do not call this directly, use '?'"
1453 |   [p form] (assoc (alt* [p (accept ::nil)] nil [form ::nil]) :maybe form))
1454 | 
1455 | (defn- noret? [p1 pret]
1456 |   (c/or (= pret ::nil)
1457 |         (c/and (#{::rep ::pcat} (::op (reg-resolve! p1))) ;;hrm, shouldn't know these
1458 |                (empty? pret))
1459 |         nil))
1460 | 
1461 | (declare preturn)
1462 | 
1463 | (defn- accept-nil? [p]
1464 |   (let [{:keys [::op ps p1 p2 forms] :as p} (reg-resolve! p)]
1465 |     (case op
1466 |           ::accept true
1467 |           nil nil
1468 |           ::amp (c/and (accept-nil? p1)
1469 |                        (let [ret (-> (preturn p1) (and-preds ps (next forms)))]
1470 |                          (not (invalid? ret))))
1471 |           ::rep (c/or (identical? p1 p2) (accept-nil? p1))
1472 |           ::pcat (every? accept-nil? ps)
1473 |           ::alt (c/some accept-nil? ps))))
1474 | 
1475 | (declare add-ret)
1476 | 
1477 | (defn- preturn [p]
1478 |   (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms] :as p} (reg-resolve! p)]
1479 |     (case op
1480 |           ::accept ret
1481 |           nil nil
1482 |           ::amp (let [pret (preturn p1)]
1483 |                   (if (noret? p1 pret)
1484 |                     ::nil
1485 |                     (and-preds pret ps forms)))
1486 |           ::rep (add-ret p1 ret k)
1487 |           ::pcat (add-ret p0 ret k)
1488 |           ::alt (let [[[p0] [k0]] (filter-alt ps ks forms accept-nil?)
1489 |                       r (if (nil? p0) ::nil (preturn p0))]
1490 |                   (if k0 (tagged-ret k0 r) r)))))
1491 | 
1492 | (defn- op-unform [p x]
1493 |   ;;(prn {:p p :x x})
1494 |   (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms rep+ maybe] :as p} (reg-resolve! p)
1495 |         kps (zipmap ks ps)]
1496 |     (case op
1497 |           ::accept [ret]
1498 |           nil [(unform p x)]
1499 |           ::amp (let [px (reduce #(unform %2 %1) x (reverse ps))]
1500 |                   (op-unform p1 px))
1501 |           ::rep (mapcat #(op-unform p1 %) x)
1502 |           ::pcat (if rep+
1503 |                    (mapcat #(op-unform p0 %) x)
1504 |                    (mapcat (fn [k]
1505 |                              (when (contains? x k)
1506 |                                (op-unform (kps k) (get x k))))
1507 |                            ks))
1508 |           ::alt (if maybe
1509 |                   [(unform p0 x)]
1510 |                   (let [[k v] x]
1511 |                     (op-unform (kps k) v))))))
1512 | 
1513 | (defn- add-ret [p r k]
1514 |   (let [{:keys [::op ps splice] :as p} (reg-resolve! p)
1515 |         prop #(let [ret (preturn p)]
1516 |                 (if (empty? ret) r ((if splice into conj) r (if k {k ret} ret))))]
1517 |     (case op
1518 |           nil r
1519 |           (::alt ::accept ::amp)
1520 |           (let [ret (preturn p)]
1521 |             ;;(prn {:ret ret})
1522 |             (if (= ret ::nil) r (conj r (if k {k ret} ret))))
1523 | 
1524 |           (::rep ::pcat) (prop))))
1525 | 
1526 | (defn- deriv
1527 |   [p x]
1528 |   (let [{[p0 & pr :as ps] :ps, [k0 & kr :as ks] :ks, :keys [::op p1 p2 ret splice forms amp] :as p} (reg-resolve! p)]
1529 |     (when p
1530 |       (case op
1531 |             ::accept nil
1532 |             nil (let [ret (dt p x p)]
1533 |                   (when-not (invalid? ret) (accept ret)))
1534 |             ::amp (when-let [p1 (deriv p1 x)]
1535 |                     (if (= ::accept (::op p1))
1536 |                       (let [ret (-> (preturn p1) (and-preds ps (next forms)))]
1537 |                         (when-not (invalid? ret)
1538 |                           (accept ret)))
1539 |                       (amp-impl p1 amp ps forms)))
1540 |             ::pcat (alt2 (pcat* {:ps (cons (deriv p0 x) pr), :ks ks, :forms forms, :ret ret})
1541 |                          (when (accept-nil? p0) (deriv (pcat* {:ps pr, :ks kr, :forms (next forms), :ret (add-ret p0 ret k0)}) x)))
1542 |             ::alt (alt* (map #(deriv % x) ps) ks forms)
1543 |             ::rep (alt2 (rep* (deriv p1 x) p2 ret splice forms)
1544 |                         (when (accept-nil? p1) (deriv (rep* p2 p2 (add-ret p1 ret nil) splice forms) x)))))))
1545 | 
1546 | (defn- op-describe [p]  
1547 |   (let [{:keys [::op ps ks forms splice p1 rep+ maybe amp] :as p} (reg-resolve! p)]
1548 |     ;;(prn {:op op :ks ks :forms forms :p p})
1549 |     (when p
1550 |       (case op
1551 |             ::accept nil
1552 |             nil p
1553 |             ::amp (list* 'clojure.spec.alpha/& amp forms)
1554 |             ::pcat (if rep+
1555 |                      (list `+ rep+)
1556 |                      (cons `cat (mapcat vector (c/or (seq ks) (repeat :_)) forms)))
1557 |             ::alt (if maybe
1558 |                     (list `? maybe)
1559 |                     (cons `alt (mapcat vector ks forms)))
1560 |             ::rep (list (if splice `+ `*) forms)))))
1561 | 
1562 | (defn- op-explain [form p path via in input]
1563 |   ;;(prn {:form form :p p :path path :input input})
1564 |   (let [[x :as input] input
1565 |         {:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve! p)
1566 |         via (if-let [name (spec-name p)] (conj via name) via)
1567 |         insufficient (fn [path form]
1568 |                        [{:path path
1569 |                          :reason "Insufficient input"
1570 |                          :pred form
1571 |                          :val ()
1572 |                          :via via
1573 |                          :in in}])]
1574 |     (when p
1575 |       (case op
1576 |             ::accept nil
1577 |             nil (if (empty? input)
1578 |                   (insufficient path form)
1579 |                   (explain-1 form p path via in x))
1580 |             ::amp (if (empty? input)
1581 |                     (if (accept-nil? p1)
1582 |                       (explain-pred-list forms ps path via in (preturn p1))
1583 |                       (insufficient path (:amp p)))
1584 |                     (if-let [p1 (deriv p1 x)]
1585 |                       (explain-pred-list forms ps path via in (preturn p1))
1586 |                       (op-explain (:amp p) p1 path via in input)))
1587 |             ::pcat (let [pkfs (map vector
1588 |                                    ps
1589 |                                    (c/or (seq ks) (repeat nil))
1590 |                                    (c/or (seq forms) (repeat nil)))
1591 |                          [pred k form] (if (= 1 (count pkfs))
1592 |                                          (first pkfs)
1593 |                                          (first (remove (fn [[p]] (accept-nil? p)) pkfs)))
1594 |                          path (if k (conj path k) path)
1595 |                          form (c/or form (op-describe pred))]
1596 |                      (if (c/and (empty? input) (not pred))
1597 |                        (insufficient path form)
1598 |                        (op-explain form pred path via in input)))
1599 |             ::alt (if (empty? input)
1600 |                     (insufficient path (op-describe p))
1601 |                     (apply concat
1602 |                            (map (fn [k form pred]
1603 |                                   (op-explain (c/or form (op-describe pred))
1604 |                                               pred
1605 |                                               (if k (conj path k) path)
1606 |                                               via
1607 |                                               in
1608 |                                               input))
1609 |                                 (c/or (seq ks) (repeat nil))
1610 |                                 (c/or (seq forms) (repeat nil))
1611 |                                 ps)))
1612 |             ::rep (op-explain (if (identical? p1 p2)
1613 |                                 forms
1614 |                                 (op-describe p1))
1615 |                               p1 path via in input)))))
1616 | 
1617 | (defn- re-gen [p overrides path rmap f]
1618 |   ;;(prn {:op op :ks ks :forms forms})
1619 |   (let [origp p
1620 |         {:keys [::op ps ks p1 p2 forms splice ret id ::gfn] :as p} (reg-resolve! p)
1621 |         rmap (if id (inck rmap id) rmap)
1622 |         ggens (fn [ps ks forms]
1623 |                 (let [gen (fn [p k f]
1624 |                             ;;(prn {:k k :path path :rmap rmap :op op :id id})
1625 |                             (when-not (c/and rmap id k (recur-limit? rmap id path k))
1626 |                               (if id
1627 |                                 (gen/delay (re-gen p overrides (if k (conj path k) path) rmap (c/or f p)))
1628 |                                 (re-gen p overrides (if k (conj path k) path) rmap (c/or f p)))))]
1629 |                   (map gen ps (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil)))))]
1630 |     (c/or (when-let [gfn (c/or (get overrides (spec-name origp))
1631 |                                (get overrides (spec-name p) )
1632 |                                (get overrides path))]
1633 |             (case op
1634 |                   (:accept nil) (gen/fmap vector (gfn))
1635 |                   (gfn)))
1636 |           (when gfn
1637 |             (gfn))
1638 |           (when p
1639 |             (case op
1640 |                   ::accept (if (= ret ::nil)
1641 |                              (gen/return [])
1642 |                              (gen/return [ret]))
1643 |                   nil (when-let [g (gensub p overrides path rmap f)]
1644 |                         (gen/fmap vector g))
1645 |                   ::amp (re-gen p1 overrides path rmap (op-describe p1))
1646 |                   ::pcat (let [gens (ggens ps ks forms)]
1647 |                            (when (every? identity gens)
1648 |                              (apply gen/cat gens)))
1649 |                   ::alt (let [gens (remove nil? (ggens ps ks forms))]
1650 |                           (when-not (empty? gens)
1651 |                             (gen/one-of gens)))
1652 |                   ::rep (if (recur-limit? rmap id [id] id)
1653 |                           (gen/return [])
1654 |                           (when-let [g (re-gen p2 overrides path rmap forms)]
1655 |                             (gen/fmap #(apply concat %)
1656 |                                       (gen/vector g)))))))))
1657 | 
1658 | (defn- re-conform [p [x & xs :as data]]
1659 |   ;;(prn {:p p :x x :xs xs})
1660 |   (if (empty? data)
1661 |     (if (accept-nil? p)
1662 |       (let [ret (preturn p)]
1663 |         (if (= ret ::nil)
1664 |           nil
1665 |           ret))
1666 |       ::invalid)
1667 |     (if-let [dp (deriv p x)]
1668 |       (recur dp xs)
1669 |       ::invalid)))
1670 | 
1671 | (defn- re-explain [path via in re input]
1672 |   (loop [p re [x & xs :as data] input i 0]
1673 |     ;;(prn {:p p :x x :xs xs :re re}) (prn)
1674 |     (if (empty? data)
1675 |       (if (accept-nil? p)
1676 |         nil ;;success
1677 |         (op-explain (op-describe p) p path via in nil))
1678 |       (if-let [dp (deriv p x)]
1679 |         (recur dp xs (inc i))
1680 |         (if (accept? p)
1681 |           (if (= (::op p) ::pcat)
1682 |             (op-explain (op-describe p) p path via (conj in i) (seq data))
1683 |             [{:path path
1684 |               :reason "Extra input"
1685 |               :pred (op-describe re)
1686 |               :val data
1687 |               :via via
1688 |               :in (conj in i)}])
1689 |           (c/or (op-explain (op-describe p) p path via (conj in i) (seq data))
1690 |                 [{:path path
1691 |                   :reason "Extra input"
1692 |                   :pred (op-describe p)
1693 |                   :val data
1694 |                   :via via
1695 |                   :in (conj in i)}]))))))
1696 | 
1697 | (defn ^:skip-wiki regex-spec-impl
1698 |   "Do not call this directly, use 'spec' with a regex op argument"
1699 |   [re gfn]
1700 |   (reify
1701 |    Specize
1702 |    (specize* [s] s)
1703 |    (specize* [s _] s)
1704 |    
1705 |    Spec
1706 |    (conform* [_ x]
1707 |              (if (c/or (nil? x) (sequential? x))
1708 |                (re-conform re (seq x))
1709 |                ::invalid))
1710 |    (unform* [_ x] (op-unform re x))
1711 |    (explain* [_ path via in x]
1712 |              (if (c/or (nil? x) (sequential? x))
1713 |                (re-explain path via in re (seq x))
1714 |                [{:path path :pred (res `#(c/or (nil? %) (sequential? %))) :val x :via via :in in}]))
1715 |    (gen* [_ overrides path rmap]
1716 |          (if gfn
1717 |            (gfn)
1718 |            (re-gen re overrides path rmap (op-describe re))))
1719 |    (with-gen* [_ gfn] (regex-spec-impl re gfn))
1720 |    (describe* [_] (op-describe re))))
1721 | 
1722 | ;;;;;;;;;;;;;;;;; HOFs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1723 | 
1724 | (defn- call-valid?
1725 |   [f specs args]
1726 |   (let [cargs (conform (:args specs) args)]
1727 |     (when-not (invalid? cargs)
1728 |       (let [ret (apply f args)
1729 |             cret (conform (:ret specs) ret)]
1730 |         (c/and (not (invalid? cret)) 
1731 |                (if (:fn specs)
1732 |                  (pvalid? (:fn specs) {:args cargs :ret cret})
1733 |                  true))))))
1734 | 
1735 | (defn- validate-fn
1736 |   "returns f if valid, else smallest"
1737 |   [f specs iters]
1738 |   (let [g (gen (:args specs))
1739 |         prop (gen/for-all* [g] #(call-valid? f specs %))]
1740 |     (let [ret (gen/quick-check iters prop)]
1741 |       (if-let [[smallest] (-> ret :shrunk :smallest)]
1742 |         smallest
1743 |         f))))
1744 | 
1745 | (defn ^:skip-wiki fspec-impl
1746 |   "Do not call this directly, use 'fspec'"
1747 |   [argspec aform retspec rform fnspec fform gfn]
1748 |   (let [specs {:args argspec :ret retspec :fn fnspec}]
1749 |     (reify
1750 |      clojure.lang.ILookup
1751 |      (valAt [this k] (get specs k))
1752 |      (valAt [_ k not-found] (get specs k not-found))
1753 | 
1754 |      Specize
1755 |      (specize* [s] s)
1756 |      (specize* [s _] s)
1757 |        
1758 |      Spec
1759 |      (conform* [this f] (if argspec
1760 |                           (if (ifn? f)
1761 |                             (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid)
1762 |                             ::invalid)
1763 |                           (throw (Exception. (str "Can't conform fspec without args spec: " (pr-str (describe this)))))))
1764 |      (unform* [_ f] f)
1765 |      (explain* [_ path via in f]
1766 |                (if (ifn? f)
1767 |                  (let [args (validate-fn f specs 100)]
1768 |                    (if (identical? f args) ;;hrm, we might not be able to reproduce
1769 |                      nil
1770 |                      (let [ret (try (apply f args) (catch Throwable t t))]
1771 |                        (if (instance? Throwable ret)
1772 |                          ;;TODO add exception data
1773 |                          [{:path path :pred '(apply fn) :val args :reason (.getMessage ^Throwable ret) :via via :in in}]
1774 | 
1775 |                          (let [cret (dt retspec ret rform)]
1776 |                            (if (invalid? cret)
1777 |                              (explain-1 rform retspec (conj path :ret) via in ret)
1778 |                              (when fnspec
1779 |                                (let [cargs (conform argspec args)]
1780 |                                  (explain-1 fform fnspec (conj path :fn) via in {:args cargs :ret cret})))))))))
1781 |                  [{:path path :pred 'ifn? :val f :via via :in in}]))
1782 |      (gen* [_ overrides _ _] (if gfn
1783 |              (gfn)
1784 |              (gen/return
1785 |               (fn [& args]
1786 |                 (c/assert (pvalid? argspec args) (with-out-str (explain argspec args)))
1787 |                 (gen/generate (gen retspec overrides))))))
1788 |      (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn))
1789 |      (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform)))))
1790 | 
1791 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; non-primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1792 | (clojure.spec.alpha/def ::kvs->map (conformer #(zipmap (map ::k %) (map ::v %)) #(map (fn [[k v]] {::k k ::v v}) %)))
1793 | 
1794 | (defmacro keys*
1795 |   "takes the same arguments as spec/keys and returns a regex op that matches sequences of key/values,
1796 |   converts them into a map, and conforms that map with a corresponding
1797 |   spec/keys call:
1798 | 
1799 |   user=> (s/conform (s/keys :req-un [::a ::c]) {:a 1 :c 2})
1800 |   {:a 1, :c 2}
1801 |   user=> (s/conform (s/keys* :req-un [::a ::c]) [:a 1 :c 2])
1802 |   {:a 1, :c 2}
1803 | 
1804 |   the resulting regex op can be composed into a larger regex:
1805 | 
1806 |   user=> (s/conform (s/cat :i1 integer? :m (s/keys* :req-un [::a ::c]) :i2 integer?) [42 :a 1 :c 2 :d 4 99])
1807 |   {:i1 42, :m {:a 1, :c 2, :d 4}, :i2 99}"
1808 |   [& kspecs]
1809 |   `(let [mspec# (keys ~@kspecs)]
1810 |      (with-gen (clojure.spec.alpha/& (* (cat ::k keyword? ::v any?)) ::kvs->map mspec#)
1811 |        (fn [] (gen/fmap (fn [m#] (apply concat m#)) (gen mspec#))))))
1812 | 
1813 | (defn ^:skip-wiki nonconforming
1814 |   "takes a spec and returns a spec that has the same properties except
1815 |   'conform' returns the original (not the conformed) value. Note, will specize regex ops."
1816 |   [spec]
1817 |   (let [spec (delay (specize spec))]
1818 |     (reify
1819 |      Specize
1820 |      (specize* [s] s)
1821 |      (specize* [s _] s)
1822 |      
1823 |      Spec
1824 |      (conform* [_ x] (let [ret (conform* @spec x)]
1825 |                        (if (invalid? ret)
1826 |                          ::invalid
1827 |                          x)))
1828 |      (unform* [_ x] x)
1829 |      (explain* [_ path via in x] (explain* @spec path via in x))
1830 |      (gen* [_ overrides path rmap] (gen* @spec overrides path rmap))
1831 |      (with-gen* [_ gfn] (nonconforming (with-gen* @spec gfn)))
1832 |      (describe* [_] `(nonconforming ~(describe* @spec))))))
1833 | 
1834 | (defn ^:skip-wiki nilable-impl
1835 |   "Do not call this directly, use 'nilable'"
1836 |   [form pred gfn]
1837 |   (let [spec (delay (specize pred form))]
1838 |     (reify
1839 |      Specize
1840 |      (specize* [s] s)
1841 |      (specize* [s _] s)
1842 | 
1843 |      Spec
1844 |      (conform* [_ x] (if (nil? x) nil (conform* @spec x)))
1845 |      (unform* [_ x] (if (nil? x) nil (unform* @spec x)))
1846 |      (explain* [_ path via in x]
1847 |                (when-not (c/or (pvalid? @spec x) (nil? x))
1848 |                  (conj
1849 |                    (explain-1 form pred (conj path ::pred) via in x)
1850 |                    {:path (conj path ::nil) :pred 'nil? :val x :via via :in in})))
1851 |      (gen* [_ overrides path rmap]
1852 |            (if gfn
1853 |              (gfn)
1854 |              (gen/frequency
1855 |                [[1 (gen/delay (gen/return nil))]
1856 |                 [9 (gen/delay (gensub pred overrides (conj path ::pred) rmap form))]])))
1857 |      (with-gen* [_ gfn] (nilable-impl form pred gfn))
1858 |      (describe* [_] `(nilable ~(res form))))))
1859 | 
1860 | (defmacro nilable
1861 |   "returns a spec that accepts nil and values satisfying pred"
1862 |   [pred]
1863 |   (let [pf (res pred)]
1864 |     `(nilable-impl '~pf ~pred nil)))
1865 | 
1866 | (defn exercise
1867 |   "generates a number (default 10) of values compatible with spec and maps conform over them,
1868 |   returning a sequence of [val conformed-val] tuples. Optionally takes
1869 |   a generator overrides map as per gen"
1870 |   ([spec] (exercise spec 10))
1871 |   ([spec n] (exercise spec n nil))
1872 |   ([spec n overrides]
1873 |      (map #(vector % (conform spec %)) (gen/sample (gen spec overrides) n))))
1874 | 
1875 | (defn exercise-fn
1876 |   "exercises the fn named by sym (a symbol) by applying it to
1877 |   n (default 10) generated samples of its args spec. When fspec is
1878 |   supplied its arg spec is used, and sym-or-f can be a fn.  Returns a
1879 |   sequence of tuples of [args ret]. "
1880 |   ([sym] (exercise-fn sym 10))
1881 |   ([sym n] (exercise-fn sym n (get-spec sym)))
1882 |   ([sym-or-f n fspec]
1883 |      (let [f (if (symbol? sym-or-f) (resolve sym-or-f) sym-or-f)]
1884 |        (if-let [arg-spec (c/and fspec (:args fspec))]
1885 |          (for [args (gen/sample (gen arg-spec) n)]
1886 |            [args (apply f args)])
1887 |          (throw (Exception. "No :args spec found, can't generate"))))))
1888 | 
1889 | (defn inst-in-range?
1890 |   "Return true if inst at or after start and before end"
1891 |   [start end inst]
1892 |   (c/and (inst? inst)
1893 |          (let [t (inst-ms inst)]
1894 |            (c/and (<= (inst-ms start) t) (< t (inst-ms end))))))
1895 | 
1896 | (defmacro inst-in
1897 |   "Returns a spec that validates insts in the range from start
1898 | (inclusive) to end (exclusive)."
1899 |   [start end]
1900 |   `(let [st# (inst-ms ~start)
1901 |          et# (inst-ms ~end)
1902 |          mkdate# (fn [d#] (java.util.Date. ^{:tag ~'long} d#))]
1903 |      (spec (and inst? #(inst-in-range? ~start ~end %))
1904 |        :gen (fn []
1905 |               (gen/fmap mkdate#
1906 |                 (gen/large-integer* {:min st# :max et#}))))))
1907 | 
1908 | (defn int-in-range?
1909 |   "Return true if start <= val, val < end and val is a fixed
1910 |   precision integer."
1911 |   [start end val]
1912 |   (c/and (int? val) (<= start val) (< val end)))
1913 | 
1914 | (defmacro int-in
1915 |   "Returns a spec that validates fixed precision integers in the
1916 |   range from start (inclusive) to end (exclusive)."
1917 |   [start end]
1918 |   `(spec (and int? #(int-in-range? ~start ~end %))
1919 |      :gen #(gen/large-integer* {:min ~start :max (dec ~end)})))
1920 | 
1921 | (defmacro double-in
1922 |   "Specs a 64-bit floating point number. Options:
1923 | 
1924 |     :infinite? - whether +/- infinity allowed (default true)
1925 |     :NaN?      - whether NaN allowed (default true)
1926 |     :min       - minimum value (inclusive, default none)
1927 |     :max       - maximum value (inclusive, default none)"
1928 |   [& {:keys [infinite? NaN? min max]
1929 |     :or {infinite? true NaN? true}
1930 |     :as m}]
1931 |   `(spec (and c/double?
1932 |               ~@(when-not infinite? '[#(not (Double/isInfinite %))])
1933 |               ~@(when-not NaN? '[#(not (Double/isNaN %))])
1934 |               ~@(when max `[#(<= % ~max)])
1935 |               ~@(when min `[#(<= ~min %)]))
1936 |          :gen #(gen/double* ~m)))
1937 | 
1938 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; assert ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1939 | (defonce
1940 |   ^{:dynamic true
1941 |     :doc "If true, compiler will enable spec asserts, which are then
1942 | subject to runtime control via check-asserts? If false, compiler
1943 | will eliminate all spec assert overhead. See 'assert'.
1944 | 
1945 | Initially set to boolean value of clojure.spec.compile-asserts
1946 | system property. Defaults to true."}
1947 |   *compile-asserts*
1948 |   (not= "false" (System/getProperty "clojure.spec.compile-asserts")))
1949 | 
1950 | (defn check-asserts?
1951 |   "Returns the value set by check-asserts."
1952 |   []
1953 |   clojure.lang.RT/checkSpecAsserts)
1954 | 
1955 | (defn check-asserts
1956 |   "Enable or disable spec asserts that have been compiled
1957 | with '*compile-asserts*' true.  See 'assert'.
1958 | 
1959 | Initially set to boolean value of clojure.spec.check-asserts
1960 | system property. Defaults to false."
1961 |   [flag]
1962 |   (set! (. clojure.lang.RT checkSpecAsserts) flag))
1963 | 
1964 | (defn assert*
1965 |   "Do not call this directly, use 'assert'."
1966 |   [spec x]
1967 |   (if (valid? spec x)
1968 |     x
1969 |     (let [ed (c/merge (assoc (explain-data* spec [] [] [] x)
1970 |                         ::failure :assertion-failed))]
1971 |       (throw (ex-info
1972 |               (str "Spec assertion failed\n" (with-out-str (explain-out ed)))
1973 |               ed)))))
1974 | 
1975 | (defmacro assert
1976 |   "spec-checking assert expression. Returns x if x is valid? according
1977 | to spec, else throws an ex-info with explain-data plus ::failure of
1978 | :assertion-failed.
1979 | 
1980 | Can be disabled at either compile time or runtime:
1981 | 
1982 | If *compile-asserts* is false at compile time, compiles to x. Defaults
1983 | to value of 'clojure.spec.compile-asserts' system property, or true if
1984 | not set.
1985 | 
1986 | If (check-asserts?) is false at runtime, always returns x. Defaults to
1987 | value of 'clojure.spec.check-asserts' system property, or false if not
1988 | set. You can toggle check-asserts? with (check-asserts bool)."
1989 |   [spec x]
1990 |   (if *compile-asserts*
1991 |     `(if clojure.lang.RT/checkSpecAsserts
1992 |        (assert* ~spec ~x)
1993 |        ~x)
1994 |     x))
1995 | 
1996 | 
1997 | 


--------------------------------------------------------------------------------