pax_global_header00006660000000000000000000000064131411542060014507gustar00rootroot0000000000000052 comment=e810fa6fb9cee3d6e4687d6ba2b4b6a04e7dfe52 prismatic-schema-clojure-1.1.6/000075500000000000000000000000001314115420600164045ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/.github/000075500000000000000000000000001314115420600177445ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/.github/ISSUE_TEMPLATE.md000064400000000000000000000004121314115420600224460ustar00rootroot00000000000000- [ ] This is a bug report (with instructions to reproduce) or other issue with the code (if this is a question or feature request, please **do not** open an issue and post on the [mailing list](https://groups.google.com/forum/#!forum/prismatic-plumbing) instead). prismatic-schema-clojure-1.1.6/.gitignore000064400000000000000000000001001314115420600203630ustar00rootroot00000000000000target/** .lein** .repl/ out/ *~ pom.xml *.asc /doc/ .nrepl-portprismatic-schema-clojure-1.1.6/CHANGELOG.md000064400000000000000000000221451314115420600202210ustar00rootroot00000000000000## 1.1.6 * Add exclusions to workaround `->MapEntry` warnings with latest cljs. ## 1.1.5 * Add float type to JVM coercers. ## 1.1.4 * Highlights schema validation errors * Fix an issue with `isa?` and the global hierarchy * Fix an issue with coercion and map entries ## 1.1.3 * Make fn validation customizable by addition of `fn-validator` function ## 1.1.2 * Exclude `clojure.core/Inst` to avoid warnings in Clojure 1.9 alphas ## 1.1.1 * Fix (at least some) AOT issues around PSimpleCell/SimpleVCell, by replacing with atom/AtomicReference. ## 1.1.0 * **Deprecate* schema.experimental.generators and schema.experimental.complete. Find them in their new home in the separate schema-generators project. * **BREAKING** change the internal details of collection specs (should only be an issue for custom collection schemas that don't rely on helpers `one-element` or `all-elements`). * Fix generation for sequence schemas containing a non-trailing `s/optional` element. ## 1.0.6 * Install a pprint method that uses the explain, in addition to an ordinary print-method. Should fix large prints and stack overflows while pprinting schemas, or with plugins such as `pretty`. ## 1.0.5 * Fix completion through non-map collections ## 1.0.4 * Attempt to resolve issues with AOT compilation by moving typehint on `use-fn-validation` var to callsites. * Update generators, bump minimum version of test.check to 0.9.0. Generators will only work under Clojure 1.7.0+. * Better performance for anonymous schematized functions, via lazy checker creation ## 1.0.3 * Fix warning about overriding `atom` under Clojure 1.7 * Fix behavior of `constrained` with some schemas (e.g. maps). ## 1.0.2 * Extend keyword `enum` coercion to keyword `eq` coercion * Add `s/atom` schema for atoms * Add `coercer!` which throws on error * Add leaf generators for UUIDs * Make `s/defn` compatible with `with-test` * Add `constrained` schema for postconditions (replaces `(both x (s/pred ...))`) ## 1.0.1 * Catch and report exceptions in guards the same as preconditions, rather than allowing them to propagate out. ## 1.0.0 * New schema backend, which is faster, simpler, and more declarative, enabling more applications and simplifying tooling. Users of built-in schema types should experience very little or no breakage, but tooling or custom schema types will need to be updated. As a concrete example of an application that's enabled, schema now experimentally supports test-check style generation from schemas, as well as completion of partial inputs. * **BREAKING** Changes to the core Schema protocol will break existing third-party schema tooling and schema types. * **BREAKING** Records coerced to an ordinary (non-record) map schema are now converted to maps, rather than retaining their record type. * **Deprecate** `s/either` in favor of `s/cond-pre`, `s/conditional`, or `schema.experimental.abstract-map-schema`. As of this release, `either` no longer works with coercion. * **Deprecate** `s/both` in favor of improved `s/conditional`. * **Deprecate** `schema.core/defrecord+`; moved to new `schema.potemkin` namespace. * `s/pred` can more intelligently guess the predicate name * `record` schemas can now coerce values to corresponding record types. * New experimental `abstract-map-schema` that models super/subclasses as maps. * Improved explains explains for leaf schemas, especially in Clojurescript. ## 0.4.4 * Fix ClojureScript warnings about `map->Record` constructors being redefined. * Add queue schemas * Configurable maximum length for values in error messages * Fix potential memory leaks after many redefinitions of `s/defn` or `s/defrecord`. ## 0.4.3 * Fix longstanding AOT compilation issue when used with Clojure 1.7.0-RC1 and later. ## 0.4.2 * Add recursive schema support for ClojureScript * Add ns metadata to defschema ## 0.4.1 * Fix some harmless warnings when using Schema with the latest version of ClojureScript (due to the addition of positional constructors for `deftype`). ## 0.4.0 * **BREAKING** Remove support for old `^{:schema ..}` style annotations. `:- schema` is the preferred way, but metadata-style schemas are still allowed for valid Clojure typehints. * **BREAKING** Remove support for bare `:- Protocol` annotations (use `:- (s/protocol Protocol)` instead). * **BREAKING** Remove deprecated macros (`defn`, `defrecord`, etc) from schema.macros. The identical versions in schema.core remain. * **BREAKING** Remove potemkin as a dependency, and the `*use-potemkin*` flag. To get the old behavior of potemkin defrecords, you can still bring your own potemkin and use `schema.core/defrecord+` in place of `schema.core/defrecord`. ## 0.3.7 * Add coercion handler for s/Uuid from string input ## 0.3.6 * Support java.util.List instances as valid data for sequence schemas ## 0.3.5 * Make primitive schemas work better in some cases under partial AOT compilation ## 0.3.3 * Fix bug in `defschema` which clobbered metadata, breaking `s/protocol` in Clojure in 0.3.2. ## 0.3.2 * Fix `s/protocol` in Clojure (didn't work properly with extends created later) * Fix ClojureScript (Closure) warning about reference to global RegExp object. * Add `set-compile-fn-validation!` function to turn off emission of validation globally, and turn off emission of validation code for non- ^:always-validate functions when *assert* is false. ## 0.3.1 * Fix Clojurescript compilation warnings/errors from accidental references to `clojure.data/diff` and `class` inside error messages. ## 0.3.0 * **BREAKING** increase minimum clojurescript version 2120 to support :include-macros * **Deprecate** direct use of `schema.macros` in client code -- prefer canonical versions in `schema.core` in both Clojure and ClojureScript, using `:include-macros true` in cljs. * **Deprecate** old `^{:s schema}` syntax for providing schemas. * **Deprecate** `*use-potemkin*` flag and behavior to default to potemkin s/defrecords in Clojure; in future releases, you will have to provide your own potemkin and explicitly opt-in to this behavior. * (Hopefully) fix issues with AOT compilation, by removing dependence on potemkin/import-vars. * Add `isa` schema for Clojure hierarchies. * Preserve the types of maps (including Records) when coercing with map schemas. * Smarter code generation in s/defrecord to avoid dead code warnings * Fix printed form of s/Str in ClojureScript * Make some internal fns public to simplify third-part schema extensions * Walking records with map schemas preserves the record type * Proper explain for s/Str ## 0.2.6 * Memoize walker computation, providing much faster checker compilation for graph-structured schemas ## 0.2.5 * Add `normalized-defn-args` helper fn for defining `s/defn`-like macros. * Map schemas correctly validate against struct-maps ## 0.2.4 * Fixed an issue that could cause ClojureScript compilation to fail * Generalize `s/recursive` to work on artibrary refs * Add `s/Symbol` as a cross-platfor primitive ## 0.2.3 * Improved explains for primitives & primitive arrays * More robust double coercions * Fix cljs warning about extending js/Function * Import schema.macros/defmulti in schema.core ## 0.2.2 * Add validated `s/def`. * Add validated `s/defmethod`. * Add `Bool` coercions. ## 0.2.1 * Add `Bool` to cross-platform primitives * Fix several minor bugs * Replace cljs-test with headless clojurescript.test. ## 0.2.0 * **breaking change:** Cross-platform leaves String and Number are now Str and Num (the former caused warnings and broke AOT). * Replaced core Schema protocol method `check` with `walker`, for increased speed and versatility * Support for schema-driven transformations/coercion * Schemas for primitive arrays (`longs`, etc) * Schematized `letfn` ## 0.1.10 * Remove non-dev dependency on cljx ## 0.1.9 * Support for pre/postcondition maps in `s/defn` * Support for recursive schemas in Clojure * Fixes for sm/defn and sm/defrecord with cljs advanced compilation ## 0.1.8 * Works with advanced compilation in cljs (at least sometimes) ## 0.1.7 * More small bugfixes * Better validation error messages in cljs ## 0.1.6 * Minor bugfixes (thanks various contributors) * Extend schema protocol to regex (thanks [AlexBaranosky](https://github.com/AlexBaranosky)). * Add `:never-validate` meta option ## 0.1.5 * Fix regression in primitive handling introduced in 0.1.4 ## 0.1.4 * Added Regex, Inst, and Uuid as primitive schema types (thanks [jwhitlark](https://github.com/jwhitlark)) * Add annotated arglists to functions defined with `s/defn` (thanks [danielneal](https://github.com/danielneal)) * Add `set-fn-validation!` to schema.core, to globally turn validation on or off. * Add `:always-validate` metadata on fn/defn name to unconditionally use validation. ## 0.1.3 * Fix compatibility with Clojurescript 1889 (removal of format) ## 0.1.2 * Validate returns the value on success * Sequence schemas only match sequential? things, to match map and set * Implementation of `defschema` puts name in metadata, rather than generating named schema * Improved error messages and stack traces for `s/defn` ## 0.1.1 * Bugfix: with-fn-validation persisting after Exception ## 0.1.0 * Initial release prismatic-schema-clojure-1.1.6/CONTRIBUTING.md000064400000000000000000000032321314115420600206350ustar00rootroot00000000000000# Contributing Contributions to Schema are very welcome. Please file bug reports on [GitHub](https://github.com/plumatic/schema/issues). For questions, feature requests, or discussion, please post on the Plumbing [mailing list](https://groups.google.com/forum/#!forum/prismatic-plumbing) for now. Contributions are preferred as GitHub pull requests on topic branches. If you want to discuss a potential change before coding it up, please post on the mailing list. Schema uses the excellent [cljx](https://github.com/lynaghk/cljx) project to share source between Clojure and ClojureScript. For any in-depth changes to Schema, you will probably want to be familiar with its feature expressions (`#clj` and `#cljx`), and the inherent differences between Clojure and ClojureScript. In particular, if you're wondering why the code is divided the way it is, this is probably the answer. If you develop with Emacs, the included `:nrepl-middleware` should allow you to work at the REPL as you're used to. Schema is relatively well-tested, on both Clojure and ClojureScript. Before submitting a pull request, we ask that you: * please try to follow the conventions in the existing code, including standard Emacs indentation, no trailing whitespace, and a max width of 95 columns * rebase your feature branch on the latest master branch * ensure any new code is well-tested, and if possible, any issue fixed is covered by one or more new tests * check that all of the tests pass **in both Clojure and ClojureScript** To run the Clojure and ClojureScript tests, first run `lein cljx`, then run `lein test`. You must have phantomjs installed for the ClojureScript tests to run. prismatic-schema-clojure-1.1.6/README.md000064400000000000000000000444171314115420600176750ustar00rootroot00000000000000 A Clojure(Script) library for declarative data description and validation. [![Clojars Project](http://clojars.org/prismatic/schema/latest-version.svg)](http://clojars.org/prismatic/schema) [Latest codox API docs](http://plumatic.github.io/schema). **NOTE: this README is updated for the recent 1.0.0 release. Please refer to the git history for previous versions of schema.** -- One of the difficulties with bringing Clojure into a team is the overhead of understanding the kind of data (e.g., list of strings, nested map from long to string to double) that a function expects and returns. While a full-blown type system is one solution to this problem, we present a lighter weight solution: schemas. (For more details on why we built Schema, check out [this post](http://plumatic.github.io/schema-for-clojurescript-data-shape-declaration-and-validation).) Schema is a rich language for describing data shapes, with a variety of features: - Data validation, with descriptive error messages of failures (targeted at programmers) - Annotation of function arguments and return values, with optional runtime validation - Schema-driven data **coercion**, which can automatically, succinctly, and safely convert complex data types (see the Coercion section below) - Schema also supports experimental `clojure.test.check` data **generation** from Schemas, as well as **completion** of partial datums, features we've found very useful when writing tests. ** As of 1.1.0, this functionality can be found in the separate [`schema-generators`](https://github.com/plumatic/schema-generators) library. ** - Schema is also built into our [`plumbing`](https://github.com/plumatic/plumbing) and [`fnhouse`](https://github.com/plumatic/fnhouse) libraries, which illustrate how we build services and APIs easily and safely with Schema. ## Meet Schema A Schema is a Clojure(Script) data structure describing a data shape, which can be used to document and validate functions and data. ```clojure (ns schema-examples (:require [schema.core :as s :include-macros true ;; cljs only ])) (def Data "A schema for a nested data type" {:a {:b s/Str :c s/Int} :d [{:e s/Keyword :f [s/Num]}]}) (s/validate Data {:a {:b "abc" :c 123} :d [{:e :bc :f [12.2 13 100]} {:e :bc :f [-1]}]}) ;; Success! (s/validate Data {:a {:b 123 :c "ABC"}}) ;; Exception -- Value does not match schema: ;; {:a {:b (not (instance? java.lang.String 123)), ;; :c (not (integer? "ABC"))}, ;; :d missing-required-key} ``` The simplest schemas describe leaf values like Keywords, Numbers, and instances of Classes (on the JVM) and prototypes (in ClojureScript): ```clojure ;; s/Any, s/Bool, s/Num, s/Keyword, s/Symbol, s/Int, and s/Str are cross-platform schemas. (s/validate s/Num 42) ;; 42 (s/validate s/Num "42") ;; RuntimeException: Value does not match schema: (not (instance java.lang.Number "42")) (s/validate s/Keyword :whoa) ;; :whoa (s/validate s/Keyword 123) ;; RuntimeException: Value does not match schema: (not (keyword? 123)) ;; On the JVM, you can use classes for instance? checks (s/validate java.lang.String "schema") ;; On JS, you can use prototype functions (s/validate Element (js/document.getElementById "some-div-id")) ``` From these simple building blocks, we can build up more complex schemas that look like the data they describe. Taking the examples above: ```clojure ;; list of strings (s/validate [s/Str] ["a" "b" "c"]) ;; nested map from long to String to double (s/validate {long {String double}} {1 {"2" 3.0 "4" 5.0}}) ``` Since schemas are just data, you can also `def` them and reuse and compose them as you would expect: ```clojure (def StringList [s/Str]) (def StringScores {String double}) (def StringScoreMap {long StringScores}) ``` What about when things go bad? Schema's `s/check` and `s/validate` provide meaningful errors that look like the bad parts of your data, and are (hopefully) easy to understand. ```clojure (s/validate StringList ["a" :b "c"]) ;; RuntimeException: Value does not match schema: ;; [nil (not (instance? java.lang.String :b)) nil] (s/validate StringScoreMap {1 {"2" 3.0 "3" [5.0]} 4.0 {}}) ;; RuntimeException: Value does not match schema: ;; {1 {"3" (not (instance? java.lang.Double [5.0]))}, ;; (not (instance? java.lang.Long 4.0)) invalid-key} ``` See the "More Examples" section below for more examples and explanation, or the [custom Schemas types](https://github.com/plumatic/schema/wiki/Defining-New-Schema-Types-1.0) page for details on how Schema works under the hood. ## Beyond type hints If you've done much Clojure, you've probably seen code with documentation like this: ```clojure (defrecord StampedNames [^Long date names ;; a list of Strings ]) (defn ^StampedNames stamped-names "names is a list of Strings" [names] (StampedNames. (str (System/currentTimeMillis)) names)) ``` Clojure's type hints make great documentation, but they fall short for complex types, often leading to ad-hoc descriptions of data in comments and doc-strings. This is better than nothing, but these ad hoc descriptions are often imprecise, hard to read, and prone to bit-rot. Schema provides macros `defrecord`, `defn`, and `fn` that help bridge this gap, by allowing arbitrary schemas as type hints on fields, arguments, and return values. This is a graceful extension of Clojure's type hinting system, because every type hint is a valid Schema, and Schemas that represent valid type hints are automatically passed through to Clojure. ```clojure (s/defrecord StampedNames [date :- Long names :- [s/Str]]) (s/defn stamped-names :- StampedNames [names :- [s/Str]] (StampedNames. (str (System/currentTimeMillis)) names)) ``` Here, `x :- y` means that `x` must satisfy schema `y`, replacing and extending the more familiar metadata hints such as `^y x`. As you can see, these type hints are precise, easy to read, and shorter than the comments they replace. Moreover, they produce Schemas that are *data*, and can be inspected, manipulated, and used for validation on-demand (did you spot the bug in `stamped-names`?) ```clojure ;; You can inspect the schemas of the record and function (s/explain StampedNames) ==> (record user.StampedNames {:date java.lang.Long, :names [java.lang.String]}) (s/explain (s/fn-schema stamped-names)) ==> (=> (record user.StampedNames {:date java.lang.Long, :names [java.lang.String]}) [java.lang.String]) ;; And you can turn on validation to catch bugs in your functions and schemas (s/with-fn-validation (stamped-names ["bob"])) ==> RuntimeException: Output of stamped-names does not match schema: {:date (not (instance? java.lang.Long "1378267311501"))} ;; Oops, I guess we should remove that `str` from `stamped-names`. ``` ## Schemas in practice We've already seen how we can build up Schemas via composition, attach them to functions, and use them to validate data. What does this look like in practice? First, we ensure that all data types that will be shared across namespaces (or heavily used within namespaces) have Schemas, either by `def`ing them or using `s/defrecord`. This allows us to compactly and precisely refer to this data type in more complex data types, or when documenting function arguments and return values. This documentation is probably the most important benefit of Schema, which is why we've optimized Schemas for easy readability and reuse -- and sometimes, this is all you need. Schemas are purely descriptive, not prescriptive, so unlike a type system they should never get in your way, or constrain the types of functions you can write. After documentation, the next-most important benefit is validation. Thus far, we've found four key use cases for validation. First, you can globally turn on function validation within a given test namespace by adding this line: ```clojure (use-fixtures :once schema.test/validate-schemas) ``` As long as your tests cover all call boundaries, this means you should catch any 'type-like' bugs in your code at test time. Second, it may be handy to enable schema validation during development. To enable it, you can either type this into the repl or put it in your `user.clj`: ```clojure (s/set-fn-validation! true) ``` To disable it again, call the same function, but with `false` as parameter instead. Third, we manually call `s/validate` to check any data we read and write over the wire or to persistent storage, ensuring that we catch and debug bad data before it strays too far from its source. If you need maximal performance, you can avoid the schema processing overhead on each call by create a validator once with `s/validator` and calling the resulting function on each datum you want to validate (`s/defn` does this under the hood). Analogously, `s/check` and `s/checker` are similar, but *return* the error (or nil for success) rather than throwing exceptions on bad data. Alternatively, you can force validation for key functions (without the need for `with-fn-validation`): ```clojure (s/defn ^:always-validate stamped-names ...) ``` Thus, each time you invoke `stamped-names`, Schema will perform validation. To reduce generated code size, you can use the `*assert*` flag and `set-compile-fn-validation!` functions to control when validation code is generated ([details](https://github.com/plumatic/schema/blob/master/src/clj/schema/macros.clj#L181)). Schema will attempt to reduce the verbosity of its output by restricting the size of values that fail validation to 19 characters. If a value exceeds this, it will be replaced by the name of its class. You can adjust this size limitation by calling `set-max-value-length!`. Finally, we use validation with coercion for API inputs and outputs. See the coercion section below for details. ## More examples The source code in [schema/core.cljx](https://github.com/plumatic/schema/blob/master/src/cljx/schema/core.cljx) provides a wealth of extra tools for defining schemas, which are described in docstrings. The file [schema/core_test.cljx](https://github.com/plumatic/schema/blob/master/test/cljx/schema/core_test.cljx) demonstrates a variety of sample schemas and many examples of passing & failing clojure data. We'll just touch on a few more examples here, and refer the reader to the code for more details and examples (for now). ### Map schema details In addition to uniform maps (like String to double), map schemas can also capture maps with specific key requirements: ```clojure (def FooBar {(s/required-key :foo) s/Str (s/required-key :bar) s/Keyword}) (s/validate FooBar {:foo "f" :bar :b}) ;; {:foo "f" :bar :b} (s/validate FooBar {:foo :f}) ;; RuntimeException: Value does not match schema: ;; {:foo (not (instance? java.lang.String :f)), ;; :bar missing-required-key} ``` For the special case of keywords, you can omit the `required-key`, like `{:foo s/Str :bar s/Keyword}`. You can also provide specific optional keys, and combine specific keys with generic schemas for the remaining key-value mappings: ```clojure (def FancyMap "If foo is present, it must map to a Keyword. Any number of additional String-String mappings are allowed as well." {(s/optional-key :foo) s/Keyword s/Str s/Str}) (s/validate FancyMap {"a" "b"}) (s/validate FancyMap {:foo :f "c" "d" "e" "f"}) ``` ### Sequence schema details Similarly, you can also write sequence schemas that expect particular values in specific positions: ```clojure (def FancySeq "A sequence that starts with a String, followed by an optional Keyword, followed by any number of Numbers." [(s/one s/Str "s") (s/optional s/Keyword "k") s/Num]) (s/validate FancySeq ["test"]) (s/validate FancySeq ["test" :k]) (s/validate FancySeq ["test" :k 1 2 3]) ;; all ok (s/validate FancySeq [1 :k 2 3 "4"]) ;; RuntimeException: Value does not match schema: ;; [(named (not (instance? java.lang.String 1)) "s") ;; nil nil nil ;; (not (instance? java.lang.Number "4"))] ``` ### Other schema types [`schema.core`](https://github.com/plumatic/schema/blob/master/src/cljx/schema/core.cljx) provides many more utilities for building schemas, including `maybe`, `eq`, `enum`, `pred`, `conditional`, `cond-pre`, `constrained`, and more. Here are a few of our favorites: ```clojure ;; anything (s/validate [s/Any] ["woohoo!" 'go-nuts 42.0]) ;; maybe (s/validate (s/maybe s/Keyword) :a) (s/validate (s/maybe s/Keyword) nil) ;; eq and enum (s/validate (s/eq :a) :a) (s/validate (s/enum :a :b :c) :a) ;; pred (s/validate (s/pred odd?) 1) ;; conditional (i.e. variant or option) (def StringListOrKeywordMap (s/conditional map? {s/Keyword s/Keyword} :else [String])) (s/validate StringListOrKeywordMap ["A" "B" "C"]) ;; => ["A" "B" "C"] (s/validate StringListOrKeywordMap {:foo :bar}) ;; => {:foo :bar} (s/validate StringListOrKeywordMap [:foo]) ;; RuntimeException: Value does not match schema: [(not (instance? java.lang.String :foo))] ;; if (shorthand for conditional) (def StringListOrKeywordMap (s/if map? {s/Keyword s/Keyword} [String])) ;; cond-pre (experimental), also shorthand for conditional, allows you to skip the ;; predicate when the options are superficially different by doing a greedy match ;; on the preconditions of the options. (def StringListOrKeywordMap (s/cond-pre {s/Keyword s/Keyword} [String])) ;; but don't do this -- this will never validate `{:b :x}` because the first schema ;; will be chosen based on the `map?` precondition (use `if` or `abstract-map-schema` instead): (def BadSchema (s/cond-pre {:a s/Keyword} {:b s/Keyword})) ;; conditional can also be used to apply extra validation to a single type, ;; but constrained is often more desirable since it applies the validation ;; as a *postcondition*, which typically provides better error messages ;; and works better with coercion (def OddLong (s/constrained long odd?)) (s/validate OddLong 1) ;; 1 (s/validate OddLong 2) ;; RuntimeException: Value does not match schema: (not (odd? 2)) (s/validate OddLong (int 3)) ;; RuntimeException: Value does not match schema: (not (instance? java.lang.Long 3)) ;; recursive (def Tree {:value s/Int :children [(s/recursive #'Tree)]}) (s/validate Tree {:value 0, :children [{:value 1, :children []}]}) ;; abstract-map (experimental) models "abstract classes" and "subclasses" with maps. (require '[schema.experimental.abstract-map :as abstract-map]) (s/defschema Animal (abstract-map/abstract-map-schema :type {:name s/Str})) (abstract-map/extend-schema Cat Animal [:cat] {:claws? s/Bool}) (abstract-map/extend-schema Dog Animal [:dog] {:barks? s/Bool}) (s/validate Cat {:type :cat :name "melvin" :claws? true}) (s/validate Animal {:type :cat :name "melvin" :claws? true}) (s/validate Animal {:type :dog :name "roofer" :barks? true}) (s/validate Animal {:type :cat :name "confused kitty" :barks? true}) ;; RuntimeException: Value does not match schema: {:claws? missing-required-key, :barks? disallowed-key} ``` You can also define schemas for [recursive data types](https://github.com/plumatic/schema/wiki/Recursive-Schemas), or create [your own custom schemas types](https://github.com/plumatic/schema/wiki/Defining-New-Schema-Types-1.0). ## Transformations and Coercion Schema also supports schema-driven data transformations, with *coercion* being the main application fleshed out thus far. Coercion is like validation, except a schema-dependent transformation can be applied to the input data before validation. An example application of coercion is converting parsed JSON (e.g., from an HTTP post request) to a domain object with a richer set of types (e.g., Keywords). ```clojure (def CommentRequest {(s/optional-key :parent-comment-id) long :text String :share-services [(s/enum :twitter :facebook :google)]}) (def parse-comment-request (coerce/coercer CommentRequest coerce/json-coercion-matcher)) (= (parse-comment-request {:parent-comment-id (int 2128123123) :text "This is awesome!" :share-services ["twitter" "facebook"]}) {:parent-comment-id 2128123123 :text "This is awesome!" :share-services [:twitter :facebook]}) ;; ==> true ``` Here, `json-coercion-matcher` provides some useful defaults for coercing from JSON, such as: - Numbers should be coerced to the expected type, if this can be done without losing precision. - When a Keyword is expected, a String can be coerced to the correct type by calling keyword There's nothing special about `json-coercion-matcher` though; it's just as easy to [make your own schema-specific transformations](https://github.com/plumatic/schema/wiki/Writing-Custom-Transformations) to do even more. For more details, see [this blog post](http://plumatic.github.io//schema-0-2-0-back-with-clojurescript-data-coercion). ## Generation and Completion ** As of 1.1.0, this functionality can be found in the separate [`schema-generators`](https://github.com/plumatic/schema-generators) library. ** ## For the Future Longer-term, we have lots more in store for Schema. Just a couple of the crazy ideas we have brewing are: - Automatically generate API client libraries based on API schemas - Compile to `core.typed` annotations for more typey goodness, if that's your thing ## Community Please feel free to join the Plumbing [mailing list](https://groups.google.com/forum/#!forum/prismatic-plumbing) to ask questions or discuss how you're using Schema. We welcome contributions in the form of bug reports and pull requests; please see `CONTRIBUTING.md` in the repo root for guidelines. Libraries that extend `schema` with new functionality are great too; here are a few that we know of: - https://github.com/metosin/schema-tools has lots of useful utilities for working with schemas - https://github.com/cddr/integrity includes a variety of extensions, including helpers for producing error messages suitable for end-users. - https://github.com/gfredericks/schema-bijections has support for bijections, which are like a precise, two-way version of coercion, created for use with JSON APIs. - https://github.com/outpace/schema-transit couples Schema to Cognitect's Transit library - https://github.com/plumatic/schema-generators provides out-of-the box generation and partial datum completion from Schemas. If you make something new, please feel free to PR to add it here! ## Supported Clojure versions Schema is currently supported on 1.6 through 1.8 and the latest version of ClojureScript. ## License Distributed under the Eclipse Public License, the same as Clojure. prismatic-schema-clojure-1.1.6/bin/000075500000000000000000000000001314115420600171545ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/bin/push_docs.sh000075500000000000000000000007021314115420600215010ustar00rootroot00000000000000#!/bin/bash set -e # Script to generate docs and push to github pages. # https://github.com/weavejester/codox/wiki/Deploying-to-GitHub-Pages cd `dirname $0` git fetch --tags latestTag=$(git describe --tags `git rev-list --tags --max-count=1`) git checkout $latestTag lein doc cd ../doc git checkout gh-pages # To be sure you're on the right branch git add . git commit -am "new documentation push." git push -u origin gh-pages cd .. git checkout -prismatic-schema-clojure-1.1.6/bin/release.sh000075500000000000000000000002011314115420600211240ustar00rootroot00000000000000#!/bin/bash set -e # Script to push a release with lein-release and then push docs. cd `dirname $0` lein release ./push_docs.sh prismatic-schema-clojure-1.1.6/bin/setup_codox.sh000075500000000000000000000005001314115420600220420ustar00rootroot00000000000000#!/bin/bash set -e # One-time script to setup codox deploy to github pages. # https://github.com/weavejester/codox/wiki/Deploying-to-GitHub-Pages cd `dirname $0` cd .. rm -rf doc && mkdir doc git clone git@github.com:plumatic/schema.git doc cd doc git symbolic-ref HEAD refs/heads/gh-pages rm .git/index git clean -fdxprismatic-schema-clojure-1.1.6/project.clj000064400000000000000000000101231314115420600205410ustar00rootroot00000000000000(defproject prismatic/schema "1.1.6" :description "Clojure(Script) library for declarative data description and validation" :url "http://github.com/plumatic/schema" :license {:name "Eclipse Public License" :url "http://www.eclipse.org/legal/epl-v10.html"} :profiles {:dev {:dependencies [[org.clojure/clojure "1.7.0"] [org.clojure/clojurescript "0.0-2760"] [org.clojure/tools.nrepl "0.2.5"] [org.clojure/test.check "0.9.0"] [potemkin "0.4.1"]] :plugins [[com.keminglabs/cljx "0.6.0" :exclusions [org.clojure/clojure]] [codox "0.8.8"] [lein-cljsbuild "1.0.5"] [com.cemerick/clojurescript.test "0.3.1"]] :cljx {:builds [{:source-paths ["src/cljx"] :output-path "target/generated/src/clj" :rules :clj} {:source-paths ["src/cljx"] :output-path "target/generated/src/cljs" :rules :cljs} {:source-paths ["test/cljx"] :output-path "target/generated/test/clj" :rules :clj} {:source-paths ["test/cljx"] :output-path "target/generated/test/cljs" :rules :cljs}]}} :1.8 {:dependencies [[org.clojure/clojure "1.8.0"] [org.clojure/clojurescript "0.0-3308"]]} :1.9 {:dependencies [[org.clojure/clojure "1.9.0-alpha5"] [org.clojure/clojurescript "0.0-3308"]]}} :aliases {"all" ["with-profile" "dev:dev,1.8:dev,1.9"] "deploy" ["do" "clean," "cljx" "once," "deploy" "clojars"] "test" ["do" "clean," "cljx" "once," "test," "with-profile" "dev" "cljsbuild" "test"]} :jar-exclusions [#"\.cljx|\.swp|\.swo|\.DS_Store"] :lein-release {:deploy-via :shell :shell ["lein" "deploy"]} :auto-clean false :source-paths ["target/generated/src/clj" "src/clj"] :resource-paths ["target/generated/src/cljs"] :test-paths ["target/generated/test/clj" "test/clj"] :cljsbuild {:test-commands {"unit" ["phantomjs" :runner "this.literal_js_was_evaluated=true" "target/unit-test.js"] "unit-no-assert" ["phantomjs" :runner "this.literal_js_was_evaluated=true" "target/unit-test-no-assert.js"]} :builds {:dev {:source-paths ["src/clj" "target/generated/src/cljs"] :compiler {:output-to "target/main.js" :optimizations :whitespace :pretty-print true}} :test {:source-paths ["src/clj" "test/clj" "target/generated/src/cljs" "target/generated/test/cljs"] :compiler {:output-to "target/unit-test.js" :optimizations :whitespace :pretty-print true}} :test-no-assert {:source-paths ["src/clj" "test/clj" "target/generated/src/cljs" "target/generated/test/cljs"] :assert false :compiler {:output-to "target/unit-test-no-assert.js" :optimizations :whitespace :pretty-print true}}}} :codox {:src-uri-mapping {#"target/generated/src/clj" #(str "src/cljx/" % "x")} :src-dir-uri "http://github.com/plumatic/schema/blob/master/" :src-linenum-anchor-prefix "L"} :signing {:gpg-key "66E0BF75"}) prismatic-schema-clojure-1.1.6/src/000075500000000000000000000000001314115420600171735ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/src/clj/000075500000000000000000000000001314115420600177435ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/src/clj/schema/000075500000000000000000000000001314115420600212035ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/src/clj/schema/coerce.clj000064400000000000000000000124231314115420600231370ustar00rootroot00000000000000(ns schema.coerce "Extension of schema for input coercion (coercing an input to match a schema)" (:require [clojure.edn :as edn] [schema.macros :as macros] [schema.core :as s :include-macros true] [schema.spec.core :as spec] [schema.utils :as utils] [clojure.string :as str]) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Generic input coercion (def Schema "A Schema for Schemas" (s/protocol s/Schema)) (def CoercionMatcher "A function from schema to coercion function, or nil if no special coercion is needed. The returned function is applied to the corresponding data before validation (or walking/ coercion of its sub-schemas, if applicable)" (s/=> (s/maybe (s/=> s/Any s/Any)) Schema)) (s/defn coercer "Produce a function that simultaneously coerces and validates a datum. Returns a coerced value, or a schema.utils.ErrorContainer describing the error." [schema coercion-matcher :- CoercionMatcher] (spec/run-checker (fn [s params] (let [c (spec/checker (s/spec s) params)] (if-let [coercer (coercion-matcher s)] (fn [x] (macros/try-catchall (let [v (coercer x)] (if (utils/error? v) v (c v))) (catch t (macros/validation-error s x t)))) c))) true schema)) (s/defn coercer! "Like `coercer`, but is guaranteed to return a value that satisfies schema (or throw)." [schema coercion-matcher :- CoercionMatcher] (let [c (coercer schema coercion-matcher)] (fn [value] (let [coerced (c value)] (when-let [error (utils/error-val coerced)] (macros/error! (utils/format* "Value cannot be coerced to match schema: %s" (pr-str error)) {:schema schema :value value :error error})) coerced)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Coercion helpers (s/defn first-matcher :- CoercionMatcher "A matcher that takes the first match from matchers." [matchers :- [CoercionMatcher]] (fn [schema] (first (keep #(% schema) matchers)))) (defn string->keyword [s] (if (string? s) (keyword s) s)) (defn string->boolean "returns true for strings that are equal, ignoring case, to the string 'true' (following java.lang.Boolean/parseBoolean semantics)" [s] (if (string? s) (= "true" (str/lower-case s)) s)) (defn keyword-enum-matcher [schema] (when (or (and (instance? schema.core.EnumSchema schema) (every? keyword? (.-vs ^schema.core.EnumSchema schema))) (and (instance? schema.core.EqSchema schema) (keyword? (.-v ^schema.core.EqSchema schema)))) string->keyword)) (defn set-matcher [schema] (if (instance? clojure.lang.APersistentSet schema) (fn [x] (if (sequential? x) (set x) x)))) (defn safe "Take a single-arg function f, and return a single-arg function that acts as identity if f throws an exception, and like f otherwise. Useful because coercers are not explicitly guarded for exceptions, and failing to coerce will generally produce a more useful error in this case." [f] (fn [x] (macros/try-catchall (f x) (catch e x)))) (def safe-long-cast "Coerce x to a long if this can be done without losing precision, otherwise return x." (safe (fn [x] (let [l (long x)] (if (== l x) l x))))) (def string->uuid "Returns instance of UUID if input is a string. Note: in CLJS, this does not guarantee a specific UUID string representation, similar to #uuid reader" (safe #(java.util.UUID/fromString ^String %)) ) (def ^:no-doc +json-coercions+ (merge {s/Keyword string->keyword s/Bool string->boolean s/Uuid string->uuid} {clojure.lang.Keyword string->keyword s/Int safe-long-cast Long safe-long-cast Double (safe double) Float (safe float) Boolean string->boolean})) (defn json-coercion-matcher "A matcher that coerces keywords and keyword eq/enums from strings, and longs and doubles from numbers on the JVM (without losing precision)" [schema] (or (+json-coercions+ schema) (keyword-enum-matcher schema) (set-matcher schema))) (def edn-read-string "Reads one object from a string. Returns nil when string is nil or empty" edn/read-string ) (def ^:no-doc +string-coercions+ (merge +json-coercions+ {s/Num (safe edn-read-string) s/Int (safe edn-read-string)} {s/Int (safe #(safe-long-cast (edn-read-string %))) Long (safe #(safe-long-cast (edn-read-string %))) Double (safe #(Double/parseDouble %))})) (defn string-coercion-matcher "A matcher that coerces keywords, keyword eq/enums, s/Num and s/Int, and long and doubles (JVM only) from strings." [schema] (or (+string-coercions+ schema) (keyword-enum-matcher schema) (set-matcher schema))) ;;;;;;;;;;;; This file autogenerated from src/cljx/schema/coerce.cljx prismatic-schema-clojure-1.1.6/src/clj/schema/core.clj000064400000000000000000001455251314115420600226410ustar00rootroot00000000000000(ns schema.core "A library for data shape definition and validation. A Schema is just Clojure data, which can be used to document and validate Clojure functions and data. For example, (def FooBar {:foo Keyword :bar [Number]}) ;; a schema (check FooBar {:foo :k :bar [1.0 2.0 3.0]}) ==> nil representing successful validation, but the following all return helpful errors describing how the provided data fails to measure up to schema FooBar's standards. (check FooBar {:bar [1.0 2.0 3.0]}) ==> {:foo missing-required-key} (check FooBar {:foo 1 :bar [1.0 2.0 3.0]}) ==> {:foo (not (keyword? 1))} (check FooBar {:foo :k :bar [1.0 2.0 3.0] :baz 1}) ==> {:baz disallowed-key} Schema lets you describe your leaf values using the Any, Keyword, Symbol, Number, String, and Int definitions below, or (in Clojure) you can use arbitrary Java classes or primitive casts to describe simple values. From there, you can build up schemas for complex types using Clojure syntax (map literals for maps, set literals for sets, vector literals for sequences, with details described below), plus helpers below that provide optional values, enumerations, arbitrary predicates, and more. Assuming you (:require [schema.core :as s :include-macros true]), Schema also provides macros for defining records with schematized elements (s/defrecord), and named or anonymous functions (s/fn and s/defn) with schematized inputs and return values. In addition to producing better-documented records and functions, these macros allow you to retrieve the schema associated with the defined record or function. Moreover, functions include optional *validation*, which will throw an error if the inputs or outputs do not match the provided schemas: (s/defrecord FooBar [foo :- Int bar :- String]) (s/defn quux :- Int [foobar :- Foobar mogrifier :- Number] (* mogrifier (+ (:foo foobar) (Long/parseLong (:bar foobar))))) (quux (FooBar. 10 \"5\") 2) ==> 30 (fn-schema quux) ==> (=> Int (record user.FooBar {:foo Int, :bar java.lang.String}) java.lang.Number) (s/with-fn-validation (quux (FooBar. 10.2 \"5\") 2)) ==> Input to quux does not match schema: [(named {:foo (not (integer? 10.2))} foobar) nil] As you can see, the preferred syntax for providing type hints to schema's defrecord, fn, and defn macros is to follow each element, argument, or function name with a :- schema. Symbols without schemas default to a schema of Any. In Clojure, class (e.g., clojure.lang.String) and primitive schemas (long, double) are also propagated to tag metadata to ensure you get the type hinting and primitive behavior you ask for. If you don't like this style, standard Clojure-style typehints are also supported: (fn-schema (s/fn [^String x])) ==> (=> Any java.lang.String) You can directly type hint a symbol as a class, primitive, or simple schema. See the docstrings of defrecord, fn, and defn for more details about how to use these macros." ;; don't exclude def because it's not a var. (:refer-clojure :exclude [Keyword Symbol Inst atom defrecord defn letfn defmethod fn MapEntry ->MapEntry]) (:require [clojure.pprint :as pprint] [clojure.string :as str] [schema.macros :as macros] [schema.utils :as utils] [schema.spec.core :as spec :include-macros true] [schema.spec.leaf :as leaf] [schema.spec.variant :as variant] [schema.spec.collection :as collection]) ) (def clj-1195-fixed? (do (defprotocol CLJ1195Check (dummy-method [this])) (try (eval '(extend-protocol CLJ1195Check nil (dummy-method [_]))) true (catch RuntimeException _ false)))) (when-not clj-1195-fixed? ;; don't exclude fn because of bug in extend-protocol (refer-clojure :exclude '[Keyword Symbol Inst atom defrecord defn letfn defmethod])) (set! *warn-on-reflection* true) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Schema protocol (defprotocol Schema (spec [this] "A spec is a record of some type that expresses the structure of this schema in a declarative and/or imperative way. See schema.spec.* for examples.") (explain [this] "Expand this schema to a human-readable format suitable for pprinting, also expanding class schematas at the leaves. Example: user> (s/explain {:a s/Keyword :b [s/Int]} ) {:a Keyword, :b [Int]}")) ;; Schemas print as their explains (do (clojure.core/defmethod print-method schema.core.Schema [s writer] (print-method (explain s) writer)) (clojure.core/defmethod pprint/simple-dispatch schema.core.Schema [s] (pprint/write-out (explain s))) (doseq [m [print-method pprint/simple-dispatch]] (prefer-method m schema.core.Schema clojure.lang.IRecord) (prefer-method m schema.core.Schema java.util.Map) (prefer-method m schema.core.Schema clojure.lang.IPersistentMap))) (clojure.core/defn checker "Compile an efficient checker for schema, which returns nil for valid values and error descriptions otherwise." [schema] (comp utils/error-val (spec/run-checker (clojure.core/fn [s params] (spec/checker (spec s) params)) false schema))) (clojure.core/defn check "Return nil if x matches schema; otherwise, returns a value that looks like the 'bad' parts of x with ValidationErrors at the leaves describing the failures. If you will be checking many datums, it is much more efficient to create a 'checker' once and call it on each of them." [schema x] ((checker schema) x)) (clojure.core/defn validator "Compile an efficient validator for schema." [schema] (let [c (checker schema)] (clojure.core/fn [value] (when-let [error (c value)] (macros/error! (utils/format* "Value does not match schema: %s" (pr-str error)) {:schema schema :value value :error error})) value))) (clojure.core/defn validate "Throw an exception if value does not satisfy schema; otherwise, return value. If you will be validating many datums, it is much more efficient to create a 'validator' once and call it on each of them." [schema value] ((validator schema) value)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Platform-specific leaf Schemas ;; On the JVM, a Class itself is a schema. In JS, we treat functions as prototypes so any ;; function prototype checks objects for compatibility. (clojure.core/defn instance-precondition [s klass] (spec/precondition s #(instance? klass %) #(list 'instance? klass %))) (extend-protocol Schema Class (spec [this] (let [pre (instance-precondition this this)] (if-let [class-schema (utils/class-schema this)] (variant/variant-spec pre [{:schema class-schema}]) (leaf/leaf-spec pre)))) (explain [this] (if-let [more-schema (utils/class-schema this)] (explain more-schema) (condp = this java.lang.String 'Str java.lang.Boolean 'Bool java.lang.Number 'Num java.util.regex.Pattern 'Regex java.util.Date 'Inst java.util.UUID 'Uuid (symbol (.getName ^Class this)) )))) ;; On the JVM, the primitive coercion functions (double, long, etc) ;; alias to the corresponding boxed number classes (do (defmacro extend-primitive [cast-sym class-sym] (let [qualified-cast-sym `(class @(resolve '~cast-sym))] `(extend-protocol Schema ~qualified-cast-sym (spec [this#] (variant/variant-spec spec/+no-precondition+ [{:schema ~class-sym}])) (explain [this#] '~cast-sym)))) (extend-primitive double Double) (extend-primitive float Float) (extend-primitive long Long) (extend-primitive int Integer) (extend-primitive short Short) (extend-primitive char Character) (extend-primitive byte Byte) (extend-primitive boolean Boolean) (extend-primitive doubles (Class/forName "[D")) (extend-primitive floats (Class/forName "[F")) (extend-primitive longs (Class/forName "[J")) (extend-primitive ints (Class/forName "[I")) (extend-primitive shorts (Class/forName "[S")) (extend-primitive chars (Class/forName "[C")) (extend-primitive bytes (Class/forName "[B")) (extend-primitive booleans (Class/forName "[Z"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Cross-platform Schema leaves ;;; Any matches anything (including nil) (clojure.core/defrecord AnythingSchema [_] ;; _ is to work around bug in Clojure where eval-ing defrecord with no fields ;; loses type info, which makes this unusable in schema-fn. ;; http://dev.clojure.org/jira/browse/CLJ-1093 Schema (spec [this] (leaf/leaf-spec spec/+no-precondition+)) (explain [this] 'Any)) (def Any "Any value, including nil." (AnythingSchema. nil)) ;;; eq (to a single allowed value) (clojure.core/defrecord EqSchema [v] Schema (spec [this] (leaf/leaf-spec (spec/precondition this #(= v %) #(list '= v %)))) (explain [this] (list 'eq v))) (clojure.core/defn eq "A value that must be (= v)." [v] (EqSchema. v)) ;;; isa (a child of parent) (clojure.core/defrecord Isa [h parent] Schema (spec [this] (leaf/leaf-spec (spec/precondition this #(if h (isa? h % parent) (isa? % parent)) #(list 'isa? % parent)))) (explain [this] (list 'isa? parent))) (clojure.core/defn isa "A value that must be a child of parent." ([parent] (Isa. nil parent)) ([h parent] (Isa. h parent))) ;;; enum (in a set of allowed values) (clojure.core/defrecord EnumSchema [vs] Schema (spec [this] (leaf/leaf-spec (spec/precondition this #(contains? vs %) #(list vs %)))) (explain [this] (cons 'enum vs))) (clojure.core/defn enum "A value that must be = to some element of vs." [& vs] (EnumSchema. (set vs))) ;;; pred (matches all values for which p? returns truthy) (clojure.core/defrecord Predicate [p? pred-name] Schema (spec [this] (leaf/leaf-spec (spec/precondition this p? #(list pred-name %)))) (explain [this] (cond (= p? integer?) 'Int (= p? keyword?) 'Keyword (= p? symbol?) 'Symbol (= p? string?) 'Str :else (list 'pred pred-name)))) (clojure.core/defn pred "A value for which p? returns true (and does not throw). Optional pred-name can be passed for nicer validation errors." ([p?] (pred p? (symbol (utils/fn-name p?)))) ([p? pred-name] (when-not (ifn? p?) (macros/error! (utils/format* "Not a function: %s" p?))) (Predicate. p? pred-name))) ;;; protocol (which value must `satisfies?`) (clojure.core/defn protocol-name [protocol] (-> protocol meta :proto-sym)) ;; In cljs, satisfies? is a macro so we must precompile (partial satisfies? p) ;; and put it in metadata of the record so that equality is preserved, along with the name. (clojure.core/defrecord Protocol [p] Schema (spec [this] (leaf/leaf-spec (spec/precondition this #((:proto-pred (meta this)) %) #(list 'satisfies? (protocol-name this) %)))) (explain [this] (list 'protocol (protocol-name this)))) ;; The cljs version is macros/protocol by necessity, since cljs `satisfies?` is a macro. (defmacro protocol "A value that must satsify? protocol p. Internaly, we must make sure not to capture the value of the protocol at schema creation time, since that's impossible in cljs and breaks later extends in Clojure. A macro for cljs sake, since `satisfies?` is a macro in cljs." [p] `(with-meta (->Protocol ~p) {:proto-pred #(satisfies? ~p %) :proto-sym '~p})) ;;; regex (validates matching Strings) (extend-protocol Schema java.util.regex.Pattern (spec [this] (leaf/leaf-spec (some-fn (spec/simple-precondition this string?) (spec/precondition this #(re-find this %) #(list 're-find (explain this) %))))) (explain [this] (symbol (str "#\"" this "\"")) )) ;;; Cross-platform Schemas for atomic value types (def Str "Satisfied only by String. Is (pred string?) and not js/String in cljs because of keywords." java.lang.String ) (def Bool "Boolean true or false" java.lang.Boolean ) (def Num "Any number" java.lang.Number ) (def Int "Any integral number" (pred integer?)) (def Keyword "A keyword" (pred keyword?)) (def Symbol "A symbol" (pred symbol?)) (def Regex "A regular expression" java.util.regex.Pattern ) (def Inst "The local representation of #inst ..." java.util.Date ) (def Uuid "The local representation of #uuid ..." java.util.UUID ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variant schemas (and other unit containers) ;;; maybe (nil) (clojure.core/defrecord Maybe [schema] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ [{:guard nil? :schema (eq nil)} {:schema schema}])) (explain [this] (list 'maybe (explain schema)))) (clojure.core/defn maybe "A value that must either be nil or satisfy schema" [schema] (Maybe. schema)) ;;; named (schema elements) (clojure.core/defrecord NamedSchema [schema name] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ [{:schema schema :wrap-error #(utils/->NamedError name %)}])) (explain [this] (list 'named (explain schema) name))) (clojure.core/defn named "A value that must satisfy schema, and has a name for documentation purposes." [schema name] (NamedSchema. schema name)) ;;; either (satisfies this schema or that one) (clojure.core/defrecord Either [schemas] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ (for [s schemas] {:guard (complement (checker s)) ;; since the guard determines which option we check against :schema s}) #(list 'some-matching-either-clause? %))) (explain [this] (cons 'either (map explain schemas)))) (clojure.core/defn ^{:deprecated "1.0.0"} either "A value that must satisfy at least one schema in schemas. Note that `either` does not work properly with coercion DEPRECATED: prefer `conditional` or `cond-pre` WARNING: either does not work with coercion. It is also slow and gives bad error messages. Please consider using `conditional` and friends instead; they are more efficient, provide better error messages, and work with coercion." [& schemas] (Either. schemas)) ;;; conditional (choice of schema, based on predicates on the value) (clojure.core/defrecord ConditionalSchema [preds-and-schemas error-symbol] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ (for [[p s] preds-and-schemas] {:guard p :schema s}) #(list (or error-symbol (if (= 1 (count preds-and-schemas)) (symbol (utils/fn-name (ffirst preds-and-schemas))) 'some-matching-condition?)) %))) (explain [this] (cons 'conditional (concat (mapcat (clojure.core/fn [[pred schema]] [(symbol (utils/fn-name pred)) (explain schema)]) preds-and-schemas) (when error-symbol [error-symbol]))))) (clojure.core/defn conditional "Define a conditional schema. Takes args like cond, (conditional pred1 schema1 pred2 schema2 ...), and checks the first schemaX where predX (an ordinary Clojure function that returns true or false) returns true on the value. Unlike cond, throws if the value does not match any condition. :else may be used as a final condition in the place of (constantly true). More efficient than either, since only one schema must be checked. An optional final argument can be passed, a symbol to appear in error messages when none of the conditions match." [& preds-and-schemas] (macros/assert! (and (seq preds-and-schemas) (or (even? (count preds-and-schemas)) (symbol? (last preds-and-schemas)))) "Expected even, nonzero number of args (with optional trailing symbol); got %s" (count preds-and-schemas)) (ConditionalSchema. (vec (for [[pred schema] (partition 2 preds-and-schemas)] (do (macros/assert! (ifn? pred) (str "Conditional predicate " pred " must be a function")) [(if (= pred :else) (constantly true) pred) schema]))) (if (odd? (count preds-and-schemas)) (last preds-and-schemas)))) ;; cond-pre (conditional based on surface type) (defprotocol HasPrecondition (precondition [this] "Return a predicate representing the Precondition for this schema: the predicate returns true if the precondition is satisfied. (See spec.core for more details)")) (extend-protocol HasPrecondition schema.spec.leaf.LeafSpec (precondition [this] (complement (.-pre ^schema.spec.leaf.LeafSpec this))) schema.spec.variant.VariantSpec (precondition [^schema.spec.variant.VariantSpec this] (every-pred (complement (.-pre this)) (apply some-fn (for [{:keys [guard schema]} (.-options this)] (if guard (every-pred guard (precondition (spec schema))) (precondition (spec schema))))))) schema.spec.collection.CollectionSpec (precondition [this] (complement (.-pre ^schema.spec.collection.CollectionSpec this)))) (clojure.core/defrecord CondPre [schemas] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ (for [s schemas] {:guard (precondition (spec s)) :schema s}) #(list 'matches-some-precondition? %))) (explain [this] (cons 'cond-pre (map explain schemas)))) (clojure.core/defn cond-pre "A replacement for `either` that constructs a conditional schema based on the schema spec preconditions of the component schemas. Given a datum, the preconditions for each schema (which typically check just the outermost class) are tested against the datum in turn. The first schema whose precondition matches is greedily selected, and the datum is validated against that schema. Unlike `either`, a validation failure is final (and there is no backtracking to try other schemas that might match). Thus, `cond-pre` is only suitable for schemas with mutually exclusive preconditions (e.g., s/Int and s/Str). If this doesn't hold (e.g. {:a s/Int} and {:b s/Str}), you must use `conditional` instead and provide an explicit condition for distinguishing the cases. EXPERIMENTAL" [& schemas] (CondPre. schemas)) ;; constrained (post-condition on schema) (clojure.core/defrecord Constrained [schema postcondition post-name] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ [{:schema schema}] nil (spec/precondition this postcondition #(list post-name %)))) (explain [this] (list 'constrained (explain schema) post-name))) (clojure.core/defn constrained "A schema with an additional post-condition. Differs from `conditional` with a single schema, in that the predicate checked *after* the main schema. This can lead to better error messages, and is often better suited for coercion." ([s p?] (constrained s p? (symbol (utils/fn-name p?)))) ([s p? pred-name] (when-not (ifn? p?) (macros/error! (utils/format* "Not a function: %s" p?))) (Constrained. s p? pred-name))) ;;; both (satisfies this schema and that one) (clojure.core/defrecord Both [schemas] Schema (spec [this] this) (explain [this] (cons 'both (map explain schemas))) HasPrecondition (precondition [this] (apply every-pred (map (comp precondition spec) schemas))) spec/CoreSpec (subschemas [this] schemas) (checker [this params] (reduce (clojure.core/fn [f t] (clojure.core/fn [x] (let [tx (t x)] (if (utils/error? tx) tx (f (or tx x)))))) (map #(spec/sub-checker {:schema %} params) (reverse schemas))))) (clojure.core/defn ^{:deprecated "1.0.0"} both "A value that must satisfy every schema in schemas. DEPRECATED: prefer 'conditional' with a single condition instead, or `constrained`. When used with coercion, coerces each schema in sequence." [& schemas] (Both. schemas)) (clojure.core/defn if "if the predicate returns truthy, use the if-schema, otherwise use the else-schema" [pred if-schema else-schema] (conditional pred if-schema (constantly true) else-schema)) ;;; Recursive schemas ;; Supports recursively defined schemas by using the level of indirection offered by by ;; Clojure and ClojureScript vars. (clojure.core/defn var-name [v] (let [{:keys [ns name]} (meta v)] (symbol (str (ns-name ns) "/" name)))) (clojure.core/defrecord Recursive [derefable] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ [{:schema @derefable}])) (explain [this] (list 'recursive (if (var? derefable) (list 'var (var-name derefable)) (format "%s@%x" (.getName (class derefable)) (System/identityHashCode derefable)) )))) (clojure.core/defn recursive "Support for (mutually) recursive schemas by passing a var that points to a schema, e.g (recursive #'ExampleRecursiveSchema)." [schema] (when-not (instance? clojure.lang.IDeref schema) (macros/error! (utils/format* "Not an IDeref: %s" schema))) (Recursive. schema)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Atom schema (defn- atom? [x] (instance? clojure.lang.Atom x) ) (clojure.core/defrecord Atomic [schema] Schema (spec [this] (collection/collection-spec (spec/simple-precondition this atom?) clojure.core/atom [(collection/one-element true schema (clojure.core/fn [item-fn coll] (item-fn @coll) nil))] (clojure.core/fn [_ xs _] (clojure.core/atom (first xs))))) (explain [this] (list 'atom (explain schema)))) (clojure.core/defn atom "An atom containing a value matching 'schema'." [schema] (->Atomic schema)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Map Schemas ;; A map schema is itself a Clojure map, which can provide value schemas for specific required ;; and optional keys, as well as a single, optional schema for additional key-value pairs. ;; Specific keys are mapped to value schemas, and given as either: ;; - (required-key k), a required key (= k) ;; - a keyword, also a required key ;; - (optional-key k), an optional key (= k) ;; For example, {:a Int (optional-key :b) String} describes a map with key :a mapping to an ;; integer, an optional key :b mapping to a String, and no other keys. ;; There can also be a single additional key, itself a schema, mapped to the schema for ;; corresponding values, which applies to all key-value pairs not covered by an explicit ;; key. ;; For example, {Int String} is a mapping from integers to strings, and ;; {:a Int Int String} is a mapping from :a to an integer, plus zero or more additional ;; mappings from integers to strings. ;;; Definitions for required and optional keys, and single entry validators (clojure.core/defrecord RequiredKey [k]) (clojure.core/defn required-key "A required key in a map" [k] (if (keyword? k) k (RequiredKey. k))) (clojure.core/defn required-key? [ks] (or (keyword? ks) (instance? RequiredKey ks))) (clojure.core/defrecord OptionalKey [k]) (clojure.core/defn optional-key "An optional key in a map" [k] (OptionalKey. k)) (clojure.core/defn optional-key? [ks] (instance? OptionalKey ks)) (clojure.core/defn explicit-schema-key [ks] (cond (keyword? ks) ks (instance? RequiredKey ks) (.-k ^RequiredKey ks) (optional-key? ks) (.-k ^OptionalKey ks) :else (macros/error! (utils/format* "Bad explicit key: %s" ks)))) (clojure.core/defn specific-key? [ks] (or (required-key? ks) (optional-key? ks))) (clojure.core/defn map-entry-ctor [[k v :as coll]] (clojure.lang.MapEntry. k v) ) ;; A schema for a single map entry. (clojure.core/defrecord MapEntry [key-schema val-schema] Schema (spec [this] (collection/collection-spec spec/+no-precondition+ map-entry-ctor [(collection/one-element true key-schema (clojure.core/fn [item-fn e] (item-fn (key e)) e)) (collection/one-element true val-schema (clojure.core/fn [item-fn e] (item-fn (val e)) nil))] (clojure.core/fn [[k] [xk xv] _] (if-let [k-err (utils/error-val xk)] [k-err 'invalid-key] [k (utils/error-val xv)])))) (explain [this] (list 'map-entry (explain key-schema) (explain val-schema)))) (clojure.core/defn map-entry [key-schema val-schema] (MapEntry. key-schema val-schema)) (clojure.core/defn find-extra-keys-schema [map-schema] (let [key-schemata (remove specific-key? (keys map-schema))] (macros/assert! (< (count key-schemata) 2) "More than one non-optional/required key schemata: %s" (vec key-schemata)) (first key-schemata))) (clojure.core/defn- explain-kspec [kspec] (if (specific-key? kspec) (if (keyword? kspec) kspec (list (cond (required-key? kspec) 'required-key (optional-key? kspec) 'optional-key) (explicit-schema-key kspec))) (explain kspec))) (defn- map-elements [this] (let [extra-keys-schema (find-extra-keys-schema this)] (let [duplicate-keys (->> (dissoc this extra-keys-schema) keys (group-by explicit-schema-key) vals (filter #(> (count %) 1)) (apply concat) (mapv explain-kspec))] (macros/assert! (empty? duplicate-keys) "Schema has multiple variants of the same explicit key: %s" duplicate-keys)) (concat (for [[k v] (dissoc this extra-keys-schema)] (let [rk (explicit-schema-key k) required? (required-key? k)] (collection/one-element required? (map-entry (eq rk) v) (clojure.core/fn [item-fn m] (let [e (find m rk)] (cond e (item-fn e) required? (item-fn (utils/error [rk 'missing-required-key]))) (if e (dissoc (if (instance? clojure.lang.PersistentStructMap m) (into {} m) m) rk) m)))))) (when extra-keys-schema [(collection/all-elements (apply map-entry (find this extra-keys-schema)))])))) (defn- map-error [] (clojure.core/fn [_ elts extra] (into {} (concat (keep utils/error-val elts) (for [[k _] extra] [k 'disallowed-key]))))) (defn- map-spec [this] (collection/collection-spec (spec/simple-precondition this map?) #(into {} %) (map-elements this) (map-error))) (clojure.core/defn- map-explain [this] (into {} (for [[k v] this] [(explain-kspec k) (explain v)]))) (extend-protocol Schema clojure.lang.APersistentMap (spec [this] (map-spec this)) (explain [this] (map-explain this)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Set schemas ;; A set schema is a Clojure set with a single element, a schema that all values must satisfy (extend-protocol Schema clojure.lang.APersistentSet (spec [this] (macros/assert! (= (count this) 1) "Set schema must have exactly one element") (collection/collection-spec (spec/simple-precondition this set?) set [(collection/all-elements (first this))] (clojure.core/fn [_ xs _] (set (keep utils/error-val xs))))) (explain [this] (set [(explain (first this))]))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Queue schemas ;; A queue schema is satisfied by PersistentQueues containing values that all satisfy ;; a specific sub-schema. (clojure.core/defn queue? [x] (instance? clojure.lang.PersistentQueue x)) (clojure.core/defn as-queue [col] (reduce conj clojure.lang.PersistentQueue/EMPTY col)) (clojure.core/defrecord Queue [schema] Schema (spec [this] (collection/collection-spec (spec/simple-precondition this queue?) as-queue [(collection/all-elements schema)] (clojure.core/fn [_ xs _] (as-queue (keep utils/error-val xs))))) (explain [this] (list 'queue (explain schema)))) (clojure.core/defn queue "Defines a schema satisfied by instances of clojure.lang.PersistentQueue (clj.core/PersistentQueue in ClojureScript) whose values satisfy x." [x] (Queue. x)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Sequence Schemas ;; A sequence schema looks like [one* optional* rest-schema?]. ;; one matches a single required element, and must be the output of 'one' below. ;; optional matches a single optional element, and must be the output of 'optional' below. ;; Finally, rest-schema is any schema, which must match any remaining elements. ;; (if optional elements are present, they must be matched before the rest-schema is applied). (clojure.core/defrecord One [schema optional? name]) (clojure.core/defn one "A single required element of a sequence (not repeated, the implicit default)" ([schema name] (One. schema false name))) (clojure.core/defn optional "A single optional element of a sequence (not repeated, the implicit default)" ([schema name] (One. schema true name))) (clojure.core/defn parse-sequence-schema [s] "Parses and validates a sequence schema, returning a vector in the form [singles multi] where singles is a sequence of 'one' and 'optional' schemas and multi is the rest-schema (which may be nil). A valid sequence schema is a vector in the form [one* optional* rest-schema?]." (let [[required more] (split-with #(and (instance? One %) (not (:optional? %))) s) [optional more] (split-with #(and (instance? One %) (:optional? %)) more)] (macros/assert! (and (<= (count more) 1) (every? #(not (instance? One %)) more)) "%s is not a valid sequence schema; %s%s%s" s "a valid sequence schema consists of zero or more `one` elements, " "followed by zero or more `optional` elements, followed by an optional " "schema that will match the remaining elements.") [(concat required optional) (first more)])) (extend-protocol Schema clojure.lang.APersistentVector (spec [this] (collection/collection-spec (spec/precondition this (clojure.core/fn [x] (or (nil? x) (sequential? x) (instance? java.util.List x))) #(list 'sequential? %)) vec (let [[singles multi] (parse-sequence-schema this)] (reduce (clojure.core/fn [more ^One s] (if-not (.-optional? s) (cons (collection/one-element true (named (.-schema s) (.-name s)) (clojure.core/fn [item-fn x] (if-let [x (seq x)] (do (item-fn (first x)) (rest x)) (do (item-fn (macros/validation-error (.-schema s) ::missing (list 'present? (.-name s)))) nil)))) more) [(collection/optional-tail (named (.-schema s) (.-name s)) (clojure.core/fn [item-fn x] (when-let [x (seq x)] (item-fn (first x)) (rest x))) more)])) (when multi [(collection/all-elements multi)]) (reverse singles))) (clojure.core/fn [_ elts extra] (let [head (mapv utils/error-val elts)] (if (seq extra) (conj head (utils/error-val (macros/validation-error nil extra (list 'has-extra-elts? (count extra))))) head))))) (explain [this] (let [[singles multi] (parse-sequence-schema this)] (vec (concat (for [^One s singles] (list (if (.-optional? s) 'optional 'one) (explain (:schema s)) (:name s))) (when multi [(explain multi)])))))) (clojure.core/defn pair "A schema for a pair of schemas and their names" [first-schema first-name second-schema second-name] [(one first-schema first-name) (one second-schema second-name)]) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Record Schemas ;; A Record schema describes a value that must have the correct type, and its body must ;; also satisfy a map schema. An optional :extra-validator-fn can also be attached to do ;; additional validation. (clojure.core/defrecord Record [klass schema] Schema (spec [this] (collection/collection-spec (let [p (spec/precondition this #(instance? klass %) #(list 'instance? klass %))] (if-let [evf (:extra-validator-fn this)] (some-fn p (spec/precondition this evf #(list 'passes-extra-validation? %))) p)) (:constructor (meta this)) (map-elements schema) (map-error))) (explain [this] (list 'record (symbol (.getName ^Class klass)) (explain schema)))) (clojure.core/defn record* [klass schema map-constructor] (macros/assert! (class? klass) "Expected record class, got %s" (utils/type-of klass)) (macros/assert! (map? schema) "Expected map, got %s" (utils/type-of schema)) (with-meta (Record. klass schema) {:constructor map-constructor})) (defmacro record "A Record instance of type klass, whose elements match map schema 'schema'. The final argument is the map constructor of the record type; if you do not pass one, an attempt is made to find the corresponding function (but this may fail in exotic circumstances)." ([klass schema] `(record ~klass ~schema (macros/if-cljs ~(let [bits (str/split (name klass) #"/")] (symbol (str/join "/" (concat (butlast bits) [(str "map->" (last bits))])))) #(~(symbol (str (name klass) "/create")) %)))) ([klass schema map-constructor] `(record* ~klass ~schema #(~map-constructor (into {} %))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Function Schemas ;; A function schema describes a function of one or more arities. ;; The function can only have a single output schema (across all arities), and each input ;; schema is a sequence schema describing the argument vector. ;; Currently function schemas are purely descriptive, and do not carry any validation logic. (clojure.core/defn explain-input-schema [input-schema] (let [[required more] (split-with #(instance? One %) input-schema)] (concat (map #(explain (.-schema ^One %)) required) (when (seq more) ['& (mapv explain more)])))) (clojure.core/defrecord FnSchema [output-schema input-schemas] ;; input-schemas sorted by arity Schema (spec [this] (leaf/leaf-spec (spec/simple-precondition this ifn?))) (explain [this] (if (> (count input-schemas) 1) (list* '=>* (explain output-schema) (map explain-input-schema input-schemas)) (list* '=> (explain output-schema) (explain-input-schema (first input-schemas)))))) (clojure.core/defn- arity [input-schema] (if (seq input-schema) (if (instance? One (last input-schema)) (count input-schema) Long/MAX_VALUE ) 0)) (clojure.core/defn make-fn-schema "A function outputting a value in output schema, whose argument vector must match one of input-schemas, each of which should be a sequence schema. Currently function schemas are purely descriptive; they validate against any function, regardless of actual input and output types." [output-schema input-schemas] (macros/assert! (seq input-schemas) "Function must have at least one input schema") (macros/assert! (every? vector? input-schemas) "Each arity must be a vector.") (macros/assert! (apply distinct? (map arity input-schemas)) "Arities must be distinct") (FnSchema. output-schema (sort-by arity input-schemas))) (defmacro =>* "Produce a function schema from an output schema and a list of arity input schema specs, each of which is a vector of argument schemas, ending with an optional '& more-schema' specification where more-schema must be a sequence schema. Currently function schemas are purely descriptive; there is no validation except for functions defined directly by s/fn or s/defn" [output-schema & arity-schema-specs] `(make-fn-schema ~output-schema ~(mapv macros/parse-arity-spec arity-schema-specs))) (defmacro => "Convenience macro for defining function schemas with a single arity; like =>*, but there is no vector around the argument schemas for this arity." [output-schema & arg-schemas] `(=>* ~output-schema ~(vec arg-schemas))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helpers for defining schemas (used in in-progress work, explanation coming soon) (clojure.core/defn schema-with-name "Records name in schema's metadata." [schema name] (vary-meta schema assoc :name name)) (clojure.core/defn schema-name "Returns the name of a schema attached via schema-with-name (or defschema)." [schema] (-> schema meta :name)) (clojure.core/defn schema-ns "Returns the namespace of a schema attached via defschema." [schema] (-> schema meta :ns)) (defmacro defschema "Convenience macro to make it clear to reader that body is meant to be used as a schema. The name of the schema is recorded in the metadata." ([name form] `(defschema ~name "" ~form)) ([name docstring form] `(def ~name ~docstring (vary-meta (schema-with-name ~form '~name) assoc :ns '~(ns-name *ns*))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Schematized defrecord and (de,let)fn macros (defmacro defrecord "Define a record with a schema. In addition to the ordinary behavior of defrecord, this macro produces a schema for the Record, which will automatically be used when validating instances of the Record class: (m/defrecord FooBar [foo :- Int bar :- String]) (schema.utils/class-schema FooBar) ==> (record user.FooBar {:foo Int, :bar java.lang.String}) (s/check FooBar (FooBar. 1.2 :not-a-string)) ==> {:foo (not (integer? 1.2)), :bar (not (instance? java.lang.String :not-a-string))} See (doc schema.core) for details of the :- syntax for record elements. Moreover, optional arguments extra-key-schema? and extra-validator-fn? can be passed to augment the record schema. - extra-key-schema is a map schema that defines validation for additional key-value pairs not in the record base (the default is to not allow extra mappings). - extra-validator-fn? is an additional predicate that will be used as part of validating the record value. The remaining opts+specs (i.e., protocol and interface implementations) are passed through directly to defrecord. Finally, this macro replaces Clojure's map->name constructor with one that is more than an order of magnitude faster (as of Clojure 1.5), and provides a new strict-map->name constructor that throws or drops extra keys not in the record base." {:arglists '([name field-schema extra-key-schema? extra-validator-fn? & opts+specs])} [name field-schema & more-args] (apply macros/emit-defrecord 'clojure.core/defrecord &env name field-schema more-args)) (defmacro defrecord+ "DEPRECATED -- canonical version moved to schema.potemkin Like defrecord, but emits a record using potemkin/defrecord+. You must provide your own dependency on potemkin to use this." {:arglists '([name field-schema extra-key-schema? extra-validator-fn? & opts+specs])} [name field-schema & more-args] (apply macros/emit-defrecord 'potemkin/defrecord+ &env name field-schema more-args)) (defmacro set-compile-fn-validation! [on?] (macros/set-compile-fn-validation! on?) nil) (clojure.core/defn fn-validation? "Get the current global schema validation setting." [] (.get ^java.util.concurrent.atomic.AtomicReference utils/use-fn-validation) ) (clojure.core/defn set-fn-validation! "Globally turn on (or off) schema validation for all s/fn and s/defn instances." [on?] (.set ^java.util.concurrent.atomic.AtomicReference utils/use-fn-validation on?) ) (defmacro with-fn-validation "Execute body with input and output schema validation turned on for all s/defn and s/fn instances globally (across all threads). After all forms have been executed, resets function validation to its previously set value. Not concurrency-safe." [& body] `(let [body# (fn [] ~@body)] (if (fn-validation?) (body#) (do (set-fn-validation! true) (try (body#) (finally (set-fn-validation! false))))))) (defmacro without-fn-validation "Execute body with input and output schema validation turned off for all s/defn and s/fn instances globally (across all threads). After all forms have been executed, resets function validation to its previously set value. Not concurrency-safe." [& body] `(let [body# (fn [] ~@body)] (if (fn-validation?) (do (set-fn-validation! false) (try (body#) (finally (set-fn-validation! true)))) (body#)))) (def fn-validator "A var that can be rebound to a function to customize the behavior of fn validation. When fn validation is on and `fn-validator` is bound to a function, normal argument and return value checks will be substituted with a call to this function with five arguments: direction - :input or :output fn-name - a symbol, the function's name schema - the schema for the arglist or the return value checker - a precompiled checker to check a value against the schema value - the actual arglist or return value The function's return value will be ignored." nil) (clojure.core/defn schematize-fn "Attach the schema to fn f at runtime, extractable by fn-schema." [f schema] (vary-meta f assoc :schema schema)) (clojure.core/defn ^FnSchema fn-schema "Produce the schema for a function defined with s/fn or s/defn." [f] (macros/assert! (fn? f) "Non-function %s" (utils/type-of f)) (or (utils/class-schema (utils/fn-schema-bearer f)) (macros/safe-get (meta f) :schema))) ;; work around bug in extend-protocol (refers to bare 'fn, so we can't exclude it). (when-not clj-1195-fixed? (ns-unmap *ns* 'fn)) (defmacro fn "s/fn : s/defn :: clojure.core/fn : clojure.core/defn See (doc s/defn) for details. Additional gotchas and limitations: - Like s/defn, the output schema must go on the fn name. If you don't supply a name, schema will gensym one for you and attach the schema. - Unlike s/defn, the function schema is stored in metadata on the fn. Clojure's implementation for metadata on fns currently produces a wrapper fn, which will decrease performance and negate the benefits of primitive type hints compared to clojure.core/fn." [& fn-args] (let [fn-args (if (symbol? (first fn-args)) fn-args (cons (gensym "fn") fn-args)) [name more-fn-args] (macros/extract-arrow-schematized-element &env fn-args) {:keys [outer-bindings schema-form fn-body]} (macros/process-fn- &env name more-fn-args)] `(let ~outer-bindings (schematize-fn ~(vary-meta `(clojure.core/fn ~name ~@fn-body) #(merge (meta &form) %)) ~schema-form)))) (defmacro defn "Like clojure.core/defn, except that schema-style typehints can be given on the argument symbols and on the function name (for the return value). You can call s/fn-schema on the defined function to get its schema back, or use with-fn-validation to enable runtime checking of function inputs and outputs. (s/defn foo :- s/Num [x :- s/Int y :- s/Num] (* x y)) (s/fn-schema foo) ==> (=> java.lang.Number Int java.lang.Number) (s/with-fn-validation (foo 1 2)) ==> 2 (s/with-fn-validation (foo 1.5 2)) ==> Input to foo does not match schema: [(named (not (integer? 1.5)) x) nil] See (doc schema.core) for details of the :- syntax for arguments and return schemas. The overhead for checking if run-time validation should be used is very small -- about 5% of a very small fn call. On top of that, actual validation costs what it costs. You can also turn on validation unconditionally for this fn only by putting ^:always-validate metadata on the fn name. Gotchas and limitations: - The output schema always goes on the fn name, not the arg vector. This means that all arities must share the same output schema. Schema will automatically propagate primitive hints to the arg vector and class hints to the fn name, so that you get the behavior you expect from Clojure. - All primitive schemas will be passed through as type hints to Clojure, despite their legality in a particular position. E.g., (s/defn foo [x :- int]) will fail because Clojure does not allow primitive ints as fn arguments; in such cases, use the boxed Classes instead (e.g., Integer). - Schema metadata is only processed on top-level arguments. I.e., you can use destructuring, but you must put schema metadata on the top-level arguments, not the destructured variables. Bad: (s/defn foo [{:keys [x :- s/Int]}]) Good: (s/defn foo [{:keys [x]} :- {:x s/Int}]) - Only a specific subset of rest-arg destructuring is supported: - & rest works as expected - & [a b] works, with schemas for individual elements parsed out of the binding, or an overall schema on the vector - & {} is not supported. - Unlike clojure.core/defn, a final attr-map on multi-arity functions is not supported." [& defn-args] (let [[name & more-defn-args] (macros/normalized-defn-args &env defn-args) {:keys [doc tag] :as standard-meta} (meta name) {:keys [outer-bindings schema-form fn-body arglists raw-arglists]} (macros/process-fn- &env name more-defn-args)] `(let ~outer-bindings (let [ret# (clojure.core/defn ~(with-meta name {}) ~(assoc (apply dissoc standard-meta (when (macros/primitive-sym? tag) [:tag])) :doc (str (str "Inputs: " (if (= 1 (count raw-arglists)) (first raw-arglists) (apply list raw-arglists))) (when-let [ret (when (= (second defn-args) :-) (nth defn-args 2))] (str "\n Returns: " ret)) (when doc (str "\n\n " doc))) :raw-arglists (list 'quote raw-arglists) :arglists (list 'quote arglists) :schema schema-form) ~@fn-body)] (utils/declare-class-schema! (utils/fn-schema-bearer ~name) ~schema-form) ret#)))) (defmacro defmethod "Like clojure.core/defmethod, except that schema-style typehints can be given on the argument symbols and after the dispatch-val (for the return value). See (doc s/defn) for details. Examples: (s/defmethod mymultifun :a-dispatch-value :- s/Num [x :- s/Int y :- s/Num] (* x y)) ;; You can also use meta tags like ^:always-validate by placing them ;; before the multifunction name: (s/defmethod ^:always-validate mymultifun :a-dispatch-value [x y] (* x y))" [multifn dispatch-val & fn-tail] `(macros/if-cljs (cljs.core/-add-method ~(with-meta multifn {:tag 'cljs.core/MultiFn}) ~dispatch-val (fn ~(with-meta (gensym) (meta multifn)) ~@fn-tail)) (. ~(with-meta multifn {:tag 'clojure.lang.MultiFn}) addMethod ~dispatch-val (fn ~(with-meta (gensym) (meta multifn)) ~@fn-tail)))) (defmacro letfn "s/letfn : s/fn :: clojure.core/letfn : clojure.core/fn" [fnspecs & body] (list `let (vec (interleave (map first fnspecs) (map #(cons `fn %) fnspecs))) `(do ~@body))) (defmacro def "Like def, but takes a schema on the var name (with the same format as the output schema of s/defn), requires an initial value, and asserts that the initial value matches the schema on the var name (regardless of the status of with-fn-validation). Due to limitations of add-watch!, cannot enforce validation of subsequent rebindings of var. Throws at compile-time for clj, and client-side load-time for cljs. Example: (s/def foo :- long \"a long\" 2)" [& def-args] (let [[name more-def-args] (macros/extract-arrow-schematized-element &env def-args) [doc-string? more-def-args] (if (= (count more-def-args) 2) (macros/maybe-split-first string? more-def-args) [nil more-def-args]) init (first more-def-args)] (macros/assert! (= 1 (count more-def-args)) "Illegal args passed to schema def: %s" def-args) `(let [output-schema# ~(macros/extract-schema-form name)] (def ~name ~@(when doc-string? [doc-string?]) (validate output-schema# ~init))))) (set! *warn-on-reflection* false) (clojure.core/defn set-max-value-length! "Sets the maximum length of value to be output before it is contracted to a prettier name." [max-length] (reset! utils/max-value-length max-length)) ;;;;;;;;;;;; This file autogenerated from src/cljx/schema/core.cljx prismatic-schema-clojure-1.1.6/src/clj/schema/experimental/000075500000000000000000000000001314115420600237005ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/src/clj/schema/experimental/abstract_map.clj000064400000000000000000000055371314115420600270440ustar00rootroot00000000000000(ns schema.experimental.abstract-map "Schemas representing abstract classes and subclasses" (:require [clojure.string :as str] [schema.core :as s :include-macros true] [schema.spec.core :as spec] [schema.spec.variant :as variant])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Private: helpers (defprotocol PExtensibleSchema (extend-schema! [this extension schema-name dispatch-values])) ;; a "subclass" (defrecord SchemaExtension [schema-name base-schema extended-schema explain-value] s/Schema (spec [this] (variant/variant-spec spec/+no-precondition+ [{:schema extended-schema}])) (explain [this] (list 'extend-schema schema-name (s/schema-name base-schema) (s/explain explain-value)))) ;; an "abstract class" (defrecord AbstractSchema [sub-schemas dispatch-key schema open?] s/Schema (spec [this] (variant/variant-spec spec/+no-precondition+ (concat (for [[k s] @sub-schemas] {:guard #(= (keyword (dispatch-key %)) (keyword k)) :schema s}) (when open? [{:schema (assoc schema dispatch-key s/Keyword s/Any s/Any)}])) (fn [v] (list (set (keys @sub-schemas)) (list dispatch-key v))))) (explain [this] (list 'abstract-map-schema dispatch-key (s/explain schema) (set (keys @sub-schemas)))) PExtensibleSchema (extend-schema! [this extension schema-name dispatch-values] (let [sub-schema (assoc (merge schema extension) dispatch-key (apply s/enum dispatch-values)) ext-schema (s/schema-with-name (SchemaExtension. schema-name this sub-schema extension) (name schema-name))] (swap! sub-schemas merge (into {} (for [k dispatch-values] [k ext-schema]))) ext-schema))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Public (s/defn abstract-map-schema "A schema representing an 'abstract class' map that must match at least one concrete subtype (indicated by the value of dispatch-key, a keyword). Add subtypes by calling `extend-schema`." [dispatch-key :- s/Keyword schema :- (s/pred map?)] (AbstractSchema. (atom {}) dispatch-key schema false)) (s/defn open-abstract-map-schema "Like abstract-map-schema, but allows unknown types to validate (for, e.g. forward compatibility)." [dispatch-key :- s/Keyword schema :- (s/pred map?)] (AbstractSchema. (atom {}) dispatch-key schema true)) (defmacro extend-schema [schema-name extensible-schema dispatch-values extension] `(def ~schema-name (extend-schema! ~extensible-schema ~extension '~schema-name ~dispatch-values))) (defn sub-schemas [abstract-schema] @(.-sub-schemas ^AbstractSchema abstract-schema)) ;;;;;;;;;;;; This file autogenerated from src/cljx/schema/experimental/abstract_map.cljx prismatic-schema-clojure-1.1.6/src/clj/schema/experimental/complete.clj000064400000000000000000000072311314115420600262050ustar00rootroot00000000000000(ns schema.experimental.complete "(Extremely) experimental support for 'completing' partial datums to match a schema. To use it, you must provide your own test.check dependency." {:deprecated "1.1.0"} (:require [clojure.test.check.generators :as check-generators] [schema.spec.core :as spec] schema.spec.collection schema.spec.leaf schema.spec.variant [schema.coerce :as coerce] [schema.core :as s] [schema.macros :as macros] [schema.utils :as utils] [schema.experimental.generators :as generators])) (def +missing+ ::missing) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Private helpers (defprotocol Completer (completer* [spec s sub-checker generator-opts] "A function applied to a datum as part of coercion to complete missing fields.")) (defn sample [g] (check-generators/generate g 10)) (extend-protocol Completer schema.spec.variant.VariantSpec (completer* [spec s sub-checker generator-opts] (let [g (apply generators/generator s generator-opts)] (if (and (class? s) (isa? s clojure.lang.IRecord) (utils/class-schema s)) (fn record-completer [x] (sub-checker (into (sample g) x))) (fn variant-completer [x] (if (= +missing+ x) (sample g) (sub-checker x)))))) schema.spec.collection.CollectionSpec (completer* [spec s sub-checker generator-opts] (if (instance? clojure.lang.APersistentMap s) ;; todo: pluggable (let [g (apply generators/generator s generator-opts)] (fn map-completer [x] (if (= +missing+ x) (sample g) ;; for now, just do required keys when user provides input. (let [ks (distinct (concat (keys x) (->> s keys (filter s/required-key?) (map s/explicit-schema-key))))] (sub-checker (into {} (for [k ks] [k (get x k +missing+)]))))))) (let [g (apply generators/generator s generator-opts)] (fn coll-completer [x] (if (= +missing+ x) (sample g) (sub-checker x)))))) schema.spec.leaf.LeafSpec (completer* [spec s sub-checker generator-opts] (let [g (apply generators/generator s generator-opts)] (fn leaf-completer [x] (if (= +missing+ x) (sample g) x))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Public (s/defn completer "Produce a function that simultaneously coerces, completes, and validates a datum." ([schema] (completer schema {})) ([schema coercion-matcher] (completer schema coercion-matcher {})) ([schema coercion-matcher leaf-generators] (completer schema coercion-matcher leaf-generators {})) ([schema coercion-matcher :- coerce/CoercionMatcher leaf-generators :- generators/LeafGenerators wrappers :- generators/GeneratorWrappers] (spec/run-checker (fn [s params] (let [c (spec/checker (s/spec s) params) coercer (or (coercion-matcher s) identity) completr (completer* (s/spec s) s c [leaf-generators wrappers])] (fn [x] (macros/try-catchall (let [v (coercer x)] (if (utils/error? v) v (completr v))) (catch t (macros/validation-error s x t)))))) true schema))) (defn complete "Fill in partial-datum to make it validate schema." [partial-datum & completer-args] ((apply completer completer-args) partial-datum)) prismatic-schema-clojure-1.1.6/src/clj/schema/experimental/generators.clj000064400000000000000000000163161314115420600265520ustar00rootroot00000000000000(ns schema.experimental.generators "(Very) experimental support for compiling schemas to test.check generators. To use it, you must provide your own test.check dependency. TODO: add cljs support." {:deprecated "1.1.0"} (:require [clojure.test.check.generators :as generators] [schema.spec.core :as spec] schema.spec.collection schema.spec.leaf schema.spec.variant [schema.core :as s] [schema.macros :as macros])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Private helpers for composite schemas (defn g-by [f & args] (generators/fmap (partial apply f) (apply generators/tuple args))) (defn g-apply-by [f args] (generators/fmap f (apply generators/tuple args))) (defn- sub-generator [{:keys [schema]} {:keys [subschema-generator ^java.util.Map cache] :as params}] (spec/with-cache cache schema (fn [d] (#'generators/make-gen (fn [r s] (generators/call-gen @d r (quot s 2))))) (fn [] (subschema-generator schema params)))) ;; Helpers for collections (declare elements-generator) (defn element-generator [e params] (if (vector? e) (case (first e) ::schema.spec.collection/optional (generators/one-of [(generators/return nil) (elements-generator (next e) params)]) ::schema.spec.collection/remaining (do (macros/assert! (= 2 (count e)) "remaining can have only one schema.") (generators/vector (sub-generator (second e) params)))) (generators/fmap vector (sub-generator e params)))) (defn elements-generator [elts params] (->> elts (map #(element-generator % params)) (apply generators/tuple) (generators/fmap (partial apply concat)))) (defprotocol CompositeGenerator (composite-generator [s params])) (extend-protocol CompositeGenerator schema.spec.variant.VariantSpec (composite-generator [s params] (generators/such-that (fn [x] (let [pre (.-pre ^schema.spec.variant.VariantSpec s) post (.-post ^schema.spec.variant.VariantSpec s)] (not (or (pre x) (and post (post x)))))) (generators/one-of (for [o (macros/safe-get s :options)] (if-let [g (:guard o)] (generators/such-that g (sub-generator o params)) (sub-generator o params)))))) ;; TODO: this does not currently capture proper semantics of maps with ;; both specific keys and key schemas that can override them. schema.spec.collection.CollectionSpec (composite-generator [s params] (generators/such-that (complement (.-pre ^schema.spec.collection.CollectionSpec s)) (generators/fmap (:constructor s) (elements-generator (:elements s) params)))) schema.spec.leaf.LeafSpec (composite-generator [s params] (macros/assert! false "You must provide a leaf generator for %s" s))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Public (def Schema "A Schema for Schemas" (s/protocol s/Schema)) (def Generator "A test.check generator" s/Any) (def LeafGenerators "A mapping from schemas to generating functions that should be used." (s/=> (s/maybe Generator) Schema)) (def +primitive-generators+ {Double generators/double ;; using unchecked-float here will unfortunately generate a lot of ;; infinities, since lots of doubles are out of the float range Float (generators/fmap unchecked-float generators/double) Long generators/large-integer Integer (generators/fmap unchecked-int generators/large-integer) Short (generators/fmap unchecked-short generators/large-integer) Character (generators/fmap unchecked-char generators/large-integer) Byte (generators/fmap unchecked-byte generators/large-integer) Boolean generators/boolean}) (def +simple-leaf-generators+ (merge +primitive-generators+ {s/Str generators/string-ascii s/Bool generators/boolean s/Num (generators/one-of [generators/large-integer generators/double]) s/Int (generators/one-of [generators/large-integer (generators/fmap unchecked-int generators/large-integer) (generators/fmap bigint generators/large-integer)]) s/Keyword generators/keyword clojure.lang.Keyword generators/keyword s/Symbol (generators/fmap (comp symbol name) generators/keyword) Object generators/any s/Any generators/any s/Uuid generators/uuid s/Inst (generators/fmap (fn [ms] (java.util.Date. ms)) generators/int)} (into {} (for [[f ctor c] [[doubles double-array Double] [floats float-array Float] [longs long-array Long] [ints int-array Integer] [shorts short-array Short] [chars char-array Character] [bytes byte-array Byte] [booleans boolean-array Boolean]]] [f (generators/fmap ctor (generators/vector (macros/safe-get +primitive-generators+ c)))])))) (defn eq-generators [s] (when (instance? schema.core.EqSchema s) (generators/return (.-v ^schema.core.EqSchema s)))) (defn enum-generators [s] (when (instance? schema.core.EnumSchema s) (let [vs (vec (.-vs ^schema.core.EqSchema s))] (generators/fmap #(nth vs %) (generators/choose 0 (dec (count vs))))))) (defn default-leaf-generators [leaf-generators] (some-fn leaf-generators +simple-leaf-generators+ eq-generators enum-generators)) (defn always [x] (generators/return x)) (def GeneratorWrappers "A mapping from schemas to wrappers that should be used around the default generators." (s/=> (s/maybe (s/=> Generator Generator)) Schema)) (defn such-that "Helper wrapper that filters to values that match predicate." [f] (partial generators/such-that f)) (defn fmap "Helper wrapper that maps f over all values." [f] (partial generators/fmap f)) (defn merged "Helper wrapper that merges some keys into a schema" [m] (fmap #(merge % m))) (s/defn generator :- Generator "Produce a test.check generator for schema. leaf-generators must return generators for all leaf schemas, and can also return generators for non-leaf schemas to override default generation logic. constraints is an optional mapping from schema to wrappers for the default generators, which can impose constraints, fix certain values, etc." ([schema] (generator schema {})) ([schema leaf-generators] (generator schema leaf-generators {})) ([schema :- Schema leaf-generators :- LeafGenerators wrappers :- GeneratorWrappers] (let [leaf-generators (default-leaf-generators leaf-generators) gen (fn [s params] ((or (wrappers s) identity) (or (leaf-generators s) (composite-generator (s/spec s) params))))] (generators/fmap (s/validator schema) (gen schema {:subschema-generator gen :cache (java.util.IdentityHashMap.)}))))) (s/defn sample :- [s/Any] "Sample k elements from generator." [k & generator-args] (generators/sample (apply generator generator-args) k)) (s/defn generate "Sample a single element of low to moderate size." [& generator-args] (generators/generate (apply generator generator-args) 10)) prismatic-schema-clojure-1.1.6/src/clj/schema/macros.clj000064400000000000000000000427031314115420600231670ustar00rootroot00000000000000(ns schema.macros "Macros and macro helpers used in schema.core." (:require [clojure.string :as str] [schema.utils :as utils])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helpers used in schema.core. (defn cljs-env? "Take the &env from a macro, and tell whether we are expanding into cljs." [env] (boolean (:ns env))) (defmacro if-cljs "Return then if we are generating cljs code and else for Clojure code. https://groups.google.com/d/msg/clojurescript/iBY5HaQda4A/w1lAQi9_AwsJ" [then else] (if (cljs-env? &env) then else)) (defmacro try-catchall "A cross-platform variant of try-catch that catches all exceptions. Does not (yet) support finally, and does not need or want an exception class." [& body] (let [try-body (butlast body) [catch sym & catch-body :as catch-form] (last body)] (assert (= catch 'catch)) (assert (symbol? sym)) `(if-cljs (try ~@try-body (~'catch js/Object ~sym ~@catch-body)) (try ~@try-body (~'catch Throwable ~sym ~@catch-body))))) (defmacro error! "Generate a cross-platform exception appropriate to the macroexpansion context" ([s] `(if-cljs (throw (js/Error. ~s)) (throw (RuntimeException. ~(with-meta s `{:tag java.lang.String}))))) ([s m] (let [m (merge {:type :schema.core/error} m)] `(if-cljs (throw (ex-info ~s ~m)) (throw (clojure.lang.ExceptionInfo. ~(with-meta s `{:tag java.lang.String}) ~m)))))) (defmacro safe-get "Like get but throw an exception if not found. A macro just to work around cljx function placement restrictions. " [m k] `(let [m# ~m k# ~k] (if-let [pair# (find m# k#)] (val pair#) (error! (utils/format* "Key %s not found in %s" k# m#))))) (defmacro assert! "Like assert, but throws a RuntimeException (in Clojure) and takes args to format." [form & format-args] `(when-not ~form (error! (utils/format* ~@format-args)))) (defmacro validation-error [schema value expectation & [fail-explanation]] `(schema.utils/error (utils/make-ValidationError ~schema ~value (delay ~expectation) ~fail-explanation))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helpers for processing and normalizing element/argument schemas in s/defrecord and s/(de)fn (defn maybe-split-first [pred s] (if (pred (first s)) [(first s) (next s)] [nil s])) (def primitive-sym? '#{float double boolean byte char short int long floats doubles booleans bytes chars shorts ints longs objects}) (defn valid-tag? [env tag] (and (symbol? tag) (or (primitive-sym? tag) (class? (resolve env tag))))) (defn normalized-metadata "Take an object with optional metadata, which may include a :tag, plus an optional explicit schema, and normalize the object to have a valid Clojure :tag plus a :schema field." [env imeta explicit-schema] (let [{:keys [tag s s? schema]} (meta imeta)] (assert! (not (or s s?)) "^{:s schema} style schemas are no longer supported.") (assert! (< (count (remove nil? [schema explicit-schema])) 2) "Expected single schema, got meta %s, explicit %s" (meta imeta) explicit-schema) (let [schema (or explicit-schema schema tag `schema.core/Any)] (with-meta imeta (-> (or (meta imeta) {}) (dissoc :tag) (utils/assoc-when :schema schema :tag (let [t (or tag schema)] (when (valid-tag? env t) t)))))))) (defn extract-schema-form "Pull out the schema stored on a thing. Public only because of its use in a public macro." [symbol] (let [s (:schema (meta symbol))] (assert! s "%s is missing a schema" symbol) s)) (defn extract-arrow-schematized-element "Take a nonempty seq, which may start like [a ...] or [a :- schema ...], and return a list of [first-element-with-schema-attached rest-elements]" [env s] (assert (seq s)) (let [[f & more] s] (if (= :- (first more)) [(normalized-metadata env f (second more)) (drop 2 more)] [(normalized-metadata env f nil) more]))) (defn process-arrow-schematized-args "Take an arg vector, in which each argument is followed by an optional :- schema, and transform into an ordinary arg vector where the schemas are metadata on the args." [env args] (loop [in args out []] (if (empty? in) out (let [[arg more] (extract-arrow-schematized-element env in)] (recur more (conj out arg)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helpers for schematized fn/defn (defn split-rest-arg [env bind] (let [[pre-& [_ rest-arg :as post-&]] (split-with #(not= % '&) bind)] (if (seq post-&) (do (assert! (= (count post-&) 2) "& must be followed by a single binding" (vec post-&)) (assert! (or (symbol? rest-arg) (and (vector? rest-arg) (not-any? #{'&} rest-arg))) "Bad & binding form: currently only bare symbols and vectors supported" (vec post-&)) [(vec pre-&) (if (vector? rest-arg) (with-meta (process-arrow-schematized-args env rest-arg) (meta rest-arg)) rest-arg)]) [bind nil]))) (defn single-arg-schema-form [rest? [index arg]] `(~(if rest? `schema.core/optional `schema.core/one) ~(extract-schema-form arg) ~(if (symbol? arg) `'~arg `'~(symbol (str (if rest? "rest" "arg") index))))) (defn simple-arglist-schema-form [rest? regular-args] (mapv (partial single-arg-schema-form rest?) (map-indexed vector regular-args))) (defn rest-arg-schema-form [arg] (let [s (extract-schema-form arg)] (if (= s `schema.core/Any) (if (vector? arg) (simple-arglist-schema-form true arg) [`schema.core/Any]) (do (assert! (vector? s) "Expected seq schema for rest args, got %s" s) s)))) (defn input-schema-form [regular-args rest-arg] (let [base (simple-arglist-schema-form false regular-args)] (if rest-arg (vec (concat base (rest-arg-schema-form rest-arg))) base))) (defn apply-prepost-conditions "Replicate pre/postcondition logic from clojure.core/fn." [body] (let [[conds body] (maybe-split-first #(and (map? %) (next body)) body)] (concat (map (fn [c] `(assert ~c)) (:pre conds)) (if-let [post (:post conds)] `((let [~'% (do ~@body)] ~@(map (fn [c] `(assert ~c)) post) ~'%)) body)))) (def ^:dynamic *compile-fn-validation* (atom true)) (defn compile-fn-validation? "Returns true if validation should be included at compile time, otherwise false. Validation is elided for any of the following cases: * function has :never-validate metadata * *compile-fn-validation* is false * *assert* is false AND function is not :always-validate" [env fn-name] (let [fn-meta (meta fn-name)] (and @*compile-fn-validation* (not (:never-validate fn-meta)) (or (:always-validate fn-meta) *assert*)))) (defn process-fn-arity "Process a single (bind & body) form, producing an output tag, schema-form, and arity-form which has asserts for validation purposes added that are executed when turned on, and have very low overhead otherwise. tag? is a prospective tag for the fn symbol based on the output schema. schema-bindings are bindings to lift eval outwards, so we don't build the schema every time we do the validation." [env fn-name output-schema-sym bind-meta [bind & body]] (assert! (vector? bind) "Got non-vector binding form %s" bind) (when-let [bad-meta (seq (filter (or (meta bind) {}) [:tag :s? :s :schema]))] (throw (RuntimeException. (str "Meta not supported on bindings, put on fn name" (vec bad-meta))))) (let [original-arglist bind bind (with-meta (process-arrow-schematized-args env bind) bind-meta) [regular-args rest-arg] (split-rest-arg env bind) input-schema-sym (gensym "input-schema") input-checker-sym (gensym "input-checker") output-checker-sym (gensym "output-checker") compile-validation (compile-fn-validation? env fn-name)] {:schema-binding [input-schema-sym (input-schema-form regular-args rest-arg)] :more-bindings (when compile-validation [input-checker-sym `(delay (schema.core/checker ~input-schema-sym)) output-checker-sym `(delay (schema.core/checker ~output-schema-sym))]) :arglist bind :raw-arglist original-arglist :arity-form (if compile-validation (let [bind-syms (vec (repeatedly (count regular-args) gensym)) rest-sym (when rest-arg (gensym "rest")) metad-bind-syms (with-meta (mapv #(with-meta %1 (meta %2)) bind-syms bind) bind-meta)] (list (if rest-arg (into metad-bind-syms ['& rest-sym]) metad-bind-syms) `(let [validate# ~(if (:always-validate (meta fn-name)) `true `(if-cljs (deref ~'ufv__) (.get ~'ufv__)))] (when validate# (let [args# ~(if rest-arg `(list* ~@bind-syms ~rest-sym) bind-syms)] (if schema.core/fn-validator (schema.core/fn-validator :input '~fn-name ~input-schema-sym @~input-checker-sym args#) (when-let [error# (@~input-checker-sym args#)] (error! (utils/format* "Input to %s does not match schema: \n\n\t \033[0;33m %s \033[0m \n\n" '~fn-name (pr-str error#)) {:schema ~input-schema-sym :value args# :error error#}))))) (let [o# (loop ~(into (vec (interleave (map #(with-meta % {}) bind) bind-syms)) (when rest-arg [rest-arg rest-sym])) ~@(apply-prepost-conditions body))] (when validate# (if schema.core/fn-validator (schema.core/fn-validator :output '~fn-name ~output-schema-sym @~output-checker-sym o#) (when-let [error# (@~output-checker-sym o#)] (error! (utils/format* "Output of %s does not match schema: \n\n\t \033[0;33m %s \033[0m \n\n" '~fn-name (pr-str error#)) {:schema ~output-schema-sym :value o# :error error#})))) o#)))) (cons (into regular-args (when rest-arg ['& rest-arg])) body))})) (defn process-fn- "Process the fn args into a final tag proposal, schema form, schema bindings, and fn form" [env name fn-body] (let [compile-validation (compile-fn-validation? env name) output-schema (extract-schema-form name) output-schema-sym (gensym "output-schema") bind-meta (or (when-let [t (:tag (meta name))] (when (primitive-sym? t) {:tag t})) {}) processed-arities (map (partial process-fn-arity env name output-schema-sym bind-meta) (if (vector? (first fn-body)) [fn-body] fn-body)) schema-bindings (map :schema-binding processed-arities) fn-forms (map :arity-form processed-arities)] {:outer-bindings (vec (concat (when compile-validation `[~(with-meta 'ufv__ {:tag 'java.util.concurrent.atomic.AtomicReference}) schema.utils/use-fn-validation]) [output-schema-sym output-schema] (apply concat schema-bindings) (mapcat :more-bindings processed-arities))) :arglists (map :arglist processed-arities) :raw-arglists (map :raw-arglist processed-arities) :schema-form (if (= 1 (count processed-arities)) `(schema.core/->FnSchema ~output-schema-sym ~[(ffirst schema-bindings)]) `(schema.core/make-fn-schema ~output-schema-sym ~(mapv first schema-bindings))) :fn-body fn-forms})) (defn parse-arity-spec "Helper for schema.core/=>*." [spec] (assert! (vector? spec) "An arity spec must be a vector") (let [[init more] ((juxt take-while drop-while) #(not= '& %) spec) fixed (mapv (fn [i s] `(schema.core/one ~s '~(symbol (str "arg" i)))) (range) init)] (if (empty? more) fixed (do (assert! (and (= (count more) 2) (vector? (second more))) "An arity with & must be followed by a single sequence schema") (into fixed (second more)))))) (defn emit-defrecord [defrecord-constructor-sym env name field-schema & more-args] (let [[extra-key-schema? more-args] (maybe-split-first map? more-args) [extra-validator-fn? more-args] (maybe-split-first (complement symbol?) more-args) field-schema (process-arrow-schematized-args env field-schema)] `(do (let [bad-keys# (seq (filter #(schema.core/required-key? %) (keys ~extra-key-schema?)))] (assert! (not bad-keys#) "extra-key-schema? can not contain required keys: %s" (vec bad-keys#))) ~(when extra-validator-fn? `(assert! (fn? ~extra-validator-fn?) "Extra-validator-fn? not a fn: %s" (type ~extra-validator-fn?))) (~defrecord-constructor-sym ~name ~field-schema ~@more-args) (utils/declare-class-schema! ~name (utils/assoc-when (schema.core/record ~name (merge ~(into {} (for [k field-schema] [(keyword (clojure.core/name k)) (do (assert! (symbol? k) "Non-symbol in record binding form: %s" k) (extract-schema-form k))])) ~extra-key-schema?) ~(symbol (str 'map-> name))) :extra-validator-fn ~extra-validator-fn?)) ~(let [map-sym (gensym "m")] `(if-cljs nil (defn ~(symbol (str 'map-> name)) ~(str "Factory function for class " name ", taking a map of keywords to field values, but not much\n" " slower than ->x like the clojure.core version.\n" " (performance is fixed in Clojure 1.7, so this should eventually be removed.)") [~map-sym] (let [base# (new ~(symbol (str name)) ~@(map (fn [s] `(get ~map-sym ~(keyword s))) field-schema)) remaining# (dissoc ~map-sym ~@(map keyword field-schema))] (if (seq remaining#) (merge base# remaining#) base#))))) ~(let [map-sym (gensym "m")] `(defn ~(symbol (str 'strict-map-> name)) ~(str "Factory function for class " name ", taking a map of keywords to field values. All" " keys are required, and no extra keys are allowed. Even faster than map->") [~map-sym & [drop-extra-keys?#]] (when-not (or drop-extra-keys?# (= (count ~map-sym) ~(count field-schema))) (error! (utils/format* "Wrong number of keys: expected %s, got %s" (sort ~(mapv keyword field-schema)) (sort (keys ~map-sym))))) (new ~(symbol (str name)) ~@(map (fn [s] `(safe-get ~map-sym ~(keyword s))) field-schema))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Public: helpers for schematized functions (defn normalized-defn-args "Helper for defining defn-like macros with schemas. Env is &env from the macro body. Reads optional docstring, return type and attribute-map and normalizes them into the metadata of the name, returning the normalized arglist. Based on clojure.tools.macro/name-with-attributes." [env macro-args] (let [[name macro-args] (extract-arrow-schematized-element env macro-args) [maybe-docstring macro-args] (maybe-split-first string? macro-args) [maybe-attr-map macro-args] (maybe-split-first map? macro-args)] (cons (vary-meta name merge (or maybe-attr-map {}) (when maybe-docstring {:doc maybe-docstring})) macro-args))) (defn set-compile-fn-validation! "Globally turn on or off function validation from being compiled into s/fn and s/defn. Enabled by default. See (doc compile-fn-validation?) for all conditions which control fn validation compilation" [on?] (reset! *compile-fn-validation* on?)) prismatic-schema-clojure-1.1.6/src/clj/schema/potemkin.clj000064400000000000000000000010311314115420600235160ustar00rootroot00000000000000(ns schema.potemkin "Features that require an explicit potemkin dependency to be provided by the consumer." (:require [schema.macros :as macros] [potemkin])) (defmacro defrecord+ "Like defrecord, but emits a record using potemkin/defrecord+. You must provide your own dependency on potemkin to use this." {:arglists '([name field-schema extra-key-schema? extra-validator-fn? & opts+specs])} [name field-schema & more-args] (apply macros/emit-defrecord 'potemkin/defrecord+ &env name field-schema more-args)) prismatic-schema-clojure-1.1.6/src/clj/schema/spec/000075500000000000000000000000001314115420600221355ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/src/clj/schema/spec/collection.clj000064400000000000000000000120601314115420600247610ustar00rootroot00000000000000(ns schema.spec.collection "A collection spec represents a collection of elements, each of which is itself schematized." (:require [schema.macros :as macros] [schema.utils :as utils] [schema.spec.core :as spec]) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Collection Specs (declare sequence-transformer) (defn- element-transformer [e params then] (if (vector? e) (case (first e) ::optional (sequence-transformer (next e) params then) ::remaining (let [_ (macros/assert! (= 2 (count e)) "remaining can have only one schema.") c (spec/sub-checker (second e) params)] (fn [^java.util.List res x] (doseq [i x] (.add res (c i))) (then res nil)) )) (let [parser (:parser e) c (spec/sub-checker e params)] (fn [^java.util.List res x] (then res (parser (fn [t] (.add res (if (utils/error? t) t (c t)))) x))) ))) (defn- sequence-transformer [elts params then] (macros/assert! (not-any? #(and (vector? %) (= (first %) ::remaining)) (butlast elts)) "Remaining schemas must be in tail position.") (reduce (fn [f e] (element-transformer e params f)) then (reverse elts))) ;; for performance (defn- has-error? [^java.util.List l] (let [it (.iterator l)] (loop [] (if (.hasNext it) (if (utils/error? (.next it)) true (recur)) false)))) (defn subschemas [elt] (if (map? elt) [(:schema elt)] (do (assert (vector? elt)) (assert (#{::remaining ::optional} (first elt))) (mapcat subschemas (next elt))))) (defrecord CollectionSpec [pre constructor elements on-error] spec/CoreSpec (subschemas [this] (mapcat subschemas elements)) (checker [this params] (let [constructor (if (:return-walked? params) constructor (fn [_] nil)) t (sequence-transformer elements params (fn [_ x] x))] (fn [x] (or (pre x) (let [res (java.util.ArrayList.) remaining (t res x) res res ] (if (or (seq remaining) (has-error? res)) (utils/error (on-error x res remaining)) (constructor res)))))))) (defn collection-spec "A collection represents a collection of elements, each of which is itself schematized. At the top level, the collection has a precondition (presumably on the overall type), a constructor for the collection from a sequence of items, an element spec, and a function that constructs a descriptive error on failure. The element spec is a nested list structure, in which the leaf elements each provide an element schema, parser (allowing for efficient processing of structured collections), and optional error wrapper. Each item in the list can be a leaf element or an `optional` nested element spec (see below). In addition, the final element can be a `remaining` schema (see below). Note that the `optional` carries no semantics with respect to validation; the user must ensure that the parser enforces the desired semantics, which should match the structure of the spec for proper generation." [pre ;- spec/Precondition constructor ;- (s/=> s/Any [(s/named s/Any 'checked-value)]) elements ;- [(s/cond-pre ;; {:schema (s/protocol Schema) ;; :parser (s/=> s/Any (s/=> s/Any s/Any) s/Any) ; takes [item-fn coll], calls item-fn on matching items, returns remaining. ;; (s/optional-key :error-wrap) (s/pred fn?)} ;; [(s/one ::optional) (s/recursive Elements)]] ;; where the last element can optionally be a [::remaining schema] on-error ;- (=> s/Any (s/named s/Any 'value) [(s/named s/Any 'checked-element)] [(s/named s/Any 'unmatched-element)]) ] (->CollectionSpec pre constructor elements on-error)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helpers for creating 'elements' (defn remaining "All remaining elements must match schema s" [s] [::remaining s]) (defn optional "If any more elements are present, they must match the elements in 'ss'" [& ss] (vec (cons ::optional ss))) (defn all-elements [schema] (remaining {:schema schema :parser (fn [coll] (macros/error! (str "should never be not called")))})) (defn one-element [required? schema parser] (let [base {:schema schema :parser parser}] (if required? base (optional base)))) (defn optional-tail [schema parser more] (into (optional {:schema schema :parser parser}) more)) ;;;;;;;;;;;; This file autogenerated from src/cljx/schema/spec/collection.cljx prismatic-schema-clojure-1.1.6/src/clj/schema/spec/core.clj000064400000000000000000000102351314115420600235600ustar00rootroot00000000000000(ns schema.spec.core "Protocol and preliminaries for Schema 'specs', which are a common language for schemas to use to express their structure." (:require [schema.macros :as macros] [schema.utils :as utils]) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Core spec protocol (defprotocol CoreSpec "Specs are a common language for Schemas to express their structure. These two use-cases aren't priveledged, just the two that are considered core to being a Spec." (subschemas [this] "List all subschemas") (checker [this params] "Create a function that takes [data], and either returns a walked version of data (by default, usually just data), or a utils/ErrorContainer containing value that looks like the 'bad' parts of data with ValidationErrors at the leaves describing the failures. params are: subschema-checker, return-walked?, and cache. params is a map specifying: - subschema-checker - a function for checking subschemas - returned-walked? - a boolean specifying whether to return a walked version of the data (otherwise, nil is returned which increases performance) - cache - a map structure from schema to checker, which speeds up checker creation when the same subschema appears multiple times, and also facilitates handling recursive schemas.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Preconditions ;; A Precondition is a function of a value that returns a ;; ValidationError if the value does not satisfy the precondition, ;; and otherwise returns nil. ;; e.g., (s/defschema Precondition (s/=> (s/maybe schema.utils.ValidationError) s/Any)) ;; as such, a precondition is essentially a very simple checker. (def +no-precondition+ (fn [_] nil)) (defn precondition "Helper for making preconditions. Takes a schema, predicate p, and error function err-f. If the datum passes the predicate, returns nil. Otherwise, returns a validation error with description (err-f datum-description), where datum-description is a (short) printable standin for the datum." [s p err-f] (fn [x] (when-let [reason (macros/try-catchall (when-not (p x) 'not) (catch e# 'throws?))] (macros/validation-error s x (err-f (utils/value-name x)) reason)))) (defmacro simple-precondition "A simple precondition where f-sym names a predicate (e.g. (simple-precondition s map?))" [s f-sym] `(precondition ~s ~f-sym #(list (quote ~f-sym) %))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helpers (defn run-checker "A helper to start a checking run, by setting the appropriate params. For examples, see schema.core/checker or schema.coerce/coercer." [f return-walked? s] (f s {:subschema-checker f :return-walked? return-walked? :cache (java.util.IdentityHashMap.) })) (defn with-cache [cache cache-key wrap-recursive-delay result-fn] (if-let [w (.get ^java.util.Map cache cache-key) ] (if (= ::in-progress w) ;; recursive (wrap-recursive-delay (delay (.get ^java.util.Map cache cache-key) )) w) (do (.put ^java.util.Map cache cache-key ::in-progress) (let [res (result-fn)] (.put ^java.util.Map cache cache-key res) res)))) (defn sub-checker "Should be called recursively on each subschema in the 'checker' method of a spec. Handles caching and error wrapping behavior." [{:keys [schema error-wrap]} {:keys [subschema-checker cache] :as params}] (let [sub (with-cache cache schema (fn [d] (fn [x] (@d x))) (fn [] (subschema-checker schema params)))] (if error-wrap (fn [x] (let [res (sub x)] (if-let [e (utils/error-val res)] (utils/error (error-wrap res)) res))) sub))) ;;;;;;;;;;;; This file autogenerated from src/cljx/schema/spec/core.cljx prismatic-schema-clojure-1.1.6/src/clj/schema/spec/leaf.clj000064400000000000000000000011141314115420600235330ustar00rootroot00000000000000(ns schema.spec.leaf (:require [schema.spec.core :as spec])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Leaf Specs (defrecord LeafSpec [pre] spec/CoreSpec (subschemas [this] nil) (checker [this params] (fn [x] (or (pre x) x)))) (defn leaf-spec "A leaf spec represents an atomic datum that is checked completely with a single precondition, and is otherwise a black box to Schema." [pre ;- spec/Precondition ] (->LeafSpec pre)) ;;;;;;;;;;;; This file autogenerated from src/cljx/schema/spec/leaf.cljx prismatic-schema-clojure-1.1.6/src/clj/schema/spec/variant.clj000064400000000000000000000060471314115420600243020ustar00rootroot00000000000000(ns schema.spec.variant (:require [schema.macros :as macros] [schema.utils :as utils] [schema.spec.core :as spec]) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variant Specs (defn- option-step [o params else] (let [g (:guard o) c (spec/sub-checker o params) step (if g (fn [x] (let [guard-result (macros/try-catchall (g x) (catch e# ::exception))] (cond (= ::exception guard-result) (macros/validation-error (:schema o) x (list (symbol (utils/fn-name g)) (utils/value-name x)) 'throws?) guard-result (c x) :else (else x)))) c)] (if-let [wrap-error (:wrap-error o)] (fn [x] (let [res (step x)] (if-let [e (utils/error-val res)] (utils/error (wrap-error e)) res))) step))) (defrecord VariantSpec [pre options err-f post] spec/CoreSpec (subschemas [this] (map :schema options)) (checker [this params] (let [t (reduce (fn [f o] (option-step o params f)) (fn [x] (macros/validation-error this x (err-f (utils/value-name x)))) (reverse options))] (if post (fn [x] (or (pre x) (let [v (t x)] (if (utils/error? v) v (or (post (if (:return-walked? params) v x)) v))))) (fn [x] (or (pre x) (t x))))))) (defn variant-spec "A variant spec represents a choice between a set of alternative subschemas, e.g., a tagged union. It has an overall precondition, set of options, and error function. The semantics of `options` is that the options are processed in order. During checking, the datum must match the schema for the first option for which `guard` passes. During generation, any datum generated from an option will pass the corresponding `guard`. err-f is a function to produce an error message if none of the guards match (and must be passed unless the last option has no guard)." ([pre options] (variant-spec pre options nil)) ([pre options err-f] (variant-spec pre options err-f nil)) ([pre ;- spec/Precondition options ;- [{:schema (s/protocol Schema) ;; (s/optional-key :guard) (s/pred fn?) ;; (s/optional-key :error-wrap) (s/pred fn?)}] err-f ;- (s/pred fn?) post ;- (s/maybe spec/Precondition) ] (macros/assert! (or err-f (nil? (:guard (last options)))) "when last option has a guard, err-f must be provided") (->VariantSpec pre options err-f post))) ;;;;;;;;;;;; This file autogenerated from src/cljx/schema/spec/variant.cljx prismatic-schema-clojure-1.1.6/src/clj/schema/test.clj000064400000000000000000000012121314115420600226500ustar00rootroot00000000000000(ns schema.test "Utilities for testing with schemas" (:require [schema.core :as s :include-macros true] clojure.test)) (defn validate-schemas "A fixture for tests: put (use-fixtures :once schema.test/validate-schemas) in your test file to turn on schema validation globally during all test executions." [fn-test] (s/with-fn-validation (fn-test))) (defmacro deftest "A test with schema validation turned on globally during execution of the body." [name & body] `(clojure.test/deftest ~name (s/with-fn-validation ~@body))) ;;;;;;;;;;;; This file autogenerated from src/cljx/schema/test.cljx prismatic-schema-clojure-1.1.6/src/clj/schema/utils.clj000064400000000000000000000134431314115420600230420ustar00rootroot00000000000000(ns schema.utils "Private utilities used in schema implementation." (:refer-clojure :exclude [record?]) (:require [clojure.string :as string]) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Miscellaneous helpers (defn assoc-when "Like assoc but only assocs when value is truthy. Copied from plumbing.core so that schema need not depend on plumbing." [m & kvs] (assert (even? (count kvs))) (into (or m {}) (for [[k v] (partition 2 kvs) :when v] [k v]))) (defn type-of [x] (class x) ) (defn fn-schema-bearer "What class can we associate the fn schema with? In Clojure use the class of the fn; in cljs just use the fn itself." [f] (class f) ) (defn format* [fmt & args] (apply format fmt args)) (def max-value-length (atom 19)) (defn value-name "Provide a descriptive short name for a value." [value] (let [t (type-of value)] (if (<= (count (str value)) @max-value-length) value (symbol (str "a-" (.getName ^Class t) ))))) (defmacro char-map [] clojure.lang.Compiler/CHAR_MAP) (defn unmunge "TODO: eventually use built in demunge in latest cljs." [s] (->> (char-map) (sort-by #(- (count (second %)))) (reduce (fn [^String s [to from]] (string/replace s from (str to))) s))) (defn fn-name "A meaningful name for a function that looks like its symbol, if applicable." [f] (let [s (.getName (class f)) slash (.lastIndexOf s "$") raw (unmunge (if (>= slash 0) (str (subs s 0 slash) "/" (subs s (inc slash))) s))] (string/replace raw #"^clojure.core/" ""))) (defn record? [x] (instance? clojure.lang.IRecord x) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Error descriptions ;; A leaf schema validation error, describing the schema and value and why it failed to ;; match the schema. In Clojure, prints like a form describing the failure that would ;; return true. (declare validation-error-explain) (deftype ValidationError [schema value expectation-delay fail-explanation] ) (defn validation-error-explain [^ValidationError err] (list (or (.-fail-explanation err) 'not) @(.-expectation-delay err))) ;; Validation errors print like forms that would return false (defmethod print-method ValidationError [err writer] (print-method (validation-error-explain err) writer)) (defn make-ValidationError "for cljs sake (easier than normalizing imports in macros.clj)" [schema value expectation-delay fail-explanation] (ValidationError. schema value expectation-delay fail-explanation)) ;; Attach a name to an error from a named schema. (declare named-error-explain) (deftype NamedError [name error] ) (defn named-error-explain [^NamedError err] (list 'named (.-error err) (.-name err))) ;; Validation errors print like forms that would return false (defmethod print-method NamedError [err writer] (print-method (named-error-explain err) writer)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Monoidish error containers, which wrap errors (to distinguish from success values). (defrecord ErrorContainer [error]) (defn error "Distinguish a value (must be non-nil) as an error." [x] (assert x) (->ErrorContainer x)) (defn error? [x] (instance? ErrorContainer x)) (defn error-val [x] (when (error? x) (.-error ^ErrorContainer x))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Registry for attaching schemas to classes, used for defn and defrecord (let [^java.util.Map +class-schemata+ (java.util.Collections/synchronizedMap (java.util.WeakHashMap.))] (defn declare-class-schema! [klass schema] "Globally set the schema for a class (above and beyond a simple instance? check). Use with care, i.e., only on classes that you control. Also note that this schema only applies to instances of the concrete type passed, i.e., (= (class x) klass), not (instance? klass x)." (assert (class? klass) (format* "Cannot declare class schema for non-class %s" (class klass))) (.put +class-schemata+ klass schema)) (defn class-schema [klass] "The last schema for a class set by declare-class-schema!, or nil." (.get +class-schemata+ klass))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Utilities for fast-as-possible reference to use to turn fn schema validation on/off (def use-fn-validation "Turn on run-time function validation for functions compiled when s/compile-fn-validation was true -- has no effect for functions compiled when it is false." ;; specialize in Clojure for performance (java.util.concurrent.atomic.AtomicReference. false) ) ;;;;;;;;;;;; This file autogenerated from src/cljx/schema/utils.cljx prismatic-schema-clojure-1.1.6/src/cljx/000075500000000000000000000000001314115420600201335ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/src/cljx/schema/000075500000000000000000000000001314115420600213735ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/src/cljx/schema/coerce.cljx000064400000000000000000000123141314115420600235160ustar00rootroot00000000000000(ns schema.coerce "Extension of schema for input coercion (coercing an input to match a schema)" (:require #+cljs [cljs.reader :as reader] #+clj [clojure.edn :as edn] #+clj [schema.macros :as macros] [schema.core :as s :include-macros true] [schema.spec.core :as spec] [schema.utils :as utils] [clojure.string :as str]) #+cljs (:require-macros [schema.macros :as macros])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Generic input coercion (def Schema "A Schema for Schemas" (s/protocol s/Schema)) (def CoercionMatcher "A function from schema to coercion function, or nil if no special coercion is needed. The returned function is applied to the corresponding data before validation (or walking/ coercion of its sub-schemas, if applicable)" (s/=> (s/maybe (s/=> s/Any s/Any)) Schema)) (s/defn coercer "Produce a function that simultaneously coerces and validates a datum. Returns a coerced value, or a schema.utils.ErrorContainer describing the error." [schema coercion-matcher :- CoercionMatcher] (spec/run-checker (fn [s params] (let [c (spec/checker (s/spec s) params)] (if-let [coercer (coercion-matcher s)] (fn [x] (macros/try-catchall (let [v (coercer x)] (if (utils/error? v) v (c v))) (catch t (macros/validation-error s x t)))) c))) true schema)) (s/defn coercer! "Like `coercer`, but is guaranteed to return a value that satisfies schema (or throw)." [schema coercion-matcher :- CoercionMatcher] (let [c (coercer schema coercion-matcher)] (fn [value] (let [coerced (c value)] (when-let [error (utils/error-val coerced)] (macros/error! (utils/format* "Value cannot be coerced to match schema: %s" (pr-str error)) {:schema schema :value value :error error})) coerced)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Coercion helpers (s/defn first-matcher :- CoercionMatcher "A matcher that takes the first match from matchers." [matchers :- [CoercionMatcher]] (fn [schema] (first (keep #(% schema) matchers)))) (defn string->keyword [s] (if (string? s) (keyword s) s)) (defn string->boolean "returns true for strings that are equal, ignoring case, to the string 'true' (following java.lang.Boolean/parseBoolean semantics)" [s] (if (string? s) (= "true" (str/lower-case s)) s)) (defn keyword-enum-matcher [schema] (when (or (and (instance? #+clj schema.core.EnumSchema #+cljs s/EnumSchema schema) (every? keyword? (.-vs ^schema.core.EnumSchema schema))) (and (instance? #+clj schema.core.EqSchema #+cljs s/EqSchema schema) (keyword? (.-v ^schema.core.EqSchema schema)))) string->keyword)) (defn set-matcher [schema] (if (instance? #+clj clojure.lang.APersistentSet #+cljs cljs.core.PersistentHashSet schema) (fn [x] (if (sequential? x) (set x) x)))) (defn safe "Take a single-arg function f, and return a single-arg function that acts as identity if f throws an exception, and like f otherwise. Useful because coercers are not explicitly guarded for exceptions, and failing to coerce will generally produce a more useful error in this case." [f] (fn [x] (macros/try-catchall (f x) (catch e x)))) #+clj (def safe-long-cast "Coerce x to a long if this can be done without losing precision, otherwise return x." (safe (fn [x] (let [l (long x)] (if (== l x) l x))))) (def string->uuid "Returns instance of UUID if input is a string. Note: in CLJS, this does not guarantee a specific UUID string representation, similar to #uuid reader" #+clj (safe #(java.util.UUID/fromString ^String %)) #+cljs #(if (string? %) (cljs.core.UUID. %) %)) (def ^:no-doc +json-coercions+ (merge {s/Keyword string->keyword s/Bool string->boolean s/Uuid string->uuid} #+clj {clojure.lang.Keyword string->keyword s/Int safe-long-cast Long safe-long-cast Double (safe double) Float (safe float) Boolean string->boolean})) (defn json-coercion-matcher "A matcher that coerces keywords and keyword eq/enums from strings, and longs and doubles from numbers on the JVM (without losing precision)" [schema] (or (+json-coercions+ schema) (keyword-enum-matcher schema) (set-matcher schema))) (def edn-read-string "Reads one object from a string. Returns nil when string is nil or empty" #+clj edn/read-string #+cljs reader/read-string) (def ^:no-doc +string-coercions+ (merge +json-coercions+ {s/Num (safe edn-read-string) s/Int (safe edn-read-string)} #+clj {s/Int (safe #(safe-long-cast (edn-read-string %))) Long (safe #(safe-long-cast (edn-read-string %))) Double (safe #(Double/parseDouble %))})) (defn string-coercion-matcher "A matcher that coerces keywords, keyword eq/enums, s/Num and s/Int, and long and doubles (JVM only) from strings." [schema] (or (+string-coercions+ schema) (keyword-enum-matcher schema) (set-matcher schema))) prismatic-schema-clojure-1.1.6/src/cljx/schema/core.cljx000064400000000000000000001454201314115420600232130ustar00rootroot00000000000000(ns schema.core "A library for data shape definition and validation. A Schema is just Clojure data, which can be used to document and validate Clojure functions and data. For example, (def FooBar {:foo Keyword :bar [Number]}) ;; a schema (check FooBar {:foo :k :bar [1.0 2.0 3.0]}) ==> nil representing successful validation, but the following all return helpful errors describing how the provided data fails to measure up to schema FooBar's standards. (check FooBar {:bar [1.0 2.0 3.0]}) ==> {:foo missing-required-key} (check FooBar {:foo 1 :bar [1.0 2.0 3.0]}) ==> {:foo (not (keyword? 1))} (check FooBar {:foo :k :bar [1.0 2.0 3.0] :baz 1}) ==> {:baz disallowed-key} Schema lets you describe your leaf values using the Any, Keyword, Symbol, Number, String, and Int definitions below, or (in Clojure) you can use arbitrary Java classes or primitive casts to describe simple values. From there, you can build up schemas for complex types using Clojure syntax (map literals for maps, set literals for sets, vector literals for sequences, with details described below), plus helpers below that provide optional values, enumerations, arbitrary predicates, and more. Assuming you (:require [schema.core :as s :include-macros true]), Schema also provides macros for defining records with schematized elements (s/defrecord), and named or anonymous functions (s/fn and s/defn) with schematized inputs and return values. In addition to producing better-documented records and functions, these macros allow you to retrieve the schema associated with the defined record or function. Moreover, functions include optional *validation*, which will throw an error if the inputs or outputs do not match the provided schemas: (s/defrecord FooBar [foo :- Int bar :- String]) (s/defn quux :- Int [foobar :- Foobar mogrifier :- Number] (* mogrifier (+ (:foo foobar) (Long/parseLong (:bar foobar))))) (quux (FooBar. 10 \"5\") 2) ==> 30 (fn-schema quux) ==> (=> Int (record user.FooBar {:foo Int, :bar java.lang.String}) java.lang.Number) (s/with-fn-validation (quux (FooBar. 10.2 \"5\") 2)) ==> Input to quux does not match schema: [(named {:foo (not (integer? 10.2))} foobar) nil] As you can see, the preferred syntax for providing type hints to schema's defrecord, fn, and defn macros is to follow each element, argument, or function name with a :- schema. Symbols without schemas default to a schema of Any. In Clojure, class (e.g., clojure.lang.String) and primitive schemas (long, double) are also propagated to tag metadata to ensure you get the type hinting and primitive behavior you ask for. If you don't like this style, standard Clojure-style typehints are also supported: (fn-schema (s/fn [^String x])) ==> (=> Any java.lang.String) You can directly type hint a symbol as a class, primitive, or simple schema. See the docstrings of defrecord, fn, and defn for more details about how to use these macros." ;; don't exclude def because it's not a var. (:refer-clojure :exclude [Keyword Symbol Inst atom defrecord defn letfn defmethod fn MapEntry ->MapEntry]) (:require #+clj [clojure.pprint :as pprint] [clojure.string :as str] #+clj [schema.macros :as macros] [schema.utils :as utils] [schema.spec.core :as spec :include-macros true] [schema.spec.leaf :as leaf] [schema.spec.variant :as variant] [schema.spec.collection :as collection]) #+cljs (:require-macros [schema.macros :as macros] schema.core)) #+clj (def clj-1195-fixed? (do (defprotocol CLJ1195Check (dummy-method [this])) (try (eval '(extend-protocol CLJ1195Check nil (dummy-method [_]))) true (catch RuntimeException _ false)))) #+clj (when-not clj-1195-fixed? ;; don't exclude fn because of bug in extend-protocol (refer-clojure :exclude '[Keyword Symbol Inst atom defrecord defn letfn defmethod])) #+clj (set! *warn-on-reflection* true) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Schema protocol (defprotocol Schema (spec [this] "A spec is a record of some type that expresses the structure of this schema in a declarative and/or imperative way. See schema.spec.* for examples.") (explain [this] "Expand this schema to a human-readable format suitable for pprinting, also expanding class schematas at the leaves. Example: user> (s/explain {:a s/Keyword :b [s/Int]} ) {:a Keyword, :b [Int]}")) ;; Schemas print as their explains #+clj (do (clojure.core/defmethod print-method schema.core.Schema [s writer] (print-method (explain s) writer)) (clojure.core/defmethod pprint/simple-dispatch schema.core.Schema [s] (pprint/write-out (explain s))) (doseq [m [print-method pprint/simple-dispatch]] (prefer-method m schema.core.Schema clojure.lang.IRecord) (prefer-method m schema.core.Schema java.util.Map) (prefer-method m schema.core.Schema clojure.lang.IPersistentMap))) (clojure.core/defn checker "Compile an efficient checker for schema, which returns nil for valid values and error descriptions otherwise." [schema] (comp utils/error-val (spec/run-checker (clojure.core/fn [s params] (spec/checker (spec s) params)) false schema))) (clojure.core/defn check "Return nil if x matches schema; otherwise, returns a value that looks like the 'bad' parts of x with ValidationErrors at the leaves describing the failures. If you will be checking many datums, it is much more efficient to create a 'checker' once and call it on each of them." [schema x] ((checker schema) x)) (clojure.core/defn validator "Compile an efficient validator for schema." [schema] (let [c (checker schema)] (clojure.core/fn [value] (when-let [error (c value)] (macros/error! (utils/format* "Value does not match schema: %s" (pr-str error)) {:schema schema :value value :error error})) value))) (clojure.core/defn validate "Throw an exception if value does not satisfy schema; otherwise, return value. If you will be validating many datums, it is much more efficient to create a 'validator' once and call it on each of them." [schema value] ((validator schema) value)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Platform-specific leaf Schemas ;; On the JVM, a Class itself is a schema. In JS, we treat functions as prototypes so any ;; function prototype checks objects for compatibility. (clojure.core/defn instance-precondition [s klass] (spec/precondition s #+clj #(instance? klass %) #+cljs #(and (not (nil? %)) (or (identical? klass (.-constructor %)) (js* "~{} instanceof ~{}" % klass))) #(list 'instance? klass %))) (extend-protocol Schema #+clj Class #+cljs function (spec [this] (let [pre (instance-precondition this this)] (if-let [class-schema (utils/class-schema this)] (variant/variant-spec pre [{:schema class-schema}]) (leaf/leaf-spec pre)))) (explain [this] (if-let [more-schema (utils/class-schema this)] (explain more-schema) (condp = this #+clj java.lang.String #+cljs nil 'Str #+clj java.lang.Boolean #+cljs js/Boolean 'Bool #+clj java.lang.Number #+cljs js/Number 'Num #+clj java.util.regex.Pattern #+cljs nil 'Regex #+clj java.util.Date #+cljs js/Date 'Inst #+clj java.util.UUID #+cljs cljs.core/UUID 'Uuid #+clj (symbol (.getName ^Class this)) #+cljs this)))) ;; On the JVM, the primitive coercion functions (double, long, etc) ;; alias to the corresponding boxed number classes #+clj (do (defmacro extend-primitive [cast-sym class-sym] (let [qualified-cast-sym `(class @(resolve '~cast-sym))] `(extend-protocol Schema ~qualified-cast-sym (spec [this#] (variant/variant-spec spec/+no-precondition+ [{:schema ~class-sym}])) (explain [this#] '~cast-sym)))) (extend-primitive double Double) (extend-primitive float Float) (extend-primitive long Long) (extend-primitive int Integer) (extend-primitive short Short) (extend-primitive char Character) (extend-primitive byte Byte) (extend-primitive boolean Boolean) (extend-primitive doubles (Class/forName "[D")) (extend-primitive floats (Class/forName "[F")) (extend-primitive longs (Class/forName "[J")) (extend-primitive ints (Class/forName "[I")) (extend-primitive shorts (Class/forName "[S")) (extend-primitive chars (Class/forName "[C")) (extend-primitive bytes (Class/forName "[B")) (extend-primitive booleans (Class/forName "[Z"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Cross-platform Schema leaves ;;; Any matches anything (including nil) (clojure.core/defrecord AnythingSchema [_] ;; _ is to work around bug in Clojure where eval-ing defrecord with no fields ;; loses type info, which makes this unusable in schema-fn. ;; http://dev.clojure.org/jira/browse/CLJ-1093 Schema (spec [this] (leaf/leaf-spec spec/+no-precondition+)) (explain [this] 'Any)) (def Any "Any value, including nil." (AnythingSchema. nil)) ;;; eq (to a single allowed value) (clojure.core/defrecord EqSchema [v] Schema (spec [this] (leaf/leaf-spec (spec/precondition this #(= v %) #(list '= v %)))) (explain [this] (list 'eq v))) (clojure.core/defn eq "A value that must be (= v)." [v] (EqSchema. v)) ;;; isa (a child of parent) (clojure.core/defrecord Isa [h parent] Schema (spec [this] (leaf/leaf-spec (spec/precondition this #(if h (isa? h % parent) (isa? % parent)) #(list 'isa? % parent)))) (explain [this] (list 'isa? parent))) (clojure.core/defn isa "A value that must be a child of parent." ([parent] (Isa. nil parent)) ([h parent] (Isa. h parent))) ;;; enum (in a set of allowed values) (clojure.core/defrecord EnumSchema [vs] Schema (spec [this] (leaf/leaf-spec (spec/precondition this #(contains? vs %) #(list vs %)))) (explain [this] (cons 'enum vs))) (clojure.core/defn enum "A value that must be = to some element of vs." [& vs] (EnumSchema. (set vs))) ;;; pred (matches all values for which p? returns truthy) (clojure.core/defrecord Predicate [p? pred-name] Schema (spec [this] (leaf/leaf-spec (spec/precondition this p? #(list pred-name %)))) (explain [this] (cond (= p? integer?) 'Int (= p? keyword?) 'Keyword (= p? symbol?) 'Symbol (= p? string?) 'Str :else (list 'pred pred-name)))) (clojure.core/defn pred "A value for which p? returns true (and does not throw). Optional pred-name can be passed for nicer validation errors." ([p?] (pred p? (symbol (utils/fn-name p?)))) ([p? pred-name] (when-not (ifn? p?) (macros/error! (utils/format* "Not a function: %s" p?))) (Predicate. p? pred-name))) ;;; protocol (which value must `satisfies?`) (clojure.core/defn protocol-name [protocol] (-> protocol meta :proto-sym)) ;; In cljs, satisfies? is a macro so we must precompile (partial satisfies? p) ;; and put it in metadata of the record so that equality is preserved, along with the name. (clojure.core/defrecord Protocol [p] Schema (spec [this] (leaf/leaf-spec (spec/precondition this #((:proto-pred (meta this)) %) #(list 'satisfies? (protocol-name this) %)))) (explain [this] (list 'protocol (protocol-name this)))) ;; The cljs version is macros/protocol by necessity, since cljs `satisfies?` is a macro. (defmacro protocol "A value that must satsify? protocol p. Internaly, we must make sure not to capture the value of the protocol at schema creation time, since that's impossible in cljs and breaks later extends in Clojure. A macro for cljs sake, since `satisfies?` is a macro in cljs." [p] `(with-meta (->Protocol ~p) {:proto-pred #(satisfies? ~p %) :proto-sym '~p})) ;;; regex (validates matching Strings) (extend-protocol Schema #+clj java.util.regex.Pattern #+cljs js/RegExp (spec [this] (leaf/leaf-spec (some-fn (spec/simple-precondition this string?) (spec/precondition this #(re-find this %) #(list 're-find (explain this) %))))) (explain [this] #+clj (symbol (str "#\"" this "\"")) #+cljs (symbol (str "#\"" (.slice (str this) 1 -1) "\"")))) ;;; Cross-platform Schemas for atomic value types (def Str "Satisfied only by String. Is (pred string?) and not js/String in cljs because of keywords." #+clj java.lang.String #+cljs (pred string?)) (def Bool "Boolean true or false" #+clj java.lang.Boolean #+cljs js/Boolean) (def Num "Any number" #+clj java.lang.Number #+cljs js/Number) (def Int "Any integral number" (pred integer?)) (def Keyword "A keyword" (pred keyword?)) (def Symbol "A symbol" (pred symbol?)) (def Regex "A regular expression" #+clj java.util.regex.Pattern #+cljs (reify Schema ;; Closure doesn't like if you just def as js/RegExp (spec [this] (leaf/leaf-spec (spec/precondition this #(instance? js/RegExp %) #(list 'instance? 'js/RegExp %)))) (explain [this] 'Regex))) (def Inst "The local representation of #inst ..." #+clj java.util.Date #+cljs js/Date) (def Uuid "The local representation of #uuid ..." #+clj java.util.UUID #+cljs cljs.core/UUID) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variant schemas (and other unit containers) ;;; maybe (nil) (clojure.core/defrecord Maybe [schema] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ [{:guard nil? :schema (eq nil)} {:schema schema}])) (explain [this] (list 'maybe (explain schema)))) (clojure.core/defn maybe "A value that must either be nil or satisfy schema" [schema] (Maybe. schema)) ;;; named (schema elements) (clojure.core/defrecord NamedSchema [schema name] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ [{:schema schema :wrap-error #(utils/->NamedError name %)}])) (explain [this] (list 'named (explain schema) name))) (clojure.core/defn named "A value that must satisfy schema, and has a name for documentation purposes." [schema name] (NamedSchema. schema name)) ;;; either (satisfies this schema or that one) (clojure.core/defrecord Either [schemas] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ (for [s schemas] {:guard (complement (checker s)) ;; since the guard determines which option we check against :schema s}) #(list 'some-matching-either-clause? %))) (explain [this] (cons 'either (map explain schemas)))) (clojure.core/defn ^{:deprecated "1.0.0"} either "A value that must satisfy at least one schema in schemas. Note that `either` does not work properly with coercion DEPRECATED: prefer `conditional` or `cond-pre` WARNING: either does not work with coercion. It is also slow and gives bad error messages. Please consider using `conditional` and friends instead; they are more efficient, provide better error messages, and work with coercion." [& schemas] (Either. schemas)) ;;; conditional (choice of schema, based on predicates on the value) (clojure.core/defrecord ConditionalSchema [preds-and-schemas error-symbol] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ (for [[p s] preds-and-schemas] {:guard p :schema s}) #(list (or error-symbol (if (= 1 (count preds-and-schemas)) (symbol (utils/fn-name (ffirst preds-and-schemas))) 'some-matching-condition?)) %))) (explain [this] (cons 'conditional (concat (mapcat (clojure.core/fn [[pred schema]] [(symbol (utils/fn-name pred)) (explain schema)]) preds-and-schemas) (when error-symbol [error-symbol]))))) (clojure.core/defn conditional "Define a conditional schema. Takes args like cond, (conditional pred1 schema1 pred2 schema2 ...), and checks the first schemaX where predX (an ordinary Clojure function that returns true or false) returns true on the value. Unlike cond, throws if the value does not match any condition. :else may be used as a final condition in the place of (constantly true). More efficient than either, since only one schema must be checked. An optional final argument can be passed, a symbol to appear in error messages when none of the conditions match." [& preds-and-schemas] (macros/assert! (and (seq preds-and-schemas) (or (even? (count preds-and-schemas)) (symbol? (last preds-and-schemas)))) "Expected even, nonzero number of args (with optional trailing symbol); got %s" (count preds-and-schemas)) (ConditionalSchema. (vec (for [[pred schema] (partition 2 preds-and-schemas)] (do (macros/assert! (ifn? pred) (str "Conditional predicate " pred " must be a function")) [(if (= pred :else) (constantly true) pred) schema]))) (if (odd? (count preds-and-schemas)) (last preds-and-schemas)))) ;; cond-pre (conditional based on surface type) (defprotocol HasPrecondition (precondition [this] "Return a predicate representing the Precondition for this schema: the predicate returns true if the precondition is satisfied. (See spec.core for more details)")) (extend-protocol HasPrecondition schema.spec.leaf.LeafSpec (precondition [this] (complement (.-pre ^schema.spec.leaf.LeafSpec this))) schema.spec.variant.VariantSpec (precondition [^schema.spec.variant.VariantSpec this] (every-pred (complement (.-pre this)) (apply some-fn (for [{:keys [guard schema]} (.-options this)] (if guard (every-pred guard (precondition (spec schema))) (precondition (spec schema))))))) schema.spec.collection.CollectionSpec (precondition [this] (complement (.-pre ^schema.spec.collection.CollectionSpec this)))) (clojure.core/defrecord CondPre [schemas] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ (for [s schemas] {:guard (precondition (spec s)) :schema s}) #(list 'matches-some-precondition? %))) (explain [this] (cons 'cond-pre (map explain schemas)))) (clojure.core/defn cond-pre "A replacement for `either` that constructs a conditional schema based on the schema spec preconditions of the component schemas. Given a datum, the preconditions for each schema (which typically check just the outermost class) are tested against the datum in turn. The first schema whose precondition matches is greedily selected, and the datum is validated against that schema. Unlike `either`, a validation failure is final (and there is no backtracking to try other schemas that might match). Thus, `cond-pre` is only suitable for schemas with mutually exclusive preconditions (e.g., s/Int and s/Str). If this doesn't hold (e.g. {:a s/Int} and {:b s/Str}), you must use `conditional` instead and provide an explicit condition for distinguishing the cases. EXPERIMENTAL" [& schemas] (CondPre. schemas)) ;; constrained (post-condition on schema) (clojure.core/defrecord Constrained [schema postcondition post-name] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ [{:schema schema}] nil (spec/precondition this postcondition #(list post-name %)))) (explain [this] (list 'constrained (explain schema) post-name))) (clojure.core/defn constrained "A schema with an additional post-condition. Differs from `conditional` with a single schema, in that the predicate checked *after* the main schema. This can lead to better error messages, and is often better suited for coercion." ([s p?] (constrained s p? (symbol (utils/fn-name p?)))) ([s p? pred-name] (when-not (ifn? p?) (macros/error! (utils/format* "Not a function: %s" p?))) (Constrained. s p? pred-name))) ;;; both (satisfies this schema and that one) (clojure.core/defrecord Both [schemas] Schema (spec [this] this) (explain [this] (cons 'both (map explain schemas))) HasPrecondition (precondition [this] (apply every-pred (map (comp precondition spec) schemas))) spec/CoreSpec (subschemas [this] schemas) (checker [this params] (reduce (clojure.core/fn [f t] (clojure.core/fn [x] (let [tx (t x)] (if (utils/error? tx) tx (f (or tx x)))))) (map #(spec/sub-checker {:schema %} params) (reverse schemas))))) (clojure.core/defn ^{:deprecated "1.0.0"} both "A value that must satisfy every schema in schemas. DEPRECATED: prefer 'conditional' with a single condition instead, or `constrained`. When used with coercion, coerces each schema in sequence." [& schemas] (Both. schemas)) (clojure.core/defn if "if the predicate returns truthy, use the if-schema, otherwise use the else-schema" [pred if-schema else-schema] (conditional pred if-schema (constantly true) else-schema)) ;;; Recursive schemas ;; Supports recursively defined schemas by using the level of indirection offered by by ;; Clojure and ClojureScript vars. (clojure.core/defn var-name [v] (let [{:keys [ns name]} (meta v)] (symbol (str #+clj (ns-name ns) #+cljs ns "/" name)))) (clojure.core/defrecord Recursive [derefable] Schema (spec [this] (variant/variant-spec spec/+no-precondition+ [{:schema @derefable}])) (explain [this] (list 'recursive (if #+clj (var? derefable) #+cljs (instance? Var derefable) (list 'var (var-name derefable)) #+clj (format "%s@%x" (.getName (class derefable)) (System/identityHashCode derefable)) #+cljs '...)))) (clojure.core/defn recursive "Support for (mutually) recursive schemas by passing a var that points to a schema, e.g (recursive #'ExampleRecursiveSchema)." [schema] (when-not #+clj (instance? clojure.lang.IDeref schema) #+cljs (satisfies? IDeref schema) (macros/error! (utils/format* "Not an IDeref: %s" schema))) (Recursive. schema)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Atom schema (defn- atom? [x] #+clj (instance? clojure.lang.Atom x) #+cljs (satisfies? IAtom x)) (clojure.core/defrecord Atomic [schema] Schema (spec [this] (collection/collection-spec (spec/simple-precondition this atom?) clojure.core/atom [(collection/one-element true schema (clojure.core/fn [item-fn coll] (item-fn @coll) nil))] (clojure.core/fn [_ xs _] (clojure.core/atom (first xs))))) (explain [this] (list 'atom (explain schema)))) (clojure.core/defn atom "An atom containing a value matching 'schema'." [schema] (->Atomic schema)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Map Schemas ;; A map schema is itself a Clojure map, which can provide value schemas for specific required ;; and optional keys, as well as a single, optional schema for additional key-value pairs. ;; Specific keys are mapped to value schemas, and given as either: ;; - (required-key k), a required key (= k) ;; - a keyword, also a required key ;; - (optional-key k), an optional key (= k) ;; For example, {:a Int (optional-key :b) String} describes a map with key :a mapping to an ;; integer, an optional key :b mapping to a String, and no other keys. ;; There can also be a single additional key, itself a schema, mapped to the schema for ;; corresponding values, which applies to all key-value pairs not covered by an explicit ;; key. ;; For example, {Int String} is a mapping from integers to strings, and ;; {:a Int Int String} is a mapping from :a to an integer, plus zero or more additional ;; mappings from integers to strings. ;;; Definitions for required and optional keys, and single entry validators (clojure.core/defrecord RequiredKey [k]) (clojure.core/defn required-key "A required key in a map" [k] (if (keyword? k) k (RequiredKey. k))) (clojure.core/defn required-key? [ks] (or (keyword? ks) (instance? RequiredKey ks))) (clojure.core/defrecord OptionalKey [k]) (clojure.core/defn optional-key "An optional key in a map" [k] (OptionalKey. k)) (clojure.core/defn optional-key? [ks] (instance? OptionalKey ks)) (clojure.core/defn explicit-schema-key [ks] (cond (keyword? ks) ks (instance? RequiredKey ks) (.-k ^RequiredKey ks) (optional-key? ks) (.-k ^OptionalKey ks) :else (macros/error! (utils/format* "Bad explicit key: %s" ks)))) (clojure.core/defn specific-key? [ks] (or (required-key? ks) (optional-key? ks))) (clojure.core/defn map-entry-ctor [[k v :as coll]] #+clj (clojure.lang.MapEntry. k v) #+cljs (vec coll)) ;; A schema for a single map entry. (clojure.core/defrecord MapEntry [key-schema val-schema] Schema (spec [this] (collection/collection-spec spec/+no-precondition+ map-entry-ctor [(collection/one-element true key-schema (clojure.core/fn [item-fn e] (item-fn (key e)) e)) (collection/one-element true val-schema (clojure.core/fn [item-fn e] (item-fn (val e)) nil))] (clojure.core/fn [[k] [xk xv] _] (if-let [k-err (utils/error-val xk)] [k-err 'invalid-key] [k (utils/error-val xv)])))) (explain [this] (list 'map-entry (explain key-schema) (explain val-schema)))) (clojure.core/defn map-entry [key-schema val-schema] (MapEntry. key-schema val-schema)) (clojure.core/defn find-extra-keys-schema [map-schema] (let [key-schemata (remove specific-key? (keys map-schema))] (macros/assert! (< (count key-schemata) 2) "More than one non-optional/required key schemata: %s" (vec key-schemata)) (first key-schemata))) (clojure.core/defn- explain-kspec [kspec] (if (specific-key? kspec) (if (keyword? kspec) kspec (list (cond (required-key? kspec) 'required-key (optional-key? kspec) 'optional-key) (explicit-schema-key kspec))) (explain kspec))) (defn- map-elements [this] (let [extra-keys-schema (find-extra-keys-schema this)] (let [duplicate-keys (->> (dissoc this extra-keys-schema) keys (group-by explicit-schema-key) vals (filter #(> (count %) 1)) (apply concat) (mapv explain-kspec))] (macros/assert! (empty? duplicate-keys) "Schema has multiple variants of the same explicit key: %s" duplicate-keys)) (concat (for [[k v] (dissoc this extra-keys-schema)] (let [rk (explicit-schema-key k) required? (required-key? k)] (collection/one-element required? (map-entry (eq rk) v) (clojure.core/fn [item-fn m] (let [e (find m rk)] (cond e (item-fn e) required? (item-fn (utils/error [rk 'missing-required-key]))) (if e (dissoc #+clj (if (instance? clojure.lang.PersistentStructMap m) (into {} m) m) #+cljs m rk) m)))))) (when extra-keys-schema [(collection/all-elements (apply map-entry (find this extra-keys-schema)))])))) (defn- map-error [] (clojure.core/fn [_ elts extra] (into {} (concat (keep utils/error-val elts) (for [[k _] extra] [k 'disallowed-key]))))) (defn- map-spec [this] (collection/collection-spec (spec/simple-precondition this map?) #(into {} %) (map-elements this) (map-error))) (clojure.core/defn- map-explain [this] (into {} (for [[k v] this] [(explain-kspec k) (explain v)]))) (extend-protocol Schema #+clj clojure.lang.APersistentMap #+cljs cljs.core.PersistentArrayMap (spec [this] (map-spec this)) (explain [this] (map-explain this)) #+cljs cljs.core.PersistentHashMap #+cljs (spec [this] (map-spec this)) #+cljs (explain [this] (map-explain this))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Set schemas ;; A set schema is a Clojure set with a single element, a schema that all values must satisfy (extend-protocol Schema #+clj clojure.lang.APersistentSet #+cljs cljs.core.PersistentHashSet (spec [this] (macros/assert! (= (count this) 1) "Set schema must have exactly one element") (collection/collection-spec (spec/simple-precondition this set?) set [(collection/all-elements (first this))] (clojure.core/fn [_ xs _] (set (keep utils/error-val xs))))) (explain [this] (set [(explain (first this))]))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Queue schemas ;; A queue schema is satisfied by PersistentQueues containing values that all satisfy ;; a specific sub-schema. (clojure.core/defn queue? [x] (instance? #+clj clojure.lang.PersistentQueue #+cljs cljs.core/PersistentQueue x)) (clojure.core/defn as-queue [col] (reduce conj #+clj clojure.lang.PersistentQueue/EMPTY #+cljs cljs.core/PersistentQueue.EMPTY col)) (clojure.core/defrecord Queue [schema] Schema (spec [this] (collection/collection-spec (spec/simple-precondition this queue?) as-queue [(collection/all-elements schema)] (clojure.core/fn [_ xs _] (as-queue (keep utils/error-val xs))))) (explain [this] (list 'queue (explain schema)))) (clojure.core/defn queue "Defines a schema satisfied by instances of clojure.lang.PersistentQueue (clj.core/PersistentQueue in ClojureScript) whose values satisfy x." [x] (Queue. x)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Sequence Schemas ;; A sequence schema looks like [one* optional* rest-schema?]. ;; one matches a single required element, and must be the output of 'one' below. ;; optional matches a single optional element, and must be the output of 'optional' below. ;; Finally, rest-schema is any schema, which must match any remaining elements. ;; (if optional elements are present, they must be matched before the rest-schema is applied). (clojure.core/defrecord One [schema optional? name]) (clojure.core/defn one "A single required element of a sequence (not repeated, the implicit default)" ([schema name] (One. schema false name))) (clojure.core/defn optional "A single optional element of a sequence (not repeated, the implicit default)" ([schema name] (One. schema true name))) (clojure.core/defn parse-sequence-schema [s] "Parses and validates a sequence schema, returning a vector in the form [singles multi] where singles is a sequence of 'one' and 'optional' schemas and multi is the rest-schema (which may be nil). A valid sequence schema is a vector in the form [one* optional* rest-schema?]." (let [[required more] (split-with #(and (instance? One %) (not (:optional? %))) s) [optional more] (split-with #(and (instance? One %) (:optional? %)) more)] (macros/assert! (and (<= (count more) 1) (every? #(not (instance? One %)) more)) "%s is not a valid sequence schema; %s%s%s" s "a valid sequence schema consists of zero or more `one` elements, " "followed by zero or more `optional` elements, followed by an optional " "schema that will match the remaining elements.") [(concat required optional) (first more)])) (extend-protocol Schema #+clj clojure.lang.APersistentVector #+cljs cljs.core.PersistentVector (spec [this] (collection/collection-spec (spec/precondition this (clojure.core/fn [x] (or (nil? x) (sequential? x) #+clj (instance? java.util.List x))) #(list 'sequential? %)) vec (let [[singles multi] (parse-sequence-schema this)] (reduce (clojure.core/fn [more ^One s] (if-not (.-optional? s) (cons (collection/one-element true (named (.-schema s) (.-name s)) (clojure.core/fn [item-fn x] (if-let [x (seq x)] (do (item-fn (first x)) (rest x)) (do (item-fn (macros/validation-error (.-schema s) ::missing (list 'present? (.-name s)))) nil)))) more) [(collection/optional-tail (named (.-schema s) (.-name s)) (clojure.core/fn [item-fn x] (when-let [x (seq x)] (item-fn (first x)) (rest x))) more)])) (when multi [(collection/all-elements multi)]) (reverse singles))) (clojure.core/fn [_ elts extra] (let [head (mapv utils/error-val elts)] (if (seq extra) (conj head (utils/error-val (macros/validation-error nil extra (list 'has-extra-elts? (count extra))))) head))))) (explain [this] (let [[singles multi] (parse-sequence-schema this)] (vec (concat (for [^One s singles] (list (if (.-optional? s) 'optional 'one) (explain (:schema s)) (:name s))) (when multi [(explain multi)])))))) (clojure.core/defn pair "A schema for a pair of schemas and their names" [first-schema first-name second-schema second-name] [(one first-schema first-name) (one second-schema second-name)]) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Record Schemas ;; A Record schema describes a value that must have the correct type, and its body must ;; also satisfy a map schema. An optional :extra-validator-fn can also be attached to do ;; additional validation. (clojure.core/defrecord Record [klass schema] Schema (spec [this] (collection/collection-spec (let [p (spec/precondition this #(instance? klass %) #(list 'instance? klass %))] (if-let [evf (:extra-validator-fn this)] (some-fn p (spec/precondition this evf #(list 'passes-extra-validation? %))) p)) (:constructor (meta this)) (map-elements schema) (map-error))) (explain [this] (list 'record #+clj (symbol (.getName ^Class klass)) #+cljs (symbol (pr-str klass)) (explain schema)))) (clojure.core/defn record* [klass schema map-constructor] #+clj (macros/assert! (class? klass) "Expected record class, got %s" (utils/type-of klass)) (macros/assert! (map? schema) "Expected map, got %s" (utils/type-of schema)) (with-meta (Record. klass schema) {:constructor map-constructor})) (defmacro record "A Record instance of type klass, whose elements match map schema 'schema'. The final argument is the map constructor of the record type; if you do not pass one, an attempt is made to find the corresponding function (but this may fail in exotic circumstances)." ([klass schema] `(record ~klass ~schema (macros/if-cljs ~(let [bits (str/split (name klass) #"/")] (symbol (str/join "/" (concat (butlast bits) [(str "map->" (last bits))])))) #(~(symbol (str (name klass) "/create")) %)))) ([klass schema map-constructor] `(record* ~klass ~schema #(~map-constructor (into {} %))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Function Schemas ;; A function schema describes a function of one or more arities. ;; The function can only have a single output schema (across all arities), and each input ;; schema is a sequence schema describing the argument vector. ;; Currently function schemas are purely descriptive, and do not carry any validation logic. (clojure.core/defn explain-input-schema [input-schema] (let [[required more] (split-with #(instance? One %) input-schema)] (concat (map #(explain (.-schema ^One %)) required) (when (seq more) ['& (mapv explain more)])))) (clojure.core/defrecord FnSchema [output-schema input-schemas] ;; input-schemas sorted by arity Schema (spec [this] (leaf/leaf-spec (spec/simple-precondition this ifn?))) (explain [this] (if (> (count input-schemas) 1) (list* '=>* (explain output-schema) (map explain-input-schema input-schemas)) (list* '=> (explain output-schema) (explain-input-schema (first input-schemas)))))) (clojure.core/defn- arity [input-schema] (if (seq input-schema) (if (instance? One (last input-schema)) (count input-schema) #+clj Long/MAX_VALUE #+cljs js/Number.MAX_VALUE) 0)) (clojure.core/defn make-fn-schema "A function outputting a value in output schema, whose argument vector must match one of input-schemas, each of which should be a sequence schema. Currently function schemas are purely descriptive; they validate against any function, regardless of actual input and output types." [output-schema input-schemas] (macros/assert! (seq input-schemas) "Function must have at least one input schema") (macros/assert! (every? vector? input-schemas) "Each arity must be a vector.") (macros/assert! (apply distinct? (map arity input-schemas)) "Arities must be distinct") (FnSchema. output-schema (sort-by arity input-schemas))) (defmacro =>* "Produce a function schema from an output schema and a list of arity input schema specs, each of which is a vector of argument schemas, ending with an optional '& more-schema' specification where more-schema must be a sequence schema. Currently function schemas are purely descriptive; there is no validation except for functions defined directly by s/fn or s/defn" [output-schema & arity-schema-specs] `(make-fn-schema ~output-schema ~(mapv macros/parse-arity-spec arity-schema-specs))) (defmacro => "Convenience macro for defining function schemas with a single arity; like =>*, but there is no vector around the argument schemas for this arity." [output-schema & arg-schemas] `(=>* ~output-schema ~(vec arg-schemas))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helpers for defining schemas (used in in-progress work, explanation coming soon) (clojure.core/defn schema-with-name "Records name in schema's metadata." [schema name] (vary-meta schema assoc :name name)) (clojure.core/defn schema-name "Returns the name of a schema attached via schema-with-name (or defschema)." [schema] (-> schema meta :name)) (clojure.core/defn schema-ns "Returns the namespace of a schema attached via defschema." [schema] (-> schema meta :ns)) (defmacro defschema "Convenience macro to make it clear to reader that body is meant to be used as a schema. The name of the schema is recorded in the metadata." ([name form] `(defschema ~name "" ~form)) ([name docstring form] `(def ~name ~docstring (vary-meta (schema-with-name ~form '~name) assoc :ns '~(ns-name *ns*))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Schematized defrecord and (de,let)fn macros (defmacro defrecord "Define a record with a schema. In addition to the ordinary behavior of defrecord, this macro produces a schema for the Record, which will automatically be used when validating instances of the Record class: (m/defrecord FooBar [foo :- Int bar :- String]) (schema.utils/class-schema FooBar) ==> (record user.FooBar {:foo Int, :bar java.lang.String}) (s/check FooBar (FooBar. 1.2 :not-a-string)) ==> {:foo (not (integer? 1.2)), :bar (not (instance? java.lang.String :not-a-string))} See (doc schema.core) for details of the :- syntax for record elements. Moreover, optional arguments extra-key-schema? and extra-validator-fn? can be passed to augment the record schema. - extra-key-schema is a map schema that defines validation for additional key-value pairs not in the record base (the default is to not allow extra mappings). - extra-validator-fn? is an additional predicate that will be used as part of validating the record value. The remaining opts+specs (i.e., protocol and interface implementations) are passed through directly to defrecord. Finally, this macro replaces Clojure's map->name constructor with one that is more than an order of magnitude faster (as of Clojure 1.5), and provides a new strict-map->name constructor that throws or drops extra keys not in the record base." {:arglists '([name field-schema extra-key-schema? extra-validator-fn? & opts+specs])} [name field-schema & more-args] (apply macros/emit-defrecord 'clojure.core/defrecord &env name field-schema more-args)) #+clj (defmacro defrecord+ "DEPRECATED -- canonical version moved to schema.potemkin Like defrecord, but emits a record using potemkin/defrecord+. You must provide your own dependency on potemkin to use this." {:arglists '([name field-schema extra-key-schema? extra-validator-fn? & opts+specs])} [name field-schema & more-args] (apply macros/emit-defrecord 'potemkin/defrecord+ &env name field-schema more-args)) (defmacro set-compile-fn-validation! [on?] (macros/set-compile-fn-validation! on?) nil) (clojure.core/defn fn-validation? "Get the current global schema validation setting." [] #+clj (.get ^java.util.concurrent.atomic.AtomicReference utils/use-fn-validation) #+cljs @utils/use-fn-validation) (clojure.core/defn set-fn-validation! "Globally turn on (or off) schema validation for all s/fn and s/defn instances." [on?] #+clj (.set ^java.util.concurrent.atomic.AtomicReference utils/use-fn-validation on?) #+cljs (reset! utils/use-fn-validation on?)) (defmacro with-fn-validation "Execute body with input and output schema validation turned on for all s/defn and s/fn instances globally (across all threads). After all forms have been executed, resets function validation to its previously set value. Not concurrency-safe." [& body] `(let [body# (fn [] ~@body)] (if (fn-validation?) (body#) (do (set-fn-validation! true) (try (body#) (finally (set-fn-validation! false))))))) (defmacro without-fn-validation "Execute body with input and output schema validation turned off for all s/defn and s/fn instances globally (across all threads). After all forms have been executed, resets function validation to its previously set value. Not concurrency-safe." [& body] `(let [body# (fn [] ~@body)] (if (fn-validation?) (do (set-fn-validation! false) (try (body#) (finally (set-fn-validation! true)))) (body#)))) (def fn-validator "A var that can be rebound to a function to customize the behavior of fn validation. When fn validation is on and `fn-validator` is bound to a function, normal argument and return value checks will be substituted with a call to this function with five arguments: direction - :input or :output fn-name - a symbol, the function's name schema - the schema for the arglist or the return value checker - a precompiled checker to check a value against the schema value - the actual arglist or return value The function's return value will be ignored." nil) (clojure.core/defn schematize-fn "Attach the schema to fn f at runtime, extractable by fn-schema." [f schema] (vary-meta f assoc :schema schema)) (clojure.core/defn ^FnSchema fn-schema "Produce the schema for a function defined with s/fn or s/defn." [f] (macros/assert! (fn? f) "Non-function %s" (utils/type-of f)) (or (utils/class-schema (utils/fn-schema-bearer f)) (macros/safe-get (meta f) :schema))) ;; work around bug in extend-protocol (refers to bare 'fn, so we can't exclude it). #+clj (when-not clj-1195-fixed? (ns-unmap *ns* 'fn)) (defmacro fn "s/fn : s/defn :: clojure.core/fn : clojure.core/defn See (doc s/defn) for details. Additional gotchas and limitations: - Like s/defn, the output schema must go on the fn name. If you don't supply a name, schema will gensym one for you and attach the schema. - Unlike s/defn, the function schema is stored in metadata on the fn. Clojure's implementation for metadata on fns currently produces a wrapper fn, which will decrease performance and negate the benefits of primitive type hints compared to clojure.core/fn." [& fn-args] (let [fn-args (if (symbol? (first fn-args)) fn-args (cons (gensym "fn") fn-args)) [name more-fn-args] (macros/extract-arrow-schematized-element &env fn-args) {:keys [outer-bindings schema-form fn-body]} (macros/process-fn- &env name more-fn-args)] `(let ~outer-bindings (schematize-fn ~(vary-meta `(clojure.core/fn ~name ~@fn-body) #(merge (meta &form) %)) ~schema-form)))) (defmacro defn "Like clojure.core/defn, except that schema-style typehints can be given on the argument symbols and on the function name (for the return value). You can call s/fn-schema on the defined function to get its schema back, or use with-fn-validation to enable runtime checking of function inputs and outputs. (s/defn foo :- s/Num [x :- s/Int y :- s/Num] (* x y)) (s/fn-schema foo) ==> (=> java.lang.Number Int java.lang.Number) (s/with-fn-validation (foo 1 2)) ==> 2 (s/with-fn-validation (foo 1.5 2)) ==> Input to foo does not match schema: [(named (not (integer? 1.5)) x) nil] See (doc schema.core) for details of the :- syntax for arguments and return schemas. The overhead for checking if run-time validation should be used is very small -- about 5% of a very small fn call. On top of that, actual validation costs what it costs. You can also turn on validation unconditionally for this fn only by putting ^:always-validate metadata on the fn name. Gotchas and limitations: - The output schema always goes on the fn name, not the arg vector. This means that all arities must share the same output schema. Schema will automatically propagate primitive hints to the arg vector and class hints to the fn name, so that you get the behavior you expect from Clojure. - All primitive schemas will be passed through as type hints to Clojure, despite their legality in a particular position. E.g., (s/defn foo [x :- int]) will fail because Clojure does not allow primitive ints as fn arguments; in such cases, use the boxed Classes instead (e.g., Integer). - Schema metadata is only processed on top-level arguments. I.e., you can use destructuring, but you must put schema metadata on the top-level arguments, not the destructured variables. Bad: (s/defn foo [{:keys [x :- s/Int]}]) Good: (s/defn foo [{:keys [x]} :- {:x s/Int}]) - Only a specific subset of rest-arg destructuring is supported: - & rest works as expected - & [a b] works, with schemas for individual elements parsed out of the binding, or an overall schema on the vector - & {} is not supported. - Unlike clojure.core/defn, a final attr-map on multi-arity functions is not supported." [& defn-args] (let [[name & more-defn-args] (macros/normalized-defn-args &env defn-args) {:keys [doc tag] :as standard-meta} (meta name) {:keys [outer-bindings schema-form fn-body arglists raw-arglists]} (macros/process-fn- &env name more-defn-args)] `(let ~outer-bindings (let [ret# (clojure.core/defn ~(with-meta name {}) ~(assoc (apply dissoc standard-meta (when (macros/primitive-sym? tag) [:tag])) :doc (str (str "Inputs: " (if (= 1 (count raw-arglists)) (first raw-arglists) (apply list raw-arglists))) (when-let [ret (when (= (second defn-args) :-) (nth defn-args 2))] (str "\n Returns: " ret)) (when doc (str "\n\n " doc))) :raw-arglists (list 'quote raw-arglists) :arglists (list 'quote arglists) :schema schema-form) ~@fn-body)] (utils/declare-class-schema! (utils/fn-schema-bearer ~name) ~schema-form) ret#)))) (defmacro defmethod "Like clojure.core/defmethod, except that schema-style typehints can be given on the argument symbols and after the dispatch-val (for the return value). See (doc s/defn) for details. Examples: (s/defmethod mymultifun :a-dispatch-value :- s/Num [x :- s/Int y :- s/Num] (* x y)) ;; You can also use meta tags like ^:always-validate by placing them ;; before the multifunction name: (s/defmethod ^:always-validate mymultifun :a-dispatch-value [x y] (* x y))" [multifn dispatch-val & fn-tail] `(macros/if-cljs (cljs.core/-add-method ~(with-meta multifn {:tag 'cljs.core/MultiFn}) ~dispatch-val (fn ~(with-meta (gensym) (meta multifn)) ~@fn-tail)) (. ~(with-meta multifn {:tag 'clojure.lang.MultiFn}) addMethod ~dispatch-val (fn ~(with-meta (gensym) (meta multifn)) ~@fn-tail)))) (defmacro letfn "s/letfn : s/fn :: clojure.core/letfn : clojure.core/fn" [fnspecs & body] (list `let (vec (interleave (map first fnspecs) (map #(cons `fn %) fnspecs))) `(do ~@body))) (defmacro def "Like def, but takes a schema on the var name (with the same format as the output schema of s/defn), requires an initial value, and asserts that the initial value matches the schema on the var name (regardless of the status of with-fn-validation). Due to limitations of add-watch!, cannot enforce validation of subsequent rebindings of var. Throws at compile-time for clj, and client-side load-time for cljs. Example: (s/def foo :- long \"a long\" 2)" [& def-args] (let [[name more-def-args] (macros/extract-arrow-schematized-element &env def-args) [doc-string? more-def-args] (if (= (count more-def-args) 2) (macros/maybe-split-first string? more-def-args) [nil more-def-args]) init (first more-def-args)] (macros/assert! (= 1 (count more-def-args)) "Illegal args passed to schema def: %s" def-args) `(let [output-schema# ~(macros/extract-schema-form name)] (def ~name ~@(when doc-string? [doc-string?]) (validate output-schema# ~init))))) #+clj (set! *warn-on-reflection* false) (clojure.core/defn set-max-value-length! "Sets the maximum length of value to be output before it is contracted to a prettier name." [max-length] (reset! utils/max-value-length max-length)) prismatic-schema-clojure-1.1.6/src/cljx/schema/experimental/000075500000000000000000000000001314115420600240705ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/src/cljx/schema/experimental/abstract_map.cljx000064400000000000000000000054051314115420600274160ustar00rootroot00000000000000(ns schema.experimental.abstract-map "Schemas representing abstract classes and subclasses" (:require [clojure.string :as str] [schema.core :as s :include-macros true] [schema.spec.core :as spec] [schema.spec.variant :as variant])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Private: helpers (defprotocol PExtensibleSchema (extend-schema! [this extension schema-name dispatch-values])) ;; a "subclass" (defrecord SchemaExtension [schema-name base-schema extended-schema explain-value] s/Schema (spec [this] (variant/variant-spec spec/+no-precondition+ [{:schema extended-schema}])) (explain [this] (list 'extend-schema schema-name (s/schema-name base-schema) (s/explain explain-value)))) ;; an "abstract class" (defrecord AbstractSchema [sub-schemas dispatch-key schema open?] s/Schema (spec [this] (variant/variant-spec spec/+no-precondition+ (concat (for [[k s] @sub-schemas] {:guard #(= (keyword (dispatch-key %)) (keyword k)) :schema s}) (when open? [{:schema (assoc schema dispatch-key s/Keyword s/Any s/Any)}])) (fn [v] (list (set (keys @sub-schemas)) (list dispatch-key v))))) (explain [this] (list 'abstract-map-schema dispatch-key (s/explain schema) (set (keys @sub-schemas)))) PExtensibleSchema (extend-schema! [this extension schema-name dispatch-values] (let [sub-schema (assoc (merge schema extension) dispatch-key (apply s/enum dispatch-values)) ext-schema (s/schema-with-name (SchemaExtension. schema-name this sub-schema extension) (name schema-name))] (swap! sub-schemas merge (into {} (for [k dispatch-values] [k ext-schema]))) ext-schema))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Public (s/defn abstract-map-schema "A schema representing an 'abstract class' map that must match at least one concrete subtype (indicated by the value of dispatch-key, a keyword). Add subtypes by calling `extend-schema`." [dispatch-key :- s/Keyword schema :- (s/pred map?)] (AbstractSchema. (atom {}) dispatch-key schema false)) (s/defn open-abstract-map-schema "Like abstract-map-schema, but allows unknown types to validate (for, e.g. forward compatibility)." [dispatch-key :- s/Keyword schema :- (s/pred map?)] (AbstractSchema. (atom {}) dispatch-key schema true)) (defmacro extend-schema [schema-name extensible-schema dispatch-values extension] `(def ~schema-name (extend-schema! ~extensible-schema ~extension '~schema-name ~dispatch-values))) (defn sub-schemas [abstract-schema] @(.-sub-schemas ^AbstractSchema abstract-schema)) prismatic-schema-clojure-1.1.6/src/cljx/schema/spec/000075500000000000000000000000001314115420600223255ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/src/cljx/schema/spec/collection.cljx000064400000000000000000000117401314115420600253450ustar00rootroot00000000000000(ns schema.spec.collection "A collection spec represents a collection of elements, each of which is itself schematized." (:require #+clj [schema.macros :as macros] [schema.utils :as utils] [schema.spec.core :as spec]) #+cljs (:require-macros [schema.macros :as macros])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Collection Specs (declare sequence-transformer) (defn- element-transformer [e params then] (if (vector? e) (case (first e) ::optional (sequence-transformer (next e) params then) ::remaining (let [_ (macros/assert! (= 2 (count e)) "remaining can have only one schema.") c (spec/sub-checker (second e) params)] #+clj (fn [^java.util.List res x] (doseq [i x] (.add res (c i))) (then res nil)) #+cljs (fn [res x] (swap! res into (map c x)) (then res nil)))) (let [parser (:parser e) c (spec/sub-checker e params)] #+clj (fn [^java.util.List res x] (then res (parser (fn [t] (.add res (if (utils/error? t) t (c t)))) x))) #+cljs (fn [res x] (then res (parser (fn [t] (swap! res conj (if (utils/error? t) t (c t)))) x)))))) (defn- sequence-transformer [elts params then] (macros/assert! (not-any? #(and (vector? %) (= (first %) ::remaining)) (butlast elts)) "Remaining schemas must be in tail position.") (reduce (fn [f e] (element-transformer e params f)) then (reverse elts))) #+clj ;; for performance (defn- has-error? [^java.util.List l] (let [it (.iterator l)] (loop [] (if (.hasNext it) (if (utils/error? (.next it)) true (recur)) false)))) #+cljs (defn- has-error? [l] (some utils/error? l)) (defn subschemas [elt] (if (map? elt) [(:schema elt)] (do (assert (vector? elt)) (assert (#{::remaining ::optional} (first elt))) (mapcat subschemas (next elt))))) (defrecord CollectionSpec [pre constructor elements on-error] spec/CoreSpec (subschemas [this] (mapcat subschemas elements)) (checker [this params] (let [constructor (if (:return-walked? params) constructor (fn [_] nil)) t (sequence-transformer elements params (fn [_ x] x))] (fn [x] (or (pre x) (let [res #+clj (java.util.ArrayList.) #+cljs (atom []) remaining (t res x) res #+clj res #+cljs @res] (if (or (seq remaining) (has-error? res)) (utils/error (on-error x res remaining)) (constructor res)))))))) (defn collection-spec "A collection represents a collection of elements, each of which is itself schematized. At the top level, the collection has a precondition (presumably on the overall type), a constructor for the collection from a sequence of items, an element spec, and a function that constructs a descriptive error on failure. The element spec is a nested list structure, in which the leaf elements each provide an element schema, parser (allowing for efficient processing of structured collections), and optional error wrapper. Each item in the list can be a leaf element or an `optional` nested element spec (see below). In addition, the final element can be a `remaining` schema (see below). Note that the `optional` carries no semantics with respect to validation; the user must ensure that the parser enforces the desired semantics, which should match the structure of the spec for proper generation." [pre ;- spec/Precondition constructor ;- (s/=> s/Any [(s/named s/Any 'checked-value)]) elements ;- [(s/cond-pre ;; {:schema (s/protocol Schema) ;; :parser (s/=> s/Any (s/=> s/Any s/Any) s/Any) ; takes [item-fn coll], calls item-fn on matching items, returns remaining. ;; (s/optional-key :error-wrap) (s/pred fn?)} ;; [(s/one ::optional) (s/recursive Elements)]] ;; where the last element can optionally be a [::remaining schema] on-error ;- (=> s/Any (s/named s/Any 'value) [(s/named s/Any 'checked-element)] [(s/named s/Any 'unmatched-element)]) ] (->CollectionSpec pre constructor elements on-error)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helpers for creating 'elements' (defn remaining "All remaining elements must match schema s" [s] [::remaining s]) (defn optional "If any more elements are present, they must match the elements in 'ss'" [& ss] (vec (cons ::optional ss))) (defn all-elements [schema] (remaining {:schema schema :parser (fn [coll] (macros/error! (str "should never be not called")))})) (defn one-element [required? schema parser] (let [base {:schema schema :parser parser}] (if required? base (optional base)))) (defn optional-tail [schema parser more] (into (optional {:schema schema :parser parser}) more)) prismatic-schema-clojure-1.1.6/src/cljx/schema/spec/core.cljx000064400000000000000000000101231314115420600241340ustar00rootroot00000000000000(ns schema.spec.core "Protocol and preliminaries for Schema 'specs', which are a common language for schemas to use to express their structure." (:require #+clj [schema.macros :as macros] [schema.utils :as utils]) #+cljs (:require-macros [schema.macros :as macros])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Core spec protocol (defprotocol CoreSpec "Specs are a common language for Schemas to express their structure. These two use-cases aren't priveledged, just the two that are considered core to being a Spec." (subschemas [this] "List all subschemas") (checker [this params] "Create a function that takes [data], and either returns a walked version of data (by default, usually just data), or a utils/ErrorContainer containing value that looks like the 'bad' parts of data with ValidationErrors at the leaves describing the failures. params are: subschema-checker, return-walked?, and cache. params is a map specifying: - subschema-checker - a function for checking subschemas - returned-walked? - a boolean specifying whether to return a walked version of the data (otherwise, nil is returned which increases performance) - cache - a map structure from schema to checker, which speeds up checker creation when the same subschema appears multiple times, and also facilitates handling recursive schemas.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Preconditions ;; A Precondition is a function of a value that returns a ;; ValidationError if the value does not satisfy the precondition, ;; and otherwise returns nil. ;; e.g., (s/defschema Precondition (s/=> (s/maybe schema.utils.ValidationError) s/Any)) ;; as such, a precondition is essentially a very simple checker. (def +no-precondition+ (fn [_] nil)) (defn precondition "Helper for making preconditions. Takes a schema, predicate p, and error function err-f. If the datum passes the predicate, returns nil. Otherwise, returns a validation error with description (err-f datum-description), where datum-description is a (short) printable standin for the datum." [s p err-f] (fn [x] (when-let [reason (macros/try-catchall (when-not (p x) 'not) (catch e# 'throws?))] (macros/validation-error s x (err-f (utils/value-name x)) reason)))) (defmacro simple-precondition "A simple precondition where f-sym names a predicate (e.g. (simple-precondition s map?))" [s f-sym] `(precondition ~s ~f-sym #(list (quote ~f-sym) %))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helpers (defn run-checker "A helper to start a checking run, by setting the appropriate params. For examples, see schema.core/checker or schema.coerce/coercer." [f return-walked? s] (f s {:subschema-checker f :return-walked? return-walked? :cache #+clj (java.util.IdentityHashMap.) #+cljs (atom {})})) (defn with-cache [cache cache-key wrap-recursive-delay result-fn] (if-let [w #+clj (.get ^java.util.Map cache cache-key) #+cljs (@cache cache-key)] (if (= ::in-progress w) ;; recursive (wrap-recursive-delay (delay #+clj (.get ^java.util.Map cache cache-key) #+cljs (@cache cache-key))) w) (do #+clj (.put ^java.util.Map cache cache-key ::in-progress) #+cljs (swap! cache assoc cache-key ::in-progress) (let [res (result-fn)] #+clj (.put ^java.util.Map cache cache-key res) #+cljs (swap! cache assoc cache-key res) res)))) (defn sub-checker "Should be called recursively on each subschema in the 'checker' method of a spec. Handles caching and error wrapping behavior." [{:keys [schema error-wrap]} {:keys [subschema-checker cache] :as params}] (let [sub (with-cache cache schema (fn [d] (fn [x] (@d x))) (fn [] (subschema-checker schema params)))] (if error-wrap (fn [x] (let [res (sub x)] (if-let [e (utils/error-val res)] (utils/error (error-wrap res)) res))) sub))) prismatic-schema-clojure-1.1.6/src/cljx/schema/spec/leaf.cljx000064400000000000000000000010021314115420600241070ustar00rootroot00000000000000(ns schema.spec.leaf (:require [schema.spec.core :as spec])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Leaf Specs (defrecord LeafSpec [pre] spec/CoreSpec (subschemas [this] nil) (checker [this params] (fn [x] (or (pre x) x)))) (defn leaf-spec "A leaf spec represents an atomic datum that is checked completely with a single precondition, and is otherwise a black box to Schema." [pre ;- spec/Precondition ] (->LeafSpec pre)) prismatic-schema-clojure-1.1.6/src/cljx/schema/spec/variant.cljx000064400000000000000000000057321314115420600246620ustar00rootroot00000000000000(ns schema.spec.variant (:require #+clj [schema.macros :as macros] [schema.utils :as utils] [schema.spec.core :as spec]) #+cljs (:require-macros [schema.macros :as macros])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variant Specs (defn- option-step [o params else] (let [g (:guard o) c (spec/sub-checker o params) step (if g (fn [x] (let [guard-result (macros/try-catchall (g x) (catch e# ::exception))] (cond (= ::exception guard-result) (macros/validation-error (:schema o) x (list (symbol (utils/fn-name g)) (utils/value-name x)) 'throws?) guard-result (c x) :else (else x)))) c)] (if-let [wrap-error (:wrap-error o)] (fn [x] (let [res (step x)] (if-let [e (utils/error-val res)] (utils/error (wrap-error e)) res))) step))) (defrecord VariantSpec [pre options err-f post] spec/CoreSpec (subschemas [this] (map :schema options)) (checker [this params] (let [t (reduce (fn [f o] (option-step o params f)) (fn [x] (macros/validation-error this x (err-f (utils/value-name x)))) (reverse options))] (if post (fn [x] (or (pre x) (let [v (t x)] (if (utils/error? v) v (or (post (if (:return-walked? params) v x)) v))))) (fn [x] (or (pre x) (t x))))))) (defn variant-spec "A variant spec represents a choice between a set of alternative subschemas, e.g., a tagged union. It has an overall precondition, set of options, and error function. The semantics of `options` is that the options are processed in order. During checking, the datum must match the schema for the first option for which `guard` passes. During generation, any datum generated from an option will pass the corresponding `guard`. err-f is a function to produce an error message if none of the guards match (and must be passed unless the last option has no guard)." ([pre options] (variant-spec pre options nil)) ([pre options err-f] (variant-spec pre options err-f nil)) ([pre ;- spec/Precondition options ;- [{:schema (s/protocol Schema) ;; (s/optional-key :guard) (s/pred fn?) ;; (s/optional-key :error-wrap) (s/pred fn?)}] err-f ;- (s/pred fn?) post ;- (s/maybe spec/Precondition) ] (macros/assert! (or err-f (nil? (:guard (last options)))) "when last option has a guard, err-f must be provided") (->VariantSpec pre options err-f post))) prismatic-schema-clojure-1.1.6/src/cljx/schema/test.cljx000064400000000000000000000011051314115420600232310ustar00rootroot00000000000000(ns schema.test "Utilities for testing with schemas" (:require [schema.core :as s :include-macros true] #+clj clojure.test)) (defn validate-schemas "A fixture for tests: put (use-fixtures :once schema.test/validate-schemas) in your test file to turn on schema validation globally during all test executions." [fn-test] (s/with-fn-validation (fn-test))) #+clj (defmacro deftest "A test with schema validation turned on globally during execution of the body." [name & body] `(clojure.test/deftest ~name (s/with-fn-validation ~@body))) prismatic-schema-clojure-1.1.6/src/cljx/schema/utils.cljx000064400000000000000000000133351314115420600234220ustar00rootroot00000000000000(ns schema.utils "Private utilities used in schema implementation." (:refer-clojure :exclude [record?]) #+clj (:require [clojure.string :as string]) #+cljs (:require goog.string.format [goog.string :as gstring] [clojure.string :as string]) #+cljs (:require-macros [schema.utils :refer [char-map]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Miscellaneous helpers (defn assoc-when "Like assoc but only assocs when value is truthy. Copied from plumbing.core so that schema need not depend on plumbing." [m & kvs] (assert (even? (count kvs))) (into (or m {}) (for [[k v] (partition 2 kvs) :when v] [k v]))) (defn type-of [x] #+clj (class x) #+cljs (js* "typeof ~{}" x)) (defn fn-schema-bearer "What class can we associate the fn schema with? In Clojure use the class of the fn; in cljs just use the fn itself." [f] #+clj (class f) #+cljs f) (defn format* [fmt & args] (apply #+clj format #+cljs gstring/format fmt args)) (def max-value-length (atom 19)) (defn value-name "Provide a descriptive short name for a value." [value] (let [t (type-of value)] (if (<= (count (str value)) @max-value-length) value (symbol (str "a-" #+clj (.getName ^Class t) #+cljs t))))) (defmacro char-map [] clojure.lang.Compiler/CHAR_MAP) (defn unmunge "TODO: eventually use built in demunge in latest cljs." [s] (->> (char-map) (sort-by #(- (count (second %)))) (reduce (fn [^String s [to from]] (string/replace s from (str to))) s))) (defn fn-name "A meaningful name for a function that looks like its symbol, if applicable." [f] #+cljs (unmunge (or (not-empty (second (re-find #"function ([^\(]*)\(" (str f)))) "function")) #+clj (let [s (.getName (class f)) slash (.lastIndexOf s "$") raw (unmunge (if (>= slash 0) (str (subs s 0 slash) "/" (subs s (inc slash))) s))] (string/replace raw #"^clojure.core/" ""))) (defn record? [x] #+clj (instance? clojure.lang.IRecord x) #+cljs (satisfies? IRecord x)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Error descriptions ;; A leaf schema validation error, describing the schema and value and why it failed to ;; match the schema. In Clojure, prints like a form describing the failure that would ;; return true. (declare validation-error-explain) (deftype ValidationError [schema value expectation-delay fail-explanation] #+cljs IPrintWithWriter #+cljs (-pr-writer [this writer opts] (-pr-writer (validation-error-explain this) writer opts))) (defn validation-error-explain [^ValidationError err] (list (or (.-fail-explanation err) 'not) @(.-expectation-delay err))) #+clj ;; Validation errors print like forms that would return false (defmethod print-method ValidationError [err writer] (print-method (validation-error-explain err) writer)) (defn make-ValidationError "for cljs sake (easier than normalizing imports in macros.clj)" [schema value expectation-delay fail-explanation] (ValidationError. schema value expectation-delay fail-explanation)) ;; Attach a name to an error from a named schema. (declare named-error-explain) (deftype NamedError [name error] #+cljs IPrintWithWriter #+cljs (-pr-writer [this writer opts] (-pr-writer (named-error-explain this) writer opts))) (defn named-error-explain [^NamedError err] (list 'named (.-error err) (.-name err))) #+clj ;; Validation errors print like forms that would return false (defmethod print-method NamedError [err writer] (print-method (named-error-explain err) writer)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Monoidish error containers, which wrap errors (to distinguish from success values). (defrecord ErrorContainer [error]) (defn error "Distinguish a value (must be non-nil) as an error." [x] (assert x) (->ErrorContainer x)) (defn error? [x] (instance? ErrorContainer x)) (defn error-val [x] (when (error? x) (.-error ^ErrorContainer x))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Registry for attaching schemas to classes, used for defn and defrecord #+clj (let [^java.util.Map +class-schemata+ (java.util.Collections/synchronizedMap (java.util.WeakHashMap.))] (defn declare-class-schema! [klass schema] "Globally set the schema for a class (above and beyond a simple instance? check). Use with care, i.e., only on classes that you control. Also note that this schema only applies to instances of the concrete type passed, i.e., (= (class x) klass), not (instance? klass x)." (assert (class? klass) (format* "Cannot declare class schema for non-class %s" (class klass))) (.put +class-schemata+ klass schema)) (defn class-schema [klass] "The last schema for a class set by declare-class-schema!, or nil." (.get +class-schemata+ klass))) #+cljs (do (defn declare-class-schema! [klass schema] (aset klass "schema$utils$schema" schema)) (defn class-schema [klass] (aget klass "schema$utils$schema"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Utilities for fast-as-possible reference to use to turn fn schema validation on/off (def use-fn-validation "Turn on run-time function validation for functions compiled when s/compile-fn-validation was true -- has no effect for functions compiled when it is false." ;; specialize in Clojure for performance #+clj (java.util.concurrent.atomic.AtomicReference. false) #+cljs (atom false)) prismatic-schema-clojure-1.1.6/test/000075500000000000000000000000001314115420600173635ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/test/clj/000075500000000000000000000000001314115420600201335ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/test/clj/schema/000075500000000000000000000000001314115420600213735ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/test/clj/schema/experimental/000075500000000000000000000000001314115420600240705ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/test/clj/schema/experimental/complete_test.clj000064400000000000000000000040671314115420600274400ustar00rootroot00000000000000(ns schema.experimental.complete-test (:use clojure.test) (:require [schema.coerce :as coerce] [schema.core :as s] [schema.experimental.abstract-map :as abstract-map] [schema.experimental.complete :as complete])) (deftest complete-test (let [s [{:a s/Int :b s/Str :c [s/Str]}] [r1 r2 r3 :as rs] (complete/complete [{:a 1} {:b "bob"} {:c ["foo" "bar"]}] s)] (is (not (s/check s rs))) (is (= (:a r1) 1)) (is (= (:b r2) "bob")) (is (= (:c r3) ["foo" "bar"]))) (testing "complete through variant" (let [s (s/cond-pre s/Str {:foo s/Int})] (is (= "test" (complete/complete "test" s))) (is (integer? (:foo (complete/complete {} s))))))) (s/defschema Animal (abstract-map/abstract-map-schema :type {:name s/Str})) (abstract-map/extend-schema Cat Animal [:cat] {:claws? s/Bool}) (abstract-map/extend-schema Dog Animal [:dog] {:barks? s/Bool}) (s/defrecord User [id :- long cash :- double friends :- [User] pet :- (s/maybe Animal)]) (def complete-user (complete/completer User {User (fn [x] (if (number? x) {:id x} x)) Animal (fn [x] (if (keyword? x) {:type x} x))})) (defn pull-pattern-matcher [s] (when (and (instance? clojure.lang.APersistentMap s) (not (s/find-extra-keys-schema s))) (fn [x] (select-keys x (->> s keys (map s/explicit-schema-key)))))) (defn pull [s x] ((coerce/coercer s pull-pattern-matcher) x)) (deftest fancy-complete-test (is (s/validate User (complete-user {}))) (is (= {:id 2} (pull {:id long} (complete-user 2)))) (is (= {:id 2 :pet {:type :cat}} (pull {:id s/Any :pet {:type s/Keyword}} (complete-user {:id 2 :pet :cat})))) (is (= {:id 10 :friends [{:id 2} {:id 3}]} (pull {:id s/Any :friends [{:id long}]} (complete-user {:id 10 :friends [2 {:id 3}]})))) (is (= {:id 10 :friends [{:id 2 :pet nil} {:id 3 :pet {:type :dog}}]} (pull {:id s/Any :friends [{:id long :pet (s/maybe {:type s/Keyword})}]} (complete-user {:id 10 :friends [{:id 2 :pet nil} {:id 3 :pet :dog}]}))))) prismatic-schema-clojure-1.1.6/test/clj/schema/experimental/generators_test.clj000064400000000000000000000040601314115420600277720ustar00rootroot00000000000000(ns schema.experimental.generators-test (:use clojure.test) (:require [clojure.test.check.properties :as properties] [clojure.test.check.generators :as check-generators] [clojure.test.check.clojure-test :as check-clojure-test] [schema.core :as s] [schema.experimental.generators :as generators])) (def OGInner {(s/required-key "l") [s/Int] s/Keyword s/Str}) (def OGInner2 {:c OGInner :d s/Str}) (def OGSchema {:a [s/Str] :b OGInner2}) (def FinalSchema {:a (s/eq ["bob"]) :b {:c (s/conditional (fn [{:strs [l]}] (and (every? even? l) (seq l))) OGInner) :d (s/eq "mary")}}) (deftest sample-test (let [res (generators/sample 20 OGSchema {[s/Str] (generators/always ["bob"]) s/Int ((generators/fmap #(inc (* % 2))) check-generators/int)} {[s/Int] (comp (generators/such-that seq) (generators/fmap (partial mapv inc))) OGInner2 (generators/merged {:d "mary"})})] (is (= (count res) 20)) (is (s/validate [FinalSchema] res)))) (deftest simple-leaf-generators-smoke-test (doseq [leaf-schema [double float long int short char byte boolean Double Float Long Integer Short Character Byte Boolean doubles floats longs ints shorts chars bytes booleans s/Str String s/Bool s/Num s/Int s/Keyword s/Symbol s/Inst Object s/Any s/Uuid (s/eq "foo") (s/enum :a :b :c)]] (testing (str leaf-schema) (is (= 10 (count (generators/sample 10 leaf-schema))))))) (def FancySeq "A sequence that starts with a String, followed by an optional Keyword, followed by any number of Numbers." [(s/one s/Str "s") (s/optional s/Keyword "k") s/Num]) (deftest fancy-seq-smoke-test "Catch issues wit a fancier schema with optional keys and such." (is (= 100 (count (generators/sample 100 FancySeq))))) (check-clojure-test/defspec spec-test 100 (properties/for-all [x (generators/generator OGSchema)] (not (s/check OGSchema x)))) prismatic-schema-clojure-1.1.6/test/clj/schema/macros_test.clj000064400000000000000000000027351314115420600244170ustar00rootroot00000000000000(ns schema.macros-test (:use clojure.test) (:require [schema.core :as s] [schema.macros :as macros])) (deftest normalized-defn-args-test (doseq [explicit-meta [{} {:a -1 :c 3}] [schema-attrs schema-forms] {{:schema `s/Any} [] {:schema 'Long :tag 'Long} [:- 'Long]} [doc-attrs doc-forms] {{} [] {:doc "docstring"} ["docstring"]} [attr-map attr-forms] {{} {} {:a 1 :b 2} [{:a 1 :b 2}]}] (let [simple-body ['[x] `(+ 1 1)] full-args (concat [(with-meta 'abc explicit-meta)] schema-forms doc-forms attr-forms simple-body) [name & more] (macros/normalized-defn-args {} full-args)] (testing (vec full-args) (is (= (concat ['abc (merge explicit-meta schema-attrs doc-attrs attr-map) simple-body]) (concat [name (meta name) more]))))))) (deftest compile-fn-validation?-test (is (macros/compile-fn-validation? {} 'foo)) (is (not (macros/compile-fn-validation? {} (with-meta 'foo {:never-validate true})))) (macros/set-compile-fn-validation! false) (is (not (macros/compile-fn-validation? {} 'foo))) (is (not (macros/compile-fn-validation? {} (with-meta 'foo {:always-validate true})))) (macros/set-compile-fn-validation! true) (binding [*assert* false] (is (not (macros/compile-fn-validation? {} 'foo))) (is (macros/compile-fn-validation? {} (with-meta 'foo {:always-validate true}))))) prismatic-schema-clojure-1.1.6/test/clj/schema/test_macros.clj000064400000000000000000000015701314115420600244130ustar00rootroot00000000000000(ns schema.test-macros "Macros to help cross-language testing of schemas." (:require clojure.test [schema.core :as s] [schema.macros :as sm] [schema.spec.core :as spec])) (defmacro valid! "Assert that x satisfies schema s, and the walked value is equal to the original." [s x] `(let [x# ~x] (~'is (= x# ((spec/run-checker #(spec/checker (s/spec %1) %2) true ~s) x#))))) (defmacro invalid! "Assert that x does not satisfy schema s, optionally checking the stringified return value" ([s x] `(~'is (s/check ~s ~x))) ([s x expected] `(do (invalid! ~s ~x) (sm/if-cljs nil (~'is (= ~expected (pr-str (s/check ~s ~x)))))))) (defmacro invalid-call! "Assert that f throws (presumably due to schema validation error) when called on args." [f & args] (when (sm/compile-fn-validation? &env f) `(~'is (~'thrown? ~'Throwable (~f ~@args))))) prismatic-schema-clojure-1.1.6/test/cljx/000075500000000000000000000000001314115420600203235ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/test/cljx/schema/000075500000000000000000000000001314115420600215635ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/test/cljx/schema/coerce_test.cljx000064400000000000000000000101101314115420600247350ustar00rootroot00000000000000(ns schema.coerce-test #+clj (:use clojure.test) #+cljs (:use-macros [cemerick.cljs.test :only [is deftest]]) (:require [schema.core :as s] [schema.utils :as utils] [schema.coerce :as coerce] #+cljs cemerick.cljs.test)) ;; s/Num s/Int (def Generic {:i s/Int (s/optional-key :b) s/Bool (s/optional-key :n) s/Num (s/optional-key :s) s/Str (s/optional-key :k1) {s/Int s/Keyword} (s/optional-key :k2) s/Keyword (s/optional-key :e) (s/enum :a :b :c) (s/optional-key :eq) (s/eq :k) (s/optional-key :set) #{s/Keyword} (s/optional-key :u) s/Uuid}) (def JSON {(s/optional-key :is) [s/Int]}) #+clj (def JVM {(s/optional-key :jb) Boolean (s/optional-key :l) long (s/optional-key :d) Double (s/optional-key :f) Float (s/optional-key :jk) clojure.lang.Keyword}) (defn err-ks [res] (set (keys (utils/error-val res)))) (deftest json-coercer-test (let [coercer (coerce/coercer (merge Generic JSON) coerce/json-coercion-matcher) res {:i 1 :is [1 2] :n 3.0 :s "asdf" :k1 {1 :hi} :k2 :bye :e :a :eq :k :set #{:a :b}}] (is (= res (coercer {:i 1.0 :is [1.0 2.0] :n 3.0 :s "asdf" :k1 {1.0 "hi"} :k2 "bye" :e "a" :eq "k" :set ["a" "a" "b"]}))) (is (= res (coercer res))) (is (= {:i 1 :b true} (coercer {:i 1.0 :b "TRUE"}))) (is (= {:i 1 :b false} (coercer {:i 1.0 :b "Yes"}))) (is (= #{:i :set} (err-ks (coercer {:i 1.1 :n 3 :set "a"}))))) #+clj (testing "jvm specific" (let [coercer (coerce/coercer JVM coerce/json-coercion-matcher) res {:l 1 :d 1.0 :jk :asdf :f (float 0.1)}] (is (= res (coercer {:l 1.0 :d 1 :jk "asdf" :f 0.1}) )) (is (= res (coercer res))) (is (= {:jb true} (coercer {:jb "TRUE"}))) (is (= {:jb false} (coercer {:jb "Yes"}))) (is (= #{:l :jk :f} (err-ks (coercer {:l 1.2 :jk 1.0 :f "0"})))) (is (= #{:f} (err-ks (coercer {:f nil})))) (is (= #{:d} (err-ks (coercer {:d nil})))) (is (= #{:d} (err-ks (coercer {:d "1.0"})))))) #+clj (testing "malformed uuid" (let [coercer (coerce/coercer Generic coerce/json-coercion-matcher)] (is (= #{:u} (err-ks (coercer {:i 1 :u "uuid-wannabe"}))))))) (deftest string-coercer-test (let [coercer (coerce/coercer Generic coerce/string-coercion-matcher)] (is (= {:b true :i 1 :n 3.0 :s "asdf" :k1 {1 :hi} :k2 :bye :e :a :eq :k :u #uuid "550e8400-e29b-41d4-a716-446655440000" :set #{:a :b}} (coercer {:b "true" :i "1" :n "3.0" :s "asdf" :k1 {"1" "hi"} :k2 "bye" :e "a" :eq "k" :u "550e8400-e29b-41d4-a716-446655440000" :set ["a" "a" "b"]}))) (is (= #{:i} (err-ks (coercer {:i "1.1"}))))) #+clj (testing "jvm specific" (let [coercer (coerce/coercer JVM coerce/string-coercion-matcher) res {:jb false :l 2 :d 1.0 :jk :asdf}] (is (= res (coercer {:jb "false" :l "2.0" :d "1" :jk "asdf"}))) (is (= #{:l} (err-ks (coercer {:l "1.2"}))))))) (deftest coercer!-test (let [coercer (coerce/coercer! {:k s/Keyword :i s/Int} coerce/string-coercion-matcher)] (is (= {:k :key :i 12} (coercer {:k "key" :i "12"}))) (is (thrown-with-msg? #+clj Exception #+cljs js/Error #"keyword\? 12" (coercer {:k 12 :i 12}))))) #+clj (do (def NestedVecs [(s/one s/Num "Node ID") (s/recursive #'NestedVecs)]) (deftest recursive-coercion-test "Test that recursion (which rebinds subschema-walker) works with coercion." (is (= [1 [2 [3] [4]]] ((coerce/coercer NestedVecs coerce/string-coercion-matcher) ["1" ["2" ["3"] ["4"]]]))))) (deftest constrained-test (is (= 1 ((coerce/coercer! (s/constrained s/Int odd?) coerce/string-coercion-matcher) "1"))) (is (= {1 1} ((coerce/coercer! (s/constrained {s/Int s/Int} #(odd? (count %))) coerce/string-coercion-matcher) {"1" "1"})))) (deftest map-entry-test (let [entry (first {:foo :bar}) coercer (coerce/coercer! (s/map-entry s/Any s/Any) (constantly nil)) coerced-value (coercer entry)] (is (= entry coerced-value)) (is (= (type entry) (type coerced-value))))) prismatic-schema-clojure-1.1.6/test/cljx/schema/core_test.cljx000064400000000000000000001404141314115420600244400ustar00rootroot00000000000000(ns schema.core-test "Tests for schema. Uses helpers defined in schema.test-macros (for cljs sake): - (valid! s x) asserts that (s/check s x) returns nil - (invalid! s x) asserts that (s/check s x) returns a validation failure - The optional last argument also checks the printed Clojure representation of the error. - (invalid-call! s x) asserts that calling the function throws an error." #+clj (:use clojure.test [schema.test-macros :only [valid! invalid! invalid-call!]]) #+cljs (:use-macros [cemerick.cljs.test :only [is deftest testing are]] [schema.test-macros :only [valid! invalid! invalid-call!]]) #+cljs (:require-macros [schema.macros :as macros]) (:require [clojure.string :as str] #+clj [clojure.pprint :as pprint] clojure.data [schema.utils :as utils] [schema.core :as s] [schema.spec.core :as spec] [schema.spec.collection :as collection] #+clj [schema.macros :as macros] #+cljs cemerick.cljs.test)) #+cljs (do (def Exception js/Error) (def AssertionError js/Error) (def Throwable js/Error)) (deftest if-cljs-test (is (= #+cljs true #+clj false (macros/if-cljs true false)))) (deftest try-catchall-test (let [a (atom 0)] (is (= 2 (macros/try-catchall (reset! a 1) (swap! a inc) (catch e (swap! a - 10))))) (is (= 2 @a))) (let [a (atom 0)] (is (= -9 (macros/try-catchall (reset! a 1) (swap! a #(throw (macros/error! (str %)))) (catch e (swap! a - 10))))) (is (= -9 @a)))) (deftest validate-return-test (is (= 1 (s/validate s/Int 1)))) (defn foo-bar []) (deftest fn-name-test (is (= "odd?" (utils/fn-name odd?))) (is (= #+clj "schema.core-test/foo-bar" #+cljs "foo-bar" (utils/fn-name foo-bar))) #+clj (is (= "schema.core-test$fn" (subs (utils/fn-name (fn foo [x] (+ x x))) 0 19))) #+cljs (is (= "foo" (utils/fn-name (fn foo [x] (+ x x))))) #+cljs (is (= "function" (utils/fn-name (fn [x] (+ x x)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Platform-specific leaf Schemas #+clj (do (deftest class-test (valid! String "a") (invalid! String nil "(not (instance? java.lang.String nil))") (invalid! String :a "(not (instance? java.lang.String :a))")) (deftest primitive-test (valid! double 1.0) (invalid! double (float 1.0) "(not (instance? java.lang.Double 1.0))") (valid! float (float 1.0)) (invalid! float 1.0) (valid! long 1) (invalid! long (byte 1)) (valid! boolean true) (invalid! boolean 1) (valid! longs (long-array 10)) (invalid! longs (int-array 10)) (doseq [f [byte char short int]] (valid! f (f 1)) (invalid! f 1)) (is (= 'double (s/explain double)))) (deftest array-test (valid! (Class/forName"[Ljava.lang.String;") (into-array String ["a"])) (invalid! (Class/forName "[Ljava.lang.Long;") (into-array String ["a"])) (valid! (Class/forName "[Ljava.lang.Double;") (into-array Double [1.0])) (valid! (Class/forName "[D") (double-array [1.0])) (invalid! (Class/forName "[D") (into-array Double [1.0])) (valid! doubles (double-array [1.0])) (is (= 'doubles (s/explain doubles))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Cross-platform Schema leaves (deftest any-test (valid! s/Any 10) (valid! s/Any nil) (valid! s/Any :whatever) (is (= 'Any (s/explain s/Any)))) (deftest eq-test (let [schema (s/eq 10)] (valid! schema 10) (invalid! schema 9 "(not (= 10 9))") (is (= '(eq 10) (s/explain schema))))) (deftest isa-test (let [h (make-hierarchy) h (derive h ::square ::shape) schema-with-h (s/isa h ::shape) schema-no-h (s/isa ::number)] (derive ::integer ::number) (valid! schema-with-h ::square) (valid! schema-no-h ::integer) (invalid! schema-with-h ::form) (invalid! schema-no-h ::form) #+clj (valid! (s/isa java.lang.Number) java.lang.Long) #+cljs (valid! (s/isa js/Number) js/Number) (is (= '(isa? ::shape) (s/explain schema-with-h))) (is (= '(isa? ::number) (s/explain schema-no-h))))) (deftest enum-test (let [schema (s/enum :a :b 1)] (valid! schema :a) (valid! schema 1) (invalid! schema :c) (invalid! (s/enum :a) 2 "(not (#{:a} 2))") (is (= '(1 :a :b enum) (sort-by str (s/explain schema)))))) (deftest pred-test (let [schema (s/pred odd? 'odd?)] (valid! schema 1) (invalid! schema 2 "(not (odd? 2))") (invalid! schema :foo "(throws? (odd? :foo))") (is (= '(pred odd?) (s/explain schema))) (invalid! (s/pred odd?) 2 "(not (odd? 2))"))) (defprotocol ATestProtocol) (s/defn ^:always-validate a-test-protocol-fn "Compile the schema before extending, make sure it works as expected" [x :- (s/protocol ATestProtocol)] x) (defrecord DirectTestProtocolSatisfier [] ATestProtocol) (defrecord IndirectTestProtocolSatisfier []) (extend-type IndirectTestProtocolSatisfier ATestProtocol) (defrecord NonTestProtocolSatisfier []) (deftest protocol-test (let [schema (s/protocol ATestProtocol)] (valid! schema (DirectTestProtocolSatisfier.)) (valid! schema (IndirectTestProtocolSatisfier.)) (invalid! schema (NonTestProtocolSatisfier.)) (invalid! schema nil) (invalid! schema 117 "(not (satisfies? ATestProtocol 117))") (is (a-test-protocol-fn (DirectTestProtocolSatisfier.))) (is (a-test-protocol-fn (IndirectTestProtocolSatisfier.))) (invalid-call! a-test-protocol-fn (NonTestProtocolSatisfier.)) (is (= '(protocol ATestProtocol) (s/explain schema))))) (deftest regex-test (valid! #"lex" "Alex B") (valid! #"lex" "lex") (invalid! #"lex" nil "(not (string? nil))") (invalid! #"lex" "Ale" "(not (re-find #\"lex\" \"Ale\"))") (is (= (symbol "#\"lex\"") (s/explain #"lex")))) (deftest leaf-bool-test (valid! s/Bool true) (invalid! s/Bool nil "(not (instance? java.lang.Boolean nil))") (is (= 'Bool (s/explain s/Bool)))) (deftest leaf-string-test (valid! s/Str "asdf") (invalid! s/Str nil "(not (instance? java.lang.String nil))") (invalid! s/Str :a "(not (instance? java.lang.String :a))") (is (= 'Str (s/explain s/Str)))) (deftest leaf-number-test (valid! s/Num 1) (valid! s/Num 1.2) (valid! s/Num (/ 1 2)) (invalid! s/Num nil "(not (instance? java.lang.Number nil))") (invalid! s/Num "1" "(not (instance? java.lang.Number \"1\"))") (is (= 'Num (s/explain s/Num)))) (deftest leaf-int-test (valid! s/Int 1) (invalid! s/Int 1.2 "(not (integer? 1.2))") #+clj (invalid! s/Int 1.0 "(not (integer? 1.0))") (invalid! s/Int nil "(not (integer? nil))") (is (= 'Int (s/explain s/Int)))) (deftest leaf-keyword-test (valid! s/Keyword :a) (valid! s/Keyword ::a) (invalid! s/Keyword nil "(not (keyword? nil))") (invalid! s/Keyword ":a" "(not (keyword? \":a\"))") (is (= 'Keyword (s/explain s/Keyword)))) (deftest leaf-symbol-test (valid! s/Symbol 'foo) (invalid! s/Symbol nil "(not (symbol? nil))") (invalid! s/Symbol "'a" "(not (symbol? \"'a\"))") (is (= 'Symbol (s/explain s/Symbol)))) (deftest leaf-regex-test (valid! s/Regex #".*") (invalid! s/Regex ".*") (is (= 'Regex (s/explain s/Regex)))) (deftest leaf-inst-test (valid! s/Inst #inst "2013-01-01T01:15:01.840-00:00") (invalid! s/Inst "2013-01-01T01:15:01.840-00:00") (is (= 'Inst (s/explain s/Inst)))) (deftest leaf-uuid-test (valid! s/Uuid #uuid "0e98ce5b-9aca-4bf7-b5fd-d90576c80fdf") (invalid! s/Uuid "0e98ce5b-9aca-4bf7-b5fd-d90576c80fdf") (is (= 'Uuid (s/explain s/Uuid)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Simple composite Schemas (deftest maybe-test (let [schema (s/maybe s/Int)] (valid! schema nil) (valid! schema 1) (invalid! schema 1.1 "(not (integer? 1.1))") (is (= '(maybe Int) (s/explain schema))))) (deftest named-test (let [schema (s/named s/Int :score)] (valid! schema 12) (invalid! schema :a "(named (not (integer? :a)) :score)") (is (= '(named Int :score) (s/explain schema))))) (deftest either-test (let [schema (s/either {:num s/Int} {:str s/Str})] (valid! schema {:num 1}) (valid! schema {:str "hello"}) (invalid! schema {:num "bad!"}) (invalid! schema {:str 1}) (is (= '(either {:a Int} Int) (s/explain (s/either {:a s/Int} s/Int)))) (is (s/explain schema)))) (deftest both-test (let [schema (s/both (s/pred (fn equal-keys? [m] (every? (fn [[k v]] (= k v)) m)) 'equal-keys?) {s/Keyword s/Keyword})] (valid! schema {}) (valid! schema {:foo :foo :bar :bar}) (invalid! schema {"foo" "foo"}) (invalid! schema {:foo :bar} "(not (equal-keys? {:foo :bar}))") (invalid! schema {:foo 1} "(not (equal-keys? {:foo 1}))") (is (= '(both (pred vector?) [Int]) (s/explain (s/both (s/pred vector? 'vector?) [s/Int])))))) (deftest conditional-test (let [schema (s/conditional #(= (:type %) :foo) {:type (s/eq :foo) :baz s/Num} #(= (:type %) :bar) {:type (s/eq :bar) :baz s/Str})] (valid! schema {:type :foo :baz 10}) (valid! schema {:type :bar :baz "10"}) (invalid! schema {:type :foo :baz "10"}) (invalid! schema {:type :bar :baz 10} "{:baz (not (instance? java.lang.String 10))}") (invalid! schema {:type :zzz :baz 10} "(not (some-matching-condition? a-clojure.lang.PersistentArrayMap))") (is (s/explain schema))) (testing "as simple constraint" (let [schema (s/conditional (fn [m] (every? (fn [[k v]] (= k v)) m)) {s/Keyword s/Keyword} 'equal-keys?)] (valid! schema {}) (valid! schema {:foo :foo :bar :bar}) (invalid! schema {"foo" "foo"}) (invalid! schema {:foo :bar} "(not (equal-keys? {:foo :bar}))") (invalid! schema {:foo 1} "(not (equal-keys? {:foo 1}))") (invalid! (s/conditional odd? s/Int) 2 "(not (odd? 2))") (invalid! (s/conditional odd? s/Int) "1" "(throws? (odd? \"1\"))") (is (= '(conditional odd? Int) (s/explain (s/conditional odd? s/Int)))) (is (= '(conditional odd? Int weird?) (s/explain (s/conditional odd? s/Int 'weird?))))))) (deftest cond-pre-test (let [s (s/cond-pre s/Int (s/maybe s/Str) (s/cond-pre s/Keyword {:x s/Int}) (s/both [s/Num] (s/pred (fn [xs] (even? (count xs))) 'even-len?)) [s/Str])] (valid! s 1) (valid! s "hello") (valid! s nil) (valid! s :hello) (valid! s {:x 3}) (valid! s [1 2]) (valid! s ["hello"]) (invalid! s 3.14) (invalid! s [1 2 3]) (invalid! s {:x 3.14}) (invalid! s [1 2 3]))) (deftest constrained-test (let [s (s/constrained s/Int odd?)] (is (= '(constrained Int odd?) (s/explain s))) (valid! s 1) (valid! s 5) (invalid! s 2 "(not (odd? 2))") (invalid! s "2" "(not (integer? \"2\"))") (invalid! (s/constrained s/Str odd?) "2" "(throws? (odd? \"2\"))" )) (let [s (s/constrained {:a s/Int} #(odd? (:a %)))] (valid! s {:a 1}) (invalid! s {:b 1}) (invalid! s {:a 2}))) (deftest if-test (let [schema (s/if #(= (:type %) :foo) {:type (s/eq :foo) :baz s/Num} {:type (s/eq :bar) :baz s/Str})] (valid! schema {:type :foo :baz 10}) (valid! schema {:type :bar :baz "10"}) (invalid! schema {:type :foo :baz "10"}) (invalid! schema {:type :bar :baz 10}) (invalid! schema {:type :zzz :baz 10}))) (def NestedVecs [(s/one s/Num "Node ID") (s/recursive #'NestedVecs)]) (def NestedMaps {:node-id s/Num (s/optional-key :children) [(s/recursive #'NestedMaps)]}) (declare TestBlackNode) (def TestRedNode {(s/optional-key :red) (s/recursive #'TestBlackNode)}) (def TestBlackNode {:black TestRedNode}) (deftest recursive-test (valid! NestedVecs [1 [2 [3 [4]]]]) (invalid! NestedVecs [1 [2 ["invalid-id" [4]]]]) (invalid! NestedVecs [1 [2 [3 "invalid-content"]]]) (valid! NestedMaps {:node-id 1 :children [{:node-id 1 :children [{:node-id 4}]} {:node-id 3}]}) (invalid! NestedMaps {:node-id 1 :children [{:invalid-node-id 1 :children [{:node-id 4}]} {:node-id 3}]}) (invalid! NestedMaps {:node-id 1 :children [{:node-id 1 :children [{:node-id 4}]} {:node-id "invalid-id"}]}) (valid! TestBlackNode {:black {}}) (valid! TestBlackNode {:black {:red {:black {}}}}) (invalid! TestBlackNode {:black {:black {}}}) (invalid! TestBlackNode {:black {:red {}}}) (let [rec (atom nil) schema {(s/optional-key :x) (s/recursive rec)}] (reset! rec schema) (valid! schema {}) (valid! schema {:x {:x {:x {}}}}) (invalid! schema {:x {:x {:y {}}}}) (let [explanation (first (s/explain schema))] (is (= '(optional-key :x) (key explanation))) #+clj (is (= 'recursive (first (val explanation)))) #+clj (is (re-matches #"clojure.lang.Atom.*" (second (val explanation)))) #+cljs (is (= '(recursive ...) (val explanation))))) (is (= '{:black {(optional-key :red) (recursive (var schema.core-test/TestBlackNode))}} (s/explain TestBlackNode)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Atom schemas (deftest atom-test (let [s (s/atom s/Str)] (is (not (s/check s (atom "asdf")))) ;; don't expect identity after walking (invalid! s (delay "asdf") "(not (atom? a-clojure.lang.Delay))") (invalid! s (atom 1)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Map Schemas (deftest uniform-map-test (let [schema {s/Keyword s/Int}] (valid! schema {}) (valid! schema {:a 1 :b 2}) (invalid! schema {'a 1 :b 2} "{(not (keyword? a)) invalid-key}") (invalid! schema {:a :b} "{:a (not (integer? :b))}") (is (= '{Keyword Int} (s/explain {s/Keyword s/Int}))))) (deftest simple-specific-key-map-test (let [schema-args [:foo s/Keyword :bar s/Int]] (doseq [[t schema] {"hash-map" (apply hash-map schema-args) "array-map" (apply array-map schema-args)}] (testing t (valid! schema {:foo :a :bar 2}) (invalid! schema [[:foo :a] [:bar 2]] "(not (map? a-clojure.lang.PersistentVector))") (invalid! schema {:foo :a} "{:bar missing-required-key}") (invalid! schema {:foo :a :bar 2 :baz 1} "{:baz disallowed-key}") (invalid! schema {:foo :a :bar 1.5} "{:bar (not (integer? 1.5))}") (is (= '{:foo Keyword, :bar Int} (s/explain schema))))))) (deftest fancier-map-schema-test (let [schema {:foo s/Int s/Str s/Num}] (valid! schema {:foo 1}) (valid! schema {:foo 1 "bar" 2.0}) (valid! schema {:foo 1 "bar" 2.0 "baz" 10.0}) (invalid! schema {:foo 1 :bar 2.0}) (invalid! schema {:foo 1 :bar 2.0}) (invalid! schema {:foo 1 :bar 2.0 "baz" 2.0}) (invalid! schema {:foo 1 "bar" "a"}))) (deftest another-fancy-map-schema-test (let [schema {:foo (s/maybe s/Int) (s/optional-key :bar) s/Num :baz {:b1 (s/pred odd?)} s/Keyword s/Any}] (valid! schema {:foo 1 :bar 1.0 :baz {:b1 3}}) (valid! schema {:foo 1 :baz {:b1 3}}) (valid! schema {:foo nil :baz {:b1 3}}) (valid! schema {:foo nil :baz {:b1 3} :whatever "whatever"}) (invalid! schema {:foo 1 :bar 1.0 :baz [[:b1 3]]}) (invalid! schema {:foo 1 :bar 1.0 :baz {:b2 3}}) (invalid! schema {:foo 1 :bar 1.0 :baz {:b1 4}}) (invalid! schema {:bar 1.0 :baz {:b1 3}}) (invalid! schema {:foo 1 :bar nil :baz {:b1 3}}) (invalid! schema {:foo 1 :bar "z" :baz {:b1 3}}))) (deftest throw-on-multiple-key-variants-test (is (thrown? Exception (s/checker {:foo s/Str (s/optional-key :foo) s/Str}))) (is (thrown? Exception (s/checker {(s/required-key "A") s/Str (s/optional-key "A") s/Str})))) (defprotocol SomeProtocol (stuff [this])) (defrecord SomeRecord [x y z] SomeProtocol (stuff [_] x)) (deftest keys-and-protocol-test (let [field-subset {:x s/Keyword :y s/Num s/Keyword s/Any} schema (s/conditional #(satisfies? SomeProtocol %) field-subset)] (is (not (s/check schema (->SomeRecord :foo 42 "extra")))) ;; comes out as map (invalid! schema {:x :foo :y 42}))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Handle Struct #+clj (do (defstruct ts1 :num :str :map :vec) (defstruct ts2 :num :str) (deftest struct-tests (let [schema {(s/required-key :num) s/Num (s/required-key :str) s/Str (s/required-key :map) {s/Keyword s/Str} (s/required-key :vec) [s/Num] (s/optional-key :opt) s/Num}] (valid! schema (struct ts1 1 "str" {:key "str"} [1])) (valid! schema {:num 1 :str "str" :map {:key "str"} :vec [1]}) (valid! schema (struct ts1 1 "str" (struct ts1 "a" "b" "c" "d") [1])) (valid! schema (assoc (struct ts1 1 "str" {:key "str"} [1]) :opt 1)) (valid! schema (assoc (struct ts2 1 "str") :map {} :vec [])) (invalid! schema (struct ts1 "str" "str" {:key "str"} [1])) (invalid! schema (struct ts1 1 1 {:key "str"} [1])) (invalid! schema (struct ts1 1 "str" {"str" "str"} [1])) (invalid! schema (struct ts1 1 "str" {:key 1} [1])) (invalid! schema (struct ts1 1 "str" {:key "str"} 1)) (invalid! schema (struct ts1 1 "str" {:key "str"} ["str"])) (invalid! schema (assoc (struct ts1 1 "str" {:key "str"} [1]) :opt "str")) (invalid! schema (assoc (struct ts1 1 "str" {:key "str"} [1]) :extra-key 1)) (invalid! schema (struct ts2 1 "str")) (invalid! schema (assoc (struct ts2 1 "str") :map {:key 1} :vec []))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Set Schemas (deftest simple-set-test (testing "set schemas must have exactly one entry" (is (thrown? Exception (s/check #{s/Int s/Num} #{}))) (is (thrown? Exception (s/check #{} #{})))) (testing "basic set identification" (let [schema #{s/Keyword}] (valid! schema #{:a :b :c}) (invalid! schema [:a :b :c] "(not (set? [:a :b :c]))") (invalid! schema {:a :a :b :b}) (is (= '#{Keyword} (s/explain schema))))) (testing "enforces matching with single simple entry" (let [schema #{s/Int}] (valid! schema #{}) (valid! schema #{1 2 3}) (invalid! schema #{1 :a} "#{(not (integer? :a))}") (invalid! schema #{:a "c" {}}))) (testing "more complex element schema" (let [schema #{[s/Int]}] (valid! schema #{}) (valid! schema #{[2 4] [3 6]}) (invalid! schema #{2}) (invalid! schema #{[[2 3]]})))) (deftest mixed-set-test (let [schema #{(s/either [s/Int] #{s/Int})}] (valid! schema #{}) (valid! schema #{[3 4] [56 1] [-11 3]}) (valid! schema #{#{3 4} #{56 1} #{-11 3}}) (valid! schema #{[3 4] #{56 1} #{-11 3}}) (invalid! schema #{#{[3 4]}}) (invalid! schema #{[[3 4]]}))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Queue Schemas (deftest queue-test (testing "queues of simple values" (let [schema (s/queue s/Int)] (valid! schema (s/as-queue [])) (valid! schema (s/as-queue [1])) (valid! schema (s/as-queue [1 2 3 4])) (invalid! schema [1 2 3]) (invalid! schema (s/as-queue [1 :a 3]))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Sequence Schemas (deftest simple-repeated-seq-test (let [schema [s/Int]] (valid! schema []) (valid! schema [1 2 3]) (invalid! schema {}) #+clj (invalid! schema [1 2 1.0]) (invalid! schema [1 2 1.1]))) (deftest simple-one-seq-test (let [schema [(s/one s/Int "int") (s/one s/Str "str")]] (valid! schema [1 "a"]) (invalid! schema [1]) (invalid! schema [1 1.0 2]) (invalid! schema [1 1]) (invalid! schema [1.0 1.0]))) (deftest optional-seq-test (let [schema [(s/one s/Int "int") (s/optional s/Str "str") (s/optional s/Int "int2")]] (valid! schema [1]) (valid! schema [1 "a"]) (valid! schema [1 "a" 2]) (invalid! schema []) (invalid! schema [1 "a" 2 3]) (invalid! schema [1 1]))) (deftest combo-seq-test (let [schema [(s/one (s/maybe s/Int) :maybe-long) (s/optional s/Keyword :key) s/Int]] (valid! schema [1]) (valid! schema [1 :a]) (valid! schema [1 :a 1 2 3]) (valid! schema [nil :b 1 2 3]) (invalid! schema {} "(not (sequential? {}))") (invalid! schema "asdf" "(not (sequential? \"asdf\"))") (invalid! schema [nil 1 1 2 3] "[nil (named (not (keyword? 1)) :key) nil nil nil]") (invalid! schema [1.4 :A 2 3] "[(named (not (integer? 1.4)) :maybe-long) nil nil nil]") (invalid! schema [] "[(not (present? :maybe-long))]") (is (= '[(one (maybe Int) :maybe-long) (optional Keyword :key) Int] (s/explain schema))))) (deftest pair-test (let [schema (s/pair s/Str "user-name" s/Int "count")] (valid! schema ["user1" 42]) (invalid! schema ["user2" 42.1]) (invalid! schema [42 "user1"]) (invalid! schema ["user1" 42 42]) (valid! schema ["user2" 41]) )) #+clj (deftest java-list-test (let [schema [s/Str]] (valid! schema (java.util.ArrayList. ["hi" "bye"])) (invalid! schema (java.util.ArrayList. [1 2])) (valid! schema (java.util.LinkedList. ["hi" "bye"])) (invalid! schema (java.util.LinkedList. [1 2])) (valid! schema java.util.Collections/EMPTY_LIST) (invalid! schema java.util.Collections/EMPTY_MAP) (invalid! schema #{"hi" "bye"}))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Record Schemas (defrecord Foo [x y]) (deftest record-test (let [schema (s/record Foo {:x s/Any (s/optional-key :y) s/Int})] (valid! schema (Foo. :foo 1)) (invalid! schema {:x :foo :y 1}) (invalid! schema (assoc (Foo. :foo 1) :bar 2)) #+clj (is (= '(record schema.core_test.Foo {:x Any, (optional-key :y) Int}) (s/explain schema))))) (deftest record-with-extra-keys-test (let [schema (s/record Foo {:x s/Any :y s/Int s/Keyword s/Any})] (valid! schema (Foo. :foo 1)) (valid! schema (assoc (Foo. :foo 1) :bar 2)) (invalid! schema {:x :foo :y 1}))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Function Schemas (deftest single-arity-fn-schema-test (let [schema (s/=> s/Keyword s/Int s/Int)] (valid! schema (fn [x y] (keyword (str (+ x y))))) (valid! schema (fn [])) ;; we don't actually validate what the function does (valid! schema {}) (is (= '(=> Keyword Int Int) (s/explain schema))))) (deftest single-arity-and-more-fn-schema-test (let [schema (s/=> s/Keyword s/Int s/Int & [s/Keyword])] (valid! schema (fn [])) ;; we don't actually validate what the function does (valid! schema {}) (is (= '(=> Keyword Int Int & [Keyword]) (s/explain schema))))) (deftest multi-arity-fn-schema-test (let [schema (s/=>* s/Keyword [s/Int] [s/Int & [s/Keyword]])] (valid! schema (fn [])) ;; we don't actually validate what the function does (valid! schema {}) (is (= '(=>* Keyword [Int] [Int & [Keyword]]) (s/explain schema))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Schematized defrecord (defmacro test-normalized-meta [symbol ex-schema desired-meta] (let [normalized (macros/normalized-metadata &env symbol ex-schema)] `(do (is (= '~symbol '~normalized)) (is (= ~(select-keys desired-meta [:schema :tag]) ~(select-keys (meta normalized) [:schema :tag])))))) #+clj (do (def ASchema [long]) (deftest normalized-metadata-test (testing "empty" (test-normalized-meta 'foo nil {:schema s/Any})) (testing "primitive" (test-normalized-meta ^long foo nil {:tag long :schema long})) (testing "class" (test-normalized-meta ^String foo nil {:tag String :schema String})) (testing "non-tag" (test-normalized-meta ^ASchema foo nil {:schema ASchema})) (testing "explicit" (test-normalized-meta ^Object foo String {:tag Object :schema String}))) (defmacro test-meta-extraction [meta-form arrow-form] (let [meta-ized (macros/process-arrow-schematized-args {} arrow-form)] `(do (is (= '~meta-form '~meta-ized)) (is (= ~(mapv #(select-keys (meta (macros/normalized-metadata {} % nil)) [:schema :tag]) meta-form) ~(mapv #(select-keys (meta %) [:schema :tag]) meta-ized)))))) (deftest extract-arrow-schematized-args-test (testing "empty" (test-meta-extraction [] [])) (testing "no-tag" (test-meta-extraction [x] [x])) (testing "old-tags" (test-meta-extraction [^String x] [^String x])) (testing "new-vs-old-tag" (test-meta-extraction [^String x] [x :- String])) (testing "multi vars" (test-meta-extraction [x ^String y z] [x y :- String z])))) (defprotocol PProtocol (do-something [this])) ;; exercies some different arities (s/defrecord Bar [^s/Int foo ^s/Str bar] {(s/optional-key :baz) s/Keyword}) (s/defrecord Bar2 [^s/Int foo ^s/Str bar] {(s/optional-key :baz) s/Keyword} PProtocol (do-something [this] 2)) (s/defrecord Bar3 [^s/Int foo ^s/Str bar] PProtocol (do-something [this] 3)) (s/defrecord Bar4 [foo :- [s/Int] bar :- (s/maybe {s/Str s/Str})] PProtocol (do-something [this] 4)) (deftest defrecord-schema-test (is (= (utils/class-schema Bar) (s/record Bar {:foo s/Int :bar s/Str (s/optional-key :baz) s/Keyword}))) (is (identity (Bar. 1 :foo))) (is (= #{:foo :bar} (set (keys (map->Bar {:foo 1}))))) ;; (is (thrown? Exception (map->Bar {}))) ;; check for primitive long (valid! Bar (Bar. 1 "test")) (invalid! Bar (Bar. 1 :foo)) (valid! Bar (assoc (Bar. 1 "test") :baz :foo)) (invalid! Bar (assoc (Bar. 1 "test") :baaaz :foo)) (invalid! Bar (assoc (Bar. 1 "test") :baz "foo")) (valid! Bar2 (assoc (Bar2. 1 "test") :baz :foo)) (invalid! Bar2 (assoc (Bar2. 1 "test") :baaaaz :foo)) (is (= 2 (do-something (Bar2. 1 "test")))) (valid! Bar3 (Bar3. 1 "test")) (invalid! Bar3 (assoc (Bar3. 1 "test") :foo :bar)) (is (= 3 (do-something (Bar3. 1 "test")))) (valid! Bar4 (Bar4. [1] {"test" "test"})) (valid! Bar4 (Bar4. [1] nil)) (invalid! Bar4 (Bar4. ["a"] {"test" "test"})) (is (= 4 (do-something (Bar4. 1 "test"))))) (s/defrecord BarNewStyle [foo :- s/Int bar :- s/Str zoo] {(s/optional-key :baz) s/Keyword}) (deftest defrecord-new-style-schema-test (is (= (utils/class-schema BarNewStyle) (s/record BarNewStyle {:foo s/Int :bar s/Str :zoo s/Any (s/optional-key :baz) s/Keyword}))) (is (identity (BarNewStyle. 1 :foo "a"))) (is (= #{:foo :bar :zoo} (set (keys (map->BarNewStyle {:foo 1}))))) ;; (is (thrown? Exception (map->BarNewStyle {}))) ;; check for primitive long (valid! BarNewStyle (BarNewStyle. 1 "test" "a")) (invalid! BarNewStyle (BarNewStyle. 1 :foo "a")) (valid! BarNewStyle (assoc (BarNewStyle. 1 "test" "a") :baz :foo)) (invalid! BarNewStyle (assoc (BarNewStyle. 1 "test" "a") :baaaz :foo)) (invalid! BarNewStyle (assoc (BarNewStyle. 1 "test" "a") :baz "foo"))) ;; Now test that schemata and protocols work as type hints. ;; (auto-detecting protocols only works in clj currently) (def LongOrString (s/either s/Int s/Str)) #+clj (s/defrecord Nested [^Bar4 b ^LongOrString c p :- (s/protocol PProtocol)]) (s/defrecord NestedExplicit [b :- Bar4 c :- LongOrString p :- (s/protocol PProtocol)]) (defn test-fancier-defrecord-schema [klass constructor] (let [bar1 (Bar. 1 "a") bar2 (Bar2. 1 "a")] (is (= (utils/class-schema klass) (s/record klass {:b Bar4 :c LongOrString :p (s/protocol PProtocol)} constructor))) (valid! klass (constructor {:b (Bar4. [1] {}) :c 1 :p bar2})) (valid! klass (constructor {:b (Bar4. [1] {}) :c "hi" :p bar2})) (invalid! klass (constructor {:b (Bar4. [1] {}) :c "hi" :p bar1})) (invalid! klass (constructor {:b (Bar4. [1] {:foo :bar}) :c 1 :p bar2})) (invalid! klass (constructor {:b nil :c "hi" :p bar2})))) (deftest fancier-defrecord-schema-test #+clj (test-fancier-defrecord-schema Nested map->Nested) (test-fancier-defrecord-schema NestedExplicit map->NestedExplicit)) (s/defrecord OddSum [a b] {} #(odd? (+ (:a %) (:b %)))) (deftest defrecord-extra-validation-test (valid! OddSum (OddSum. 1 2)) (invalid! OddSum (OddSum. 1 3))) #+clj (do (s/defrecord RecordWithPrimitive [x :- long]) (deftest record-with-primitive-test (valid! RecordWithPrimitive (RecordWithPrimitive. 1)) (is (thrown? Exception (RecordWithPrimitive. "a"))) (is (thrown? Exception (RecordWithPrimitive. nil))))) (deftest map->record-test (let [subset {:foo 1 :bar "a"} exact (assoc subset :zoo :zoo) superset (assoc exact :baz :baz)] (testing "map->record" (is (= (assoc subset :zoo nil) (into {} (map->BarNewStyle subset)))) (is (= exact (into {} (map->BarNewStyle exact)))) (is (= superset (into {} (map->BarNewStyle superset))))) (testing "strict-map->record" (is (thrown? Exception (strict-map->BarNewStyle subset))) (is (= exact (into {} (strict-map->BarNewStyle exact)))) (is (= exact (into {} (strict-map->BarNewStyle exact true)))) (is (thrown? Exception (strict-map->BarNewStyle superset))) (is (= exact (into {} (strict-map->BarNewStyle superset true))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Schematized functions #+clj (deftest split-rest-arg-test (is (= (macros/split-rest-arg {} ['a '& 'b]) '[[a] b])) (is (= (macros/split-rest-arg {} ['a 'b]) '[[a b] nil]))) ;;; fn (def OddLong (s/both (s/pred odd?) #+cljs s/Int #+clj long)) (def +test-fn-schema+ "Schema for (s/fn ^String [^OddLong x y])" (s/=> s/Str OddLong s/Any)) (deftest simple-validated-meta-test (let [f (s/fn ^s/Str foo [^OddLong arg0 arg1])] (is (= +test-fn-schema+ (s/fn-schema f))))) (deftest no-schema-fn-test (let [f (s/fn [arg0 arg1] (+ arg0 arg1))] (is (= (s/=> s/Any s/Any s/Any) (s/fn-schema f))) (s/with-fn-validation (is (= 4 (f 1 3)))) (is (= 4 (f 1 3))))) (deftest simple-validated-fn-test (let [f (s/fn test-fn :- (s/pred even?) [^s/Int x y :- {:foo (s/both s/Int (s/pred odd?))}] (+ x (:foo y -100)))] (s/with-fn-validation (is (= 4 (f 1 {:foo 3}))) ;; Primitive Interface Test #+clj (is (thrown? Exception (.invokePrim f 1 {:foo 3}))) ;; primitive type hints don't work on fns (invalid-call! f 1 {:foo 4}) ;; foo not odd? (invalid-call! f 2 {:foo 3})) ;; return not even? (is (= 5 (f 1 {:foo 4}))) ;; foo not odd? (is (= 4.0 (f 1.0 {:foo 3}))) ;; first arg not long (is (= 5 (f 2 {:foo 3}))) ;; return not even? (testing "Tests that the anonymous function schema macro can handle a name, a schema without a name and no return schema." (let [named-square (s/fn square :- s/Int [x :- s/Int] (* x x)) anon-square (s/fn :- s/Int [x :- s/Int] (* x x)) arg-only-square (s/fn [x :- s/Int] (* x x))] (is (= 100 (named-square 10) (anon-square 10) (arg-only-square 10))))))) (deftest always-validated-fn-test (let [f (s/fn ^:always-validate test-fn :- (s/pred even?) [x :- (s/pred pos?)] (inc x))] (is (= 2 (f 1))) (invalid-call! f 2) (invalid-call! f -1))) (s/defn ^:never-validate never-validated-test-fn :- (s/pred even?) [x :- (s/pred pos?)] (inc x)) (deftest never-validated-fn-test (doseq [f [never-validated-test-fn (s/fn ^:never-validate test-fn :- (s/pred even?) [x :- (s/pred pos?)] (inc x))]] (s/with-fn-validation (is (= 2 (f 1))) (is (= 3 (f 2))) (is (= 0 (f -1)))))) (s/defn ^:never-validate never-validated-rest-test-fn :- (s/pred even?) [arg0 & [rest0 :- (s/pred pos?)]] (+ arg0 (or rest0 2))) (deftest never-validated-rest-test (doseq [f [never-validated-rest-test-fn (s/fn ^:never-validate rest-test-fn :- (s/pred even?) [arg0 & [rest0 :- (s/pred pos?)]] (+ arg0 (or rest0 2)))]] (s/with-fn-validation (is (= 2 (f 0))) (is (= 4 (f 2 2))) (is (= 1 (f 2 -1)))))) (s/set-compile-fn-validation! false) (s/defn elided-validation-test-fn :- (s/pred even?) [x :- (s/pred pos?)] (inc x)) (s/defn ^:always-validate elided-validation-always-test-fn :- (s/pred even?) [x :- (s/pred pos?)] (inc x)) (s/set-compile-fn-validation! true) (deftest elided-validation-test (doseq [f [elided-validation-test-fn elided-validation-always-test-fn]] (s/with-fn-validation (is (= 2 (f 1))) (is (= 3 (f 2))) (is (= 0 (f -1)))))) (defn parse-long [x] #+clj (Long/parseLong x) #+cljs (js/parseInt x)) (deftest destructured-validated-fn-test (let [LongPair [(s/one s/Int 'x) (s/one s/Int 'y)] f (s/fn foo :- s/Int [^LongPair [x y] ^s/Int arg1] (+ x y arg1))] (is (= (s/=> s/Int LongPair s/Int) (s/fn-schema f))) (s/with-fn-validation (is (= 6 (f [1 2] 3))) (invalid-call! f ["a" 2] 3)))) (deftest two-arity-fn-test (let [f (s/fn foo :- s/Int ([^s/Str arg0 ^s/Int arg1] (+ arg1 (foo arg0))) ([^s/Str arg0] (parse-long arg0)))] (is (= (s/=>* s/Int [s/Str] [s/Str s/Int]) (s/fn-schema f))) (is (= 3 (f "3"))) (is (= 10 (f "3" 7))))) (deftest infinite-arity-fn-test (let [f (s/fn foo :- s/Int ([^s/Int arg0] (inc arg0)) ([^s/Int arg0 & strs :- [s/Str]] (reduce + (foo arg0) (map count strs))))] (is (= (s/=>* s/Int [s/Int] [s/Int & [s/Str]]) (s/fn-schema f))) (s/with-fn-validation (is (= 5 (f 4))) (is (= 16 (f 4 "55555" "666666"))) (invalid-call! f 4 [3 3 3])))) (deftest rest-arg-destructuring-test (testing "no schema" (let [f (s/fn foo :- s/Int [^s/Int arg0 & [rest0]] (+ arg0 (or rest0 2)))] (is (= (s/=>* s/Int [s/Int & [(s/optional s/Any 'rest0)]]) (s/fn-schema f))) (s/with-fn-validation (is (= 6 (f 4))) (is (= 9 (f 4 5))) (invalid-call! f 4 9 2)))) (testing "arg schema" (let [f (s/fn foo :- s/Int [^s/Int arg0 & [rest0 :- s/Int]] (+ arg0 (or rest0 2)))] (is (= (s/=>* s/Int [s/Int & [(s/optional s/Int 'rest0)]]) (s/fn-schema f))) (s/with-fn-validation (is (= 6 (f 4))) (is (= 9 (f 4 5))) (invalid-call! f 4 9 2) (invalid-call! f 4 1.5)))) (testing "list schema" (let [f (s/fn foo :- s/Int [^s/Int arg0 & [rest0] :- [s/Int]] (+ arg0 (or rest0 2)))] (is (= (s/=>* s/Int [s/Int & [s/Int]]) (s/fn-schema f))) (s/with-fn-validation (is (= 6 (f 4))) (is (= 9 (f 4 5))) (is (= 9 (f 4 5 9))) (invalid-call! f 4 1.5))))) (deftest fn-recursion-test (testing "non-tail recursion" (let [f (s/fn fib :- s/Int [n :- s/Int] (if (<= n 2) 1 (+ (fib (- n 1)) (fib (- n 2)))))] (is (= 8 (f 6))) (s/with-fn-validation (is (= 8 (f 6)))))) (testing "tail recursion" (let [f (s/fn fact :- s/Int [n :- s/Int ret :- s/Int] (if (<= n 1) ret (recur (dec n) (* ret n))))] (is (= 120 (f 5 1))) (s/with-fn-validation (is (= 120 (f 5 1))))))) #+clj ;; in ClojureScript, metadata on ordinary fn form does not propagate to fn either. (deftest fn-metadata-test (let [->mkeys #(set (keys (meta %)))] (is (= (into (->mkeys (s/fn [])) [:blah]) (->mkeys ^:blah (s/fn [])))))) ;;; defn (def OddLongString (s/both s/Str (s/pred #(odd? (parse-long %)) 'odd-str?))) (s/defn ^{:tag String} simple-validated-defn :- OddLongString "I am a simple schema fn" {:metadata :bla} [arg0 :- OddLong] (str arg0)) (s/defn validated-pre-post-defn :- OddLong "I have pre/post conditions" [arg0 :- s/Num] {:pre [(odd? arg0) (> 10 arg0)] :post [(odd? %) (< 5 %)]} arg0) (def +simple-validated-defn-schema+ (s/=> OddLongString OddLong)) (def ^String +bad-input-str+ "Input to simple-validated-defn does not match schema") ;; Test that s/defn returns var #+clj (with-test (s/defn with-test-fn [a b] (+ a b)) (is (= 3 (with-test-fn 1 2))) (is (= 0 (with-test-fn 10 -10)))) #+cljs (deftest simple-validated-defn-test (s/with-fn-validation (is (= "3" (simple-validated-defn 3))) (invalid-call! simple-validated-defn 4) (invalid-call! simple-validated-defn "a")) (s/with-fn-validation (is (= 7 (validated-pre-post-defn 7))) (invalid-call! validated-pre-post-defn 0) (invalid-call! validated-pre-post-defn 11) (invalid-call! validated-pre-post-defn 1) (invalid-call! validated-pre-post-defn "a")) (comment ;; Triggers what seems to be a bug in cljs, fixed in latest version. (let [e (try (s/with-fn-validation (simple-validated-defn 2)) nil (catch js/Error e e))] (when e ;; validation can be disabled at compile time, and exception not thrown (is (>= (.indexOf (str e) +bad-input-str+) 0))))) (is (= +simple-validated-defn-schema+ (s/fn-schema simple-validated-defn)))) #+clj (s/defn ^String multi-arglist-validated-defn :- OddLongString "I am a multi-arglist schema fn" {:metadata :bla} ([arg0 :- OddLong] (str arg0)) ([arg0 :- OddLong arg1 :- Long] (str (+ arg0 arg1)))) #+clj (deftest simple-validated-defn-test (is (= "Inputs: [arg0 :- OddLong]\n Returns: OddLongString\n\n I am a simple schema fn" (:doc (meta #'simple-validated-defn)))) (is (= '([arg0]) (:arglists (meta #'simple-validated-defn)))) (is (= "Inputs: ([arg0 :- OddLong] [arg0 :- OddLong arg1 :- Long])\n Returns: OddLongString\n\n I am a multi-arglist schema fn" (:doc (meta #'multi-arglist-validated-defn)))) (is (= '([arg0] [arg0 arg1]) (:arglists (meta #'multi-arglist-validated-defn)))) (s/with-fn-validation (testing "pre/post" (is (= 7 (validated-pre-post-defn 7))) (is (thrown-with-msg? AssertionError #"Assert failed: \(odd\? arg0\)" (validated-pre-post-defn 0))) (is (thrown-with-msg? AssertionError #"Assert failed: \(> 10 arg0\)" (validated-pre-post-defn 11))) (is (thrown-with-msg? AssertionError #"Assert failed: \(< 5 %\)" (validated-pre-post-defn 1))) (invalid-call! validated-pre-post-defn "a"))) (let [{:keys [tag schema metadata]} (meta #'simple-validated-defn)] #+clj (is (= tag s/Str)) (is (= +simple-validated-defn-schema+ schema)) (is (= metadata :bla))) (is (= +simple-validated-defn-schema+ (s/fn-schema simple-validated-defn))) (s/with-fn-validation (is (= "3" (simple-validated-defn 3))) (invalid-call! simple-validated-defn 4) (invalid-call! simple-validated-defn "a")) (is (= "4" (simple-validated-defn 4))) (let [e ^Exception (try (s/with-fn-validation (simple-validated-defn 2)) nil (catch Exception e e))] (is (.contains (.getMessage e) +bad-input-str+)) (is (.contains (.getClassName ^StackTraceElement (first (.getStackTrace e))) "simple_validated_defn")) (is (.startsWith (.getFileName ^StackTraceElement (first (.getStackTrace e))) "core_test.clj")))) (s/defn ^:always-validate always-validated-defn :- (s/pred even?) [x :- (s/pred pos?)] (inc x)) (deftest always-validated-defn-test (is (= 2 (always-validated-defn 1))) (invalid-call! always-validated-defn 2) (invalid-call! always-validated-defn -1)) (s/defn fib :- s/Int [n :- s/Int] (if (<= n 2) 1 (+ (fib (- n 1)) (fib (- n 2))))) (s/defn fact :- s/Int [n :- s/Int ret :- s/Int] (if (<= n 1) ret (recur (dec n) (* ret n)))) (deftest defn-recursion-test (testing "non-tail recursion" (is (= 8 (fib 6))) (s/with-fn-validation (is (= 8 (fib 6))))) (testing "tail recursion" (is (= 120 (fact 5 1))) (s/with-fn-validation (is (= 120 (fact 5 1)))))) ;; letfn (deftest minimal-letfn-test (is (= "1" (s/letfn [] "1")))) (deftest simple-letfn-test (is (= "1" (s/with-fn-validation (s/letfn [(x :- s/Num [] 1) (y :- s/Str [m :- s/Num] (str m))] (y (x))))))) (deftest unannotated-letfn-test (is (= "1" (s/with-fn-validation (s/letfn [(x [] 1) (y [m] (str m))] (y (x))))))) (deftest no-validation-letfn-test (is (= "1" (s/letfn [(x :- s/Num [] 1) (y :- s/Str [m :- s/Num] (str m))] (y (x)))))) (deftest error-letfn-test (s/with-fn-validation (s/letfn [(x :- s/Num [] "1") (y :- s/Str [m :- s/Num] (str m))] (invalid-call! y (x))))) ;; Primitive validation testing for JVM #+clj (do (def +primitive-validated-defn-schema+ (s/=> long OddLong)) (s/defn primitive-validated-defn :- long [^long arg0 :- OddLong] (inc arg0)) (deftest simple-primitive-validated-defn-test (is (= +primitive-validated-defn-schema+ (s/fn-schema primitive-validated-defn))) (is ((ancestors (class primitive-validated-defn)) clojure.lang.IFn$LL)) (s/with-fn-validation (is (= 4 (primitive-validated-defn 3))) (is (= 4 (.invokePrim primitive-validated-defn 3))) (is (thrown? Exception (primitive-validated-defn 4)))) (is (= 5 (primitive-validated-defn 4)))) (s/defn another-primitive-fn :- double [^long arg0] 1.0) (deftest another-primitive-fn-test (is ((ancestors (class another-primitive-fn)) clojure.lang.IFn$LD)) (is (= 1.0 (another-primitive-fn 10))))) (deftest with-fn-validation-error-test (is (thrown? #+clj RuntimeException #+cljs js/Error (s/with-fn-validation (throw #+clj (RuntimeException.) #+cljs (js/Error. "error"))))) (is (false? (s/fn-validation?)))) ;; def (deftest def-test ;; heh (s/def v 1) (is (= 1 v)) (s/def v "doc" 2) (is (= 2 v)) #+clj (is (= "doc" (:doc (meta #'v)))) (s/def v :- s/Int "doc" 3) (is (= 3 v)) #+clj (is (= "doc" (:doc (meta #'v)))) (s/def v :- s/Int 3) #+clj (is (= String (:tag (meta (s/def v :- String "a"))))) #+clj (is (thrown? Exception (s/def v :- s/Int "doc" 1.0))) #+clj (is (thrown? Exception (s/def v :- s/Int 1.0))) #+clj (is (thrown? Exception (s/def ^s/Int v 1.0)))) ;; defmethod (defmulti m #(:k (first %&))) (deftest defmethod-unannotated-test (s/defmethod m :v [m x y] (+ x y)) (is (= 3 (m {:k :v} 1 2)))) (deftest defmethod-input-annotated (s/defmethod m :v [m :- {:k s/Keyword} x :- s/Num y :- s/Num] (+ x y)) (is (= 3 (s/with-fn-validation (m {:k :v} 1 2))))) (deftest defmethod-output-annotated (s/defmethod m :v :- s/Num [m x y] (+ x y)) (is (= 3 (s/with-fn-validation (m {:k :v} 1 2))))) (deftest defmethod-all-annotated (s/defmethod m :v :- s/Num [m :- {:k s/Keyword} x :- s/Num y :- s/Num] (+ x y)) (is (= 3 (s/with-fn-validation (m {:k :v} 1 2))))) (deftest defmethod-input-error-test (s/defmethod m :v :- s/Num [m :- {:k s/Keyword} x :- s/Num y :- s/Num] (+ x y)) (s/with-fn-validation (invalid-call! m {:k :v} 1 "2"))) (deftest defmethod-output-error-test (s/defmethod m :v :- s/Num [m :- {:k s/Keyword} x :- s/Num y :- s/Num] "wrong") (s/with-fn-validation (invalid-call! m {:k :v} 1 2))) (deftest defmethod-metadata-test (s/defmethod ^:always-validate m :v :- s/Num [m :- {:k s/Keyword} x :- s/Num y :- s/Num] "wrong") (is (thrown? #+clj RuntimeException #+cljs js/Error (m {:k :v} 1 2)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Composite Schemas (test a few combinations of above) (deftest nice-error-test (let [schema {:a #{[s/Int]} :b [(s/one s/Keyword :k) s/Int] :c s/Any}] (valid! schema {:a #{[1 2 3 4] [] [1 2]} :b [:k 1 2 3] :c :whatever}) (invalid! schema {:a #{[1 2 3 4] [] [1 2] [:a :b]} :b [:k] :c nil} "{:a #{[(not (integer? :a)) (not (integer? :b))]}}") (invalid! schema {:a #{} :b [1 :a] :c nil} "{:b [(named (not (keyword? 1)) :k) (not (integer? :a))]}") (invalid! schema {:a #{} :b [:k]} "{:c missing-required-key}"))) (s/defrecord Explainer [^s/Int foo ^s/Keyword bar] {(s/optional-key :baz) s/Keyword}) #+clj ;; clojurescript.test hangs on this test in phantom.js, so marking clj-only (deftest fancy-explain-test (is (= (s/explain {(s/required-key 'x) s/Int s/Keyword [(s/one s/Int "foo") (s/maybe Explainer)]}) `{~'(required-key x) ~'Int ~'Keyword [(~'one ~'Int "foo") (~'maybe (~'record #+clj Explainer #+cljs schema.core-test/Explainer {:foo ~'Int :bar ~'Keyword (~'optional-key :baz) ~'Keyword}))]}))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Regression tests #+clj (deftest pprint-test (is (= "(maybe Int)" (str/trim (with-out-str (pprint/pprint (s/maybe s/Int))))))) (defrecord ItemTest [first second]) (defrecord CacheTest [schema] s/Schema (spec [this] (collection/collection-spec (let [p (spec/precondition this #(instance? ItemTest %) #(list 'instance? ItemTest %))] (if-let [evf (:extra-validator-fn this)] (some-fn p (spec/precondition this evf #(list 'passes-extra-validation? %))) p)) (fn [x] x) [{:schema s/Int :parser (fn [item-col m] (item-col (:first m)) m) :error-wrap (fn [err] [:first (utils/error-val err)])} {:schema schema :parser (fn [item-col m] (item-col (:second m)) m) :error-wrap (fn [err] [:second (utils/error-val err)])} {:schema s/Any :parser (fn [_ _] nil)}] (fn [_ elts _] (map utils/error-val elts)))) (explain [_] (list 'cache-test))) (deftest issue-310-error-wrap-cache (are [schema value expected] (= expected (pr-str (s/check schema value))) (->CacheTest s/Int) (->ItemTest :a nil) "([:first (not (integer? :a))] [:second (not (integer? nil))])" (->CacheTest [s/Int]) (->ItemTest :a nil) "([:first (not (integer? :a))] nil)" (->CacheTest [s/Int]) (->ItemTest :a [nil]) "([:first (not (integer? :a))] [:second [(not (integer? nil))]])")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helpers for defining schemas (used in in-progress work, expanlation coming soon) (s/defschema TestFoo {:bar s/Str}) (deftest test-defschema (is (= 'TestFoo (:name (meta TestFoo)))) (is (= 'schema.core-test (:ns (meta TestFoo))))) (deftest schema-with-name-test (let [schema (s/schema-with-name {:baz s/Num} 'Baz)] (valid! schema {:baz 123}) (invalid! schema {:baz "abc"}) (is (= 'Baz (s/schema-name schema))) (is (= nil (s/schema-ns schema))))) (deftest schema-name-test (is (= 'TestFoo (s/schema-name TestFoo)))) (deftest schema-ns-test (is (= 'schema.core-test (s/schema-ns TestFoo)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Testing the ability to redefine schema.macros/fn-validator (deftest soft-validation-test (let [the-log (atom []) log #(swap! the-log conj %&)] (with-redefs [s/fn-validator (fn [dir fn-name schema checker value] (when-let [err (checker value)] (log dir fn-name value)))] (s/with-fn-validation (simple-validated-defn 12) (simple-validated-defn 13))) (is (= [[:input 'simple-validated-defn [12]] [:output 'simple-validated-defn "12"]] @the-log)))) prismatic-schema-clojure-1.1.6/test/cljx/schema/experimental/000075500000000000000000000000001314115420600242605ustar00rootroot00000000000000prismatic-schema-clojure-1.1.6/test/cljx/schema/experimental/abstract_map_test.cljx000064400000000000000000000036271314115420600306510ustar00rootroot00000000000000(ns schema.experimental.abstract-map-test #+clj (:use clojure.test [schema.test-macros :only [valid! invalid! invalid-call!]]) #+cljs (:use-macros [cemerick.cljs.test :only [is deftest testing]] [schema.test-macros :only [valid! invalid! invalid-call!]]) (:require [schema.core :as s] [schema.coerce :as coerce] [schema.experimental.abstract-map :as abstract-map :include-macros true] #+cljs cemerick.cljs.test)) (s/defschema Animal (abstract-map/abstract-map-schema :type {:age s/Num :vegan? s/Bool})) (abstract-map/extend-schema Cat Animal [:cat] {:fav-catnip s/Str}) (deftest extend-schema-test (valid! Cat {:age 3 :vegan? false :fav-catnip "cosmic" :type :cat}) (invalid! Cat {:age 3 :vegan? false :fav-catnip "cosmic" :type :cat :foobar false}) (valid! Animal {:age 3 :vegan? false :fav-catnip "cosmic" :type :cat}) (invalid! Animal {:age 3 :vegan? false :type :cat} "{:fav-catnip missing-required-key}") (invalid! Animal {:age 3 :vegan? false :fav-catnip "cosmic" :type :dog})) (s/defschema TV (abstract-map/open-abstract-map-schema :make {:channel s/Int :power? s/Bool})) (abstract-map/extend-schema HondaTV TV [:honda] {:num-wheels s/Int}) (deftest open-abstract-map-schema-test (valid! TV {:channel 30 :power? true :num-wheels 1 :make :honda}) (valid! HondaTV {:channel 30 :power? true :num-wheels 1 :make :honda}) (valid! TV {:channel 30 :power? false :missiles "short range" :make :dod}) (invalid! TV {:channel 30 :make :unknown} "{:power? missing-required-key}")) (deftest json-coercer-test (let [animal-coercer (coerce/coercer Animal coerce/json-coercion-matcher) cat-coercer (coerce/coercer Cat coerce/json-coercion-matcher) cat {:type :cat :age 12 :vegan? false :fav-catnip "cosmic"}] (is (= cat (animal-coercer (update-in cat [:type] name)))) (is (= cat (cat-coercer (update-in cat [:type] name)))))) prismatic-schema-clojure-1.1.6/test/cljx/schema/test_test.cljx000064400000000000000000000004371314115420600244670ustar00rootroot00000000000000(ns schema.test-test #+clj (:use clojure.test) (:require [schema.core :as s] [schema.test :as st])) #+clj (do (s/defn test-fn :- s/Str [] 5) (deftest validation-off-test (is (= 5 (test-fn)))) (st/deftest validation-on-test (is (thrown? Exception (test-fn)))))