From 8d9326e55c9e9f40e27e40f311263b98d3f9b18e Mon Sep 17 00:00:00 2001 From: Alex Baranosky Date: Sat, 3 Aug 2013 13:16:34 -0700 Subject: [PATCH] def-*-schemas take any modifier keywords *after* the var name, not before. --- .gitignore | 0 .travis.yml | 0 README.md | 17 ++++++----- project.clj | 0 src/clj_schema/contracts.clj | 4 +-- src/clj_schema/example.clj | 0 src/clj_schema/internal/utils.clj | 0 src/clj_schema/schema.clj | 40 +++++++++++++++---------- src/clj_schema/simple_schemas.clj | 0 src/clj_schema/validation.clj | 0 test/clj_schema/contracts_test.clj | 0 test/clj_schema/example_test.clj | 0 test/clj_schema/internal/utils_test.clj | 0 test/clj_schema/schema_test.clj | 0 test/clj_schema/test_schemas.clj | 18 +++++------ test/clj_schema/validation_test.clj | 0 16 files changed, 46 insertions(+), 33 deletions(-) mode change 100644 => 100755 .gitignore mode change 100644 => 100755 .travis.yml mode change 100644 => 100755 README.md mode change 100644 => 100755 project.clj mode change 100644 => 100755 src/clj_schema/contracts.clj mode change 100644 => 100755 src/clj_schema/example.clj mode change 100644 => 100755 src/clj_schema/internal/utils.clj mode change 100644 => 100755 src/clj_schema/schema.clj mode change 100644 => 100755 src/clj_schema/simple_schemas.clj mode change 100644 => 100755 src/clj_schema/validation.clj mode change 100644 => 100755 test/clj_schema/contracts_test.clj mode change 100644 => 100755 test/clj_schema/example_test.clj mode change 100644 => 100755 test/clj_schema/internal/utils_test.clj mode change 100644 => 100755 test/clj_schema/schema_test.clj mode change 100644 => 100755 test/clj_schema/test_schemas.clj mode change 100644 => 100755 test/clj_schema/validation_test.clj diff --git a/.gitignore b/.gitignore old mode 100644 new mode 100755 diff --git a/.travis.yml b/.travis.yml old mode 100644 new mode 100755 diff --git a/README.md b/README.md old mode 100644 new mode 100755 index cd9950a..2b5b9fe --- a/README.md +++ b/README.md @@ -103,7 +103,7 @@ paths (and constraints) from all included schemas. [:baz] #"baz"]) ``` -All schemas are just maps: +Schemas are just maps: ```clj (def-map-schema foo-schema [[:a] String]) @@ -120,7 +120,10 @@ All schemas are just maps: `def-map-schema` creates a strict schema by default, which expects only the paths it describes to be present on the given map. -`(def-map-schema :loose my-schema [[:a] String])` creates a loose schema, which expects its paths to be +`(def-map-schema my-schema :loose + [[:a] String])` + +Creates a loose schema, which expects its paths to be present but does not complain about extra paths. @@ -131,7 +134,7 @@ You can also add constraints: schemas, or simple schema precursors that apply to data structure under validation: ```clj -(def-map-schema :loose sorted-unique +(def-map-schema sorted-unique :loose (constraints sorted? (fn [m] (= (count (keys m)) (count (distinct (keys m)))))) [[:id] String]) @@ -152,13 +155,13 @@ data structure under validation: #### An alternate, layout-based checkerboard schema, ensures checkering of 1's and 0's: ```clj -(def-seq-schema :layout white-row +(def-seq-schema white-row :layout [0 1 0 1 0 1 0 1]) -(def-seq-schema :layout black-row +(def-seq-schema black-row :layout [1 0 1 0 1 0 1 0]) -(def-seq-schema :layout checkers-board-schema +(def-seq-schema checkers-board-schema :layout [white-row black-row white-row black-row white-row black-row white-row black-row]) ``` @@ -293,7 +296,7 @@ These should probably be renamed to something less confusing. Any ideas? (sort-people-by-height [(person :height 98) (person :height 67) (person :height 89)])))) ;; example factories can also be defined as multi-arity -(def-seq-schema :layout point-schema +(def-seq-schema point-schema :layout (constraints (fn [[x y]] (= (class x) (class y)))) [Number Number]) diff --git a/project.clj b/project.clj old mode 100644 new mode 100755 diff --git a/src/clj_schema/contracts.clj b/src/clj_schema/contracts.clj old mode 100644 new mode 100755 index 1d9953a..aed1c48 --- a/src/clj_schema/contracts.clj +++ b/src/clj_schema/contracts.clj @@ -6,7 +6,7 @@ (:require [robert.hooke :as hooke])) -(def-map-schema :loose ^:private contract-schema +(def-map-schema ^:private contract-schema :loose [[:var] var? (optional-path [:sampling-rate]) [:or nil fn? [number? #(>= % 0) #(<= % 100)]] (optional-path [:input-schema]) Anything @@ -81,4 +81,4 @@ (when-let [errors (seq (validation-errors (sequence-of contract-schema) contracts))] (throw (Exception. (str "contracts were not valid: " contracts errors)))) (doseq [c contracts] - (hooke/remove-hook (:var c) ::contract))) \ No newline at end of file + (hooke/remove-hook (:var c) ::contract))) diff --git a/src/clj_schema/example.clj b/src/clj_schema/example.clj old mode 100644 new mode 100755 diff --git a/src/clj_schema/internal/utils.clj b/src/clj_schema/internal/utils.clj old mode 100644 new mode 100755 diff --git a/src/clj_schema/schema.clj b/src/clj_schema/schema.clj old mode 100644 new mode 100755 index b7b17b0..117b857 --- a/src/clj_schema/schema.clj +++ b/src/clj_schema/schema.clj @@ -160,8 +160,10 @@ map under-validation to have more keys than are specified in the schema." Can be supplied other schemas which it will addd behavior to.. Accepts constraints that are applied to the whole map." [looseness & constraints-and-schema-vectors] - (let [user-specified-constraints (mapcat ::constraint-bundle - (filter constraint-bundle? constraints-and-schema-vectors)) + (assert (contains? #{:strict :loose} looseness)) + (let [user-specified-constraints (->> constraints-and-schema-vectors + (filter constraint-bundle? ) + (mapcat ::constraint-bundle)) schemas (filter schema? constraints-and-schema-vectors) inherited-schema-specs (mapcat :schema-spec schemas) inherited-constraints (mapcat :constraints schemas) @@ -169,12 +171,14 @@ map under-validation to have more keys than are specified in the schema." schema-specs (apply concat (filter schema-spec? constraints-and-schema-vectors)) flattened-schema-specs (vec (concat inherited-schema-specs schema-specs)) compiled-schema-specs (u/map-nth 2 ensure-schema flattened-schema-specs)] - (assert (contains? #{:strict :loose} looseness)) + (assert (even? (count schema-specs))) (assert (every? sequential? (schema-path-set {:schema-spec schema-specs}))) {:type :map :schema-spec compiled-schema-specs - :constraints (distinct (concat map-constraints inherited-constraints user-specified-constraints)) + :constraints (distinct (concat map-constraints + inherited-constraints + user-specified-constraints)) :strict (= :strict looseness)})) (defmacro def-map-schema @@ -183,9 +187,11 @@ map under-validation to have more keys than are specified in the schema." {:arglists '([name & constraints-and-schema-vectors] [looseness name & constraints-and-schema-vectors])} [& args] - (let [[looseness name & constraints-and-schema-vectors] (if (keyword? (first args)) + (let [[name looseness & constraints-and-schema-vectors] (if (keyword? (second args)) args - (cons :strict args))] + (list* (first args) + :strict + (rest args)))] `(def ~(vary-meta name assoc ::schema true ::strict (= :strict looseness)) (map-schema ~looseness ~@constraints-and-schema-vectors)))) @@ -197,11 +203,13 @@ map under-validation to have more keys than are specified in the schema." a layout to check the sequence against. Accepts constraints that are applied to the whole sequence." [all-or-layout & constraints-and-schema-specs] - (let [user-specified-constraints (mapcat ::constraint-bundle - (filter constraint-bundle? constraints-and-schema-specs)) + (assert (contains? #{:all :layout} all-or-layout)) + (let [user-specified-constraints (->> constraints-and-schema-specs + (filter constraint-bundle?) + (mapcat ::constraint-bundle)) schema (first (remove constraint-bundle? constraints-and-schema-specs)) seq-layout schema] - (assert (contains? #{:all :layout} all-or-layout)) + (if (= :layout all-or-layout) {:type :seq-layout :schema-spec (vec (map ensure-schema seq-layout)) @@ -217,10 +225,11 @@ map under-validation to have more keys than are specified in the schema." {:arglists '([name & constraints-and-schema-specs] [all-or-layout name & constraints-and-schema-specs])} [& args] - (let [[all-or-layout name & constraints-and-schema-specs] (if (keyword? (first args)) + (let [[name all-or-layout & constraints-and-schema-specs] (if (keyword? (second args)) args - (cons :all args))] - (assert (contains? #{:all :layout} all-or-layout)) + (list* (first args) + :all + (rest args)))] `(def ~(vary-meta name assoc ::schema true) (seq-schema ~all-or-layout ~@constraints-and-schema-specs)))) @@ -229,8 +238,9 @@ map under-validation to have more keys than are specified in the schema." the given schema. Accepts constraints that are applied to the whole sequence." [& constraints-and-schema-specs] - (let [user-specified-constraints (mapcat ::constraint-bundle - (filter constraint-bundle? constraints-and-schema-specs)) + (let [user-specified-constraints (->> constraints-and-schema-specs + (filter constraint-bundle?) + (mapcat ::constraint-bundle)) schema (first (remove constraint-bundle? constraints-and-schema-specs))] {:type :set :schema-spec (ensure-schema schema) @@ -358,7 +368,7 @@ map under-validation to have more keys than are specified in the schema." ;;;; Scaffolding (defn scaffold-schema - "Makes a simple scaffolding schema from a given map, sequence or set." + "Makes a basic/starter schema from a given map, sequence or set." [schema-name x] (cond (map? x) (list 'def-map-schema (symbol schema-name) diff --git a/src/clj_schema/simple_schemas.clj b/src/clj_schema/simple_schemas.clj old mode 100644 new mode 100755 diff --git a/src/clj_schema/validation.clj b/src/clj_schema/validation.clj old mode 100644 new mode 100755 diff --git a/test/clj_schema/contracts_test.clj b/test/clj_schema/contracts_test.clj old mode 100644 new mode 100755 diff --git a/test/clj_schema/example_test.clj b/test/clj_schema/example_test.clj old mode 100644 new mode 100755 diff --git a/test/clj_schema/internal/utils_test.clj b/test/clj_schema/internal/utils_test.clj old mode 100644 new mode 100755 diff --git a/test/clj_schema/schema_test.clj b/test/clj_schema/schema_test.clj old mode 100644 new mode 100755 diff --git a/test/clj_schema/test_schemas.clj b/test/clj_schema/test_schemas.clj old mode 100644 new mode 100755 index 428b12a..cdfd9dd --- a/test/clj_schema/test_schemas.clj +++ b/test/clj_schema/test_schemas.clj @@ -8,13 +8,13 @@ (def-map-schema count-schema [[:count] Number]) (def-map-schema product-schema [[:quantity] Number [:price] Number]) -(def-map-schema :loose loose-height-schema +(def-map-schema loose-height-schema :loose [[:height] Number]) (def-map-schema person-schema name-schema height-schema) -(def-map-schema :loose loose-person-schema +(def-map-schema loose-person-schema :loose [[:name :first] String [:height] Number]) @@ -26,7 +26,7 @@ [[:mom] person-schema [:dad] loose-person-schema]) -(def-map-schema :loose schema-with-constraints +(def-map-schema schema-with-constraints :loose (constraints (comp even? count distinct vals) (fn [m] (even? (count (keys m))))) [[:a] String @@ -46,19 +46,19 @@ (def black-square (OneOf 0)) (def white-square (OneOf 1)) -(def-seq-schema :layout white-row +(def-seq-schema white-row :layout [white-square black-square white-square black-square white-square black-square white-square black-square]) -(def-seq-schema :layout black-row +(def-seq-schema black-row :layout [black-square white-square black-square white-square black-square white-square black-square white-square]) -(def-seq-schema :layout checkers-board-schema +(def-seq-schema checkers-board-schema :layout [white-row black-row white-row black-row white-row black-row white-row black-row]) ;;; -(def-map-schema :loose non-empty-map +(def-map-schema non-empty-map :loose (constraints (simple-schema map?) (complement empty?))) @@ -67,7 +67,7 @@ [[:a] (OneOf 1)] (constraints (fn [m] (not (sorted? m))))) -(def-seq-schema :all red-list +(def-seq-schema red-list :all (constraints (fn [xs] (even? (count xs)))) (OneOf :red) (constraints list?)) @@ -75,4 +75,4 @@ (def-set-schema red-set (constraints (fn [xs] (even? (count xs)))) (OneOf :red :RED :Red) - (constraints sorted?)) \ No newline at end of file + (constraints sorted?)) diff --git a/test/clj_schema/validation_test.clj b/test/clj_schema/validation_test.clj old mode 100644 new mode 100755