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 <[email protected]> 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 _______________________________________________ pkg-java-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-java-commits
