def-*-schemas take any modifier keywords *after* the var name, not be…

…fore.
staples-sparx · Aug 3, 2013 · 8d9326e · 8d9326e
1 parent 59fd0d5
commit 8d9326e
Show file tree

Hide file tree

Showing 16 changed files with 46 additions and 33 deletions.
diff --git a/.gitignore b/.gitignore
diff --git a/.travis.yml b/.travis.yml
diff --git 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
diff --git 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)))
+    (hooke/remove-hook (:var c) ::contract)))
diff --git a/src/clj_schema/example.clj b/src/clj_schema/example.clj
diff --git a/src/clj_schema/internal/utils.clj b/src/clj_schema/internal/utils.clj
diff --git a/src/clj_schema/schema.clj b/src/clj_schema/schema.clj
@@ -160,21 +160,25 @@ 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)
         schema-spec? (fn [x] (and (vector? x) (not (constraint-bundle? x))))
         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
diff --git a/src/clj_schema/validation.clj b/src/clj_schema/validation.clj
diff --git a/test/clj_schema/contracts_test.clj b/test/clj_schema/contracts_test.clj
diff --git a/test/clj_schema/example_test.clj b/test/clj_schema/example_test.clj
diff --git a/test/clj_schema/internal/utils_test.clj b/test/clj_schema/internal/utils_test.clj
diff --git a/test/clj_schema/schema_test.clj b/test/clj_schema/schema_test.clj
diff --git 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,12 +67,12 @@
   [[: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?))
 
 (def-set-schema red-set
   (constraints (fn [xs] (even? (count xs))))
   (OneOf :red :RED :Red)
-  (constraints sorted?))
+  (constraints sorted?))
diff --git a/test/clj_schema/validation_test.clj b/test/clj_schema/validation_test.clj