[prismatic-schema-clojure] 01/03: Add generated clj code
Apollon Oikonomopoulos
apoikos at moszumanska.debian.org
Fri Aug 4 20:39:29 UTC 2017
This is an automated email from the git hooks/post-receive script.
apoikos pushed a commit to branch master
in repository prismatic-schema-clojure.
commit e810fa6fb9cee3d6e4687d6ba2b4b6a04e7dfe52
Author: Apollon Oikonomopoulos <apoikos at debian.org>
Date: Fri Aug 4 16:26:46 2017 -0400
Add generated clj code
---
src/clj/schema/coerce.clj | 152 +++
src/clj/schema/core.clj | 1414 ++++++++++++++++++++++++++
src/clj/schema/experimental/abstract_map.clj | 76 ++
src/clj/schema/spec/collection.clj | 142 +++
src/clj/schema/spec/core.clj | 101 ++
src/clj/schema/spec/leaf.clj | 22 +
src/clj/schema/spec/variant.clj | 89 ++
src/clj/schema/test.clj | 21 +
src/clj/schema/utils.clj | 175 ++++
9 files changed, 2192 insertions(+)
diff --git a/src/clj/schema/coerce.clj b/src/clj/schema/coerce.clj
new file mode 100644
index 0000000..382fd3c
--- /dev/null
+++ b/src/clj/schema/coerce.clj
@@ -0,0 +1,152 @@
+(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
diff --git a/src/clj/schema/core.clj b/src/clj/schema/core.clj
new file mode 100644
index 0000000..76e19ef
--- /dev/null
+++ b/src/clj/schema/core.clj
@@ -0,0 +1,1414 @@
+(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
diff --git a/src/clj/schema/experimental/abstract_map.clj b/src/clj/schema/experimental/abstract_map.clj
new file mode 100644
index 0000000..d4015f4
--- /dev/null
+++ b/src/clj/schema/experimental/abstract_map.clj
@@ -0,0 +1,76 @@
+(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
diff --git a/src/clj/schema/spec/collection.clj b/src/clj/schema/spec/collection.clj
new file mode 100644
index 0000000..61b1ee0
--- /dev/null
+++ b/src/clj/schema/spec/collection.clj
@@ -0,0 +1,142 @@
+(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
diff --git a/src/clj/schema/spec/core.clj b/src/clj/schema/spec/core.clj
new file mode 100644
index 0000000..5a52cb6
--- /dev/null
+++ b/src/clj/schema/spec/core.clj
@@ -0,0 +1,101 @@
+(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
diff --git a/src/clj/schema/spec/leaf.clj b/src/clj/schema/spec/leaf.clj
new file mode 100644
index 0000000..f120d8f
--- /dev/null
+++ b/src/clj/schema/spec/leaf.clj
@@ -0,0 +1,22 @@
+(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
diff --git a/src/clj/schema/spec/variant.clj b/src/clj/schema/spec/variant.clj
new file mode 100644
index 0000000..3de7d8e
--- /dev/null
+++ b/src/clj/schema/spec/variant.clj
@@ -0,0 +1,89 @@
+(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
diff --git a/src/clj/schema/test.clj b/src/clj/schema/test.clj
new file mode 100644
index 0000000..3ca77b5
--- /dev/null
+++ b/src/clj/schema/test.clj
@@ -0,0 +1,21 @@
+(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
diff --git a/src/clj/schema/utils.clj b/src/clj/schema/utils.clj
new file mode 100644
index 0000000..ac0ba13
--- /dev/null
+++ b/src/clj/schema/utils.clj
@@ -0,0 +1,175 @@
+(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
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-java/prismatic-schema-clojure.git
More information about the pkg-java-commits
mailing list