From 603693b59ec339ffb8ca3fde0ea0dd8a8479a8b2 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Wed, 28 Aug 2019 18:23:47 +0200 Subject: [PATCH 01/13] Refactor and performance improvements (breaking changes). --- .gitignore | 3 +- CHANGELOG.md | 28 +++ deps.edn | 19 +- doc/content.adoc | 138 ++++++--------- src/struct/core.cljc | 386 ++++++++++++++++++++++------------------- src/struct/util.cljc | 27 +++ test/struct/tests.cljc | 261 ++++++++++++++++------------ test/user.clj | 17 ++ tools.clj | 104 +++-------- 9 files changed, 525 insertions(+), 458 deletions(-) create mode 100644 src/struct/util.cljc create mode 100644 test/user.clj diff --git a/.gitignore b/.gitignore index 6e5b056..ddf5ea1 100644 --- a/.gitignore +++ b/.gitignore @@ -13,4 +13,5 @@ pom.xml.asc /repl /node_modules /settings.xml -/.cpcache \ No newline at end of file +/.cpcache +/.rebel_readline_history \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md index e6444d8..ca0710f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,33 @@ # Changelog # +## Version 2.0.0 ## + +Date: 2019-08-28 + +This is **BREAKING CHANGES** release: + +- The error reporting is changed; now is a map instead of simple + string, and it includes the current value, the validator type and + the validator functions used to generate this error. +- The error message translation is generalized; now the messages can + be functions that will called when error is reported with current + validator state as single argument. +- The validator structure map changed a little bit. + +Other relevant changes: + +- New `defs` macro for "compile" user defined spec (huge performance + improvement over use spec directly). +- Removed `cuerdas` dependency (just for convenience of having 0 deps). + + +## Version 1.4.0 ## + +Date: 2019-06-06 + +- Minor fix on handling neested data structures. +- Migrate to cli tools. + ## Version 1.3.0 ## Date: 2018-06-02 diff --git a/deps.edn b/deps.edn index df1ac4f..b7da09a 100644 --- a/deps.edn +++ b/deps.edn @@ -1,20 +1,19 @@ -{:deps {funcool/cuerdas {:mvn/version "2.2.0"}} - :paths ["src"] +{:paths ["src"] :aliases {:dev - {:extra-deps {org.clojure/clojurescript {:mvn/version "1.10.516"} - ;; org.clojure/clojure {:mvn/version "1.10.0"} + {:extra-deps {org.clojure/clojurescript {:mvn/version "1.10.520"} + org.clojure/clojure {:mvn/version "1.10.1"} com.bhauman/rebel-readline-cljs {:mvn/version "0.1.4"} com.bhauman/rebel-readline {:mvn/version "0.1.4"} - com.bhauman/figwheel-main {:mvn/version "0.2.0"} - eftest/eftest {:mvn/version "0.5.7"}} + org.clojure/tools.namespace {:mvn/version "0.3.1"} + criterium {:mvn/version "0.4.5"}} :extra-paths ["test"]} + :deploy + {:extra-deps {badigeon/badigeon {:git/url "https://github.com/EwenG/badigeon.git" + :sha "db25a8f7053dec65afeb7fb0d1a5351dcdbe78bd" + :tag "0.0.8"}}} :ancient {:main-opts ["-m" "deps-ancient.deps-ancient"] :extra-deps {deps-ancient {:mvn/version "RELEASE"}}} - :jar {:extra-deps {seancorfield/depstar {:mvn/version "RELEASE"}} - :main-opts ["-m" "hf.depstar.jar"]} - - :repl {:main-opts ["-m" "rebel-readline.main"]} }} diff --git a/doc/content.adoc b/doc/content.adoc index 2f51d44..28d9faa 100644 --- a/doc/content.adoc +++ b/doc/content.adoc @@ -34,7 +34,7 @@ Just include that in your dependency vector on *_project.clj_*: [source,clojure] ---- -[funcool/struct "1.3.0"] +[funcool/struct "2.0.0-SNAPSHOT"] ---- @@ -53,7 +53,7 @@ Define a small schema for the example purpose: [source, clojure] ---- -(def +scheme+ +(st/defs +scheme+ {:name [st/required st/string] :year [st/required st/number]}) ---- @@ -68,14 +68,14 @@ matters: [source, clojure] ---- -(def +scheme+ +(st/defs +scheme+ [[:name st/required st/string] [:year st/required st/number]]) ---- -By default, all validators are optional so if the value is missing, no error -will reported. If you want make the value mandatory, you should use a specific -`required` validator. +By default, all validators are optional so if the value is missing, no +error will reported. If you want make the value mandatory, you should +use a specific `required` validator. And finally, start validating your data: @@ -91,11 +91,24 @@ And finally, start validating your data: (-> {:year "1994"} (st/validate +scheme+)) -;; => [{:name "this field is mandatory", :year "must be a number"} {}] +;; => [{:name {:type :struct.core/required ...} + :year {:type :struct.core/number ...}} + {}] +---- + +The error has the following structure: + +[source, clojure] +---- +{:type :struct.core/required, + :optional false, + :validate #object[function], + :message nil, + :value nil} ---- -If only want to know if some data is valid or not, you can use the `valid?` predicate -for that purpose: +Then, if you only want to know if some data is valid or not, you can +use the `valid?` predicate for that purpose: [source, clojure] ---- @@ -103,8 +116,9 @@ for that purpose: ;; => false ---- -The additional entries in the map are not stripped by default, but this behavior -can be changed passing an additional flag as the third argument: +The additional entries in the map are not stripped by default, but +this behavior can be changed passing an additional flag as the third +argument: [source, clojure] ---- @@ -129,7 +143,7 @@ key part the proper path to the neested data structure: (-> {:a {:b "foo"} {:c {:d "bar"}}} (st/validate +scheme+)) -;; => [{:a {:b "must be a number"}} {:c {:d "bar"}}] +;; => [{:a {:b {:type :struct.core/integer ...}}} {:c {:d "bar"}}] ---- @@ -142,22 +156,19 @@ In addition to simple validators, one may use additional contraints ---- (def schema {:num [[st/in-range 10 20]]}) -(st/validate {:num 21} schema) -;; => [{:num "not in range"} {}] - (st/validate {:num 19} schema) ;; => [nil {:num 19}] ---- -Note the double vector; the outer denotes a list of validatiors and the inner -denotes a validator with patameters. +Note the double vector; the outer denotes a list of validatiors and +the inner denotes a validator with patameters. === Custom messages -The builtin validators comes with default messages in human readable format, but -sometimes you may want to change them (e.g. for i18n purposes). This is how you -can do it: +The builtin validators comes with no messages in human readable +format, but sometimes you may want to have them (e.g. for i18n +purposes). This is how you can do it: [source, clojure] ---- @@ -165,49 +176,37 @@ can do it: {:num [[st/in-range 10 20 :message "errors.not-in-range"]]}) (st/validate {:num 21} schema) -;; => [{:num "errors.not-in-range"} {}] +;; => [{:num {:message "errors.not-in-range" ...}} {}] ---- -A message can contains format wildcards `%s`, these wildcards will be replaced by `args` of validator, e.g.: - -[source, clojure] ----- -(def schema - {:age [[st/in-range 18 26 :message "The age must be between %s and %s"]]}) - -(st/validate {:age 30} schema) -;; => [{:age "The age must be between 18 and 26"} {}] - ----- - - === Data coercions In addition to simple validations, this library includes the ability -to coerce values, and a collection of validators that matches over strings. Let's -see some code: +to coerce values, and a collection of validators that matches over +strings. Let's see some code: .Example attaching custom coercions [source, clojure] ---- -(def schema +(st/defs schema {:year [[st/integer :coerce str]]}) (st/validate {:year 1994} schema)) ;; => [nil {:year "1994"}] ---- -Looking at the data returned from the validation -process, one can see that the value is properly coerced with the specified coercion function. +Looking at the data returned from the validation process, one can see +that the value is properly coerced with the specified coercion +function. -This library comes with a collection of validators that already -have attached coercion functions. These serve to validate parameters -that arrive as strings but need to be converted to the appropriate type: +This library comes with a collection of validators that already have +attached coercion functions. These serve to validate parameters that +arrive as strings but need to be converted to the appropriate type: [source, clojure] ---- -(def schema {:year [st/required st/integer-str] - :id [st/required st/uuid-str]}) +(s/defs schema {:year [st/required st/integer-str] + :id [st/required st/uuid-str]}) (st/validate {:year "1994" :id "543e7472-6624-4cb5-b65e-f3c341843d0f"} @@ -270,55 +269,23 @@ Additional notes: === Define your own validator -As mentioned previously, the validators in _struct_ library are defined using plain -hash-maps. For example, this is how the builtin `integer` validator is defined: +As mentioned previously, the validators in _struct_ library are +defined using plain hash-maps. For example, this is how the builtin +`integer` validator is defined: [source, clojure] ---- (def integer - {:message "must be a integer" - :optional true - :validate integer?})) ----- - -If the validator needs access to previously validated data, the `:state` key -should be present with the value `true`. Let see the `identical-to` validator as example: - -[source,clojure] ----- -(def identical-to - {:message "does not match" + {:type ::integer :optional true - :state true - :validate (fn [state v ref] - (let [prev (get state ref)] - (= prev v)))}) + :validate #(integer? %2)}) ---- -Validators that access the state receive an additional argument with the state for validator -function. - -=== Translating validation messages - -`struct.core/validate` accepts a third options argument where a function can be passed in with the `:translate` key like the following: - -[source,clojure] ----- -(st/validate {:year "1994" - :id "543e7472-6624-4cb5-b65e-f3c341843d0f"} - schema - {:translate (fn [message] (clojure.string/uppercase message))) ----- - -The translation function accepts the `:message` of the schma upon validation failure. -This allows easy integration with an i18n library such as tempura if you privide a keyword for the schema's `:message` that in turn maps to the localised message in the dictionary. - -== Developers Guide === Contributing -Unlike Clojure and other Clojure contrib libs, there aren't many restrictions for -contributions. Just open an issue or pull request. +Unlike Clojure and other Clojure contrib libs, there aren't many +restrictions for contributions. Just open an issue or pull request. === Get the Code @@ -342,19 +309,20 @@ For the JVM platform: [source, text] ---- -lein test +clojure -Adev -m struct.tests ---- And for JS platform: [source, text] ---- -./scripts/build +clojure -Adev tools.clj build:tests node out/tests.js ---- You will need to have nodejs installed on your system. + === License _struct_ is under public domain: diff --git a/src/struct/core.cljc b/src/struct/core.cljc index 28b2df4..3341167 100644 --- a/src/struct/core.cljc +++ b/src/struct/core.cljc @@ -1,23 +1,21 @@ (ns struct.core (:refer-clojure :exclude [keyword uuid vector boolean long map set]) - (:require [cuerdas.core :as str])) + (:require [struct.util :as util]) + #?(:cljs (:require-macros struct.core))) + +#?(:clj (set! *warn-on-reflection* true) + :cljs (set! *warn-on-infer* true)) -;; --- Impl details (def ^:private map' #?(:cljs cljs.core/map :clj clojure.core/map)) -(defn- apply-validation - [step data value] - (if-let [validate (:validate step nil)] - (let [args (:args step [])] - (if (:state step) - (apply validate data value args) - (apply validate value args))) - true)) +(def ^:private vector' #?(:cljs cljs.core/vector + :clj clojure.core/vector)) +;; --- Impl details (defn- dissoc-in - [m [k & ks :as keys]] + [m [k & ks]] (if ks (if-let [nextmap (get m k)] (let [newmap (dissoc-in nextmap ks)] @@ -27,96 +25,145 @@ m) (dissoc m k))) -(defn- prepare-message - [opts step] - (if (::nomsg opts) - ::nomsg - (let [msg (:message step "errors.invalid") - tr (:translate opts identity)] - (apply str/format (tr msg) (vec (:args step)))))) - -(def ^:const ^:private opts-params - #{:coerce :message :optional}) +(def ^:private opts-params + #{:coerce :message :optional :type}) (def ^:private notopts? (complement opts-params)) -(defn- build-step - [key item] - (letfn [(coerce-key [key] (if (vector? key) key [key]))] - (if (vector? item) - (let [validator (first item) - result (split-with notopts? (rest item)) - args (first result) - opts (apply hash-map (second result))] - (merge (assoc validator :args args :path (coerce-key key)) - (select-keys opts [:coerce :message :optional]))) - (assoc item :args [] :path (coerce-key key))))) - -(defn- normalize-step-map-entry - [acc key value] - (if (vector? value) - (reduce #(conj! %1 (build-step key %2)) acc value) - (conj! acc (build-step key value)))) - -(defn- normalize-step-entry - [acc [key & values]] - (reduce #(conj! %1 (build-step key %2)) acc values)) - -(defn- build-steps +(defn- compile-validator + [data] + (cond + (map? data) + data + + (fn? data) + {:type ::custom-predicate + :optional true + :validate #(data %2)} + + (vector? data) + (let [vdata (compile-validator (first data)) + result (split-with notopts? (rest data)) + args (first result) + opts (apply hash-map (second result)) + ofn (:validate vdata) + nfn (fn [data val] + (apply ofn data val args))] + (merge vdata opts {:validate nfn})) + + :else + (throw (ex-info (pr-str "Invalid validator data:" data) {:data data})))) + +(defn compile-validation-fn + [items] + (reduce (fn [acc item] + (let [validate-fn (:validate item) + optional? (:optional item)] + (fn [data value] + (if (or (and (nil? value) optional?) + (validate-fn data value)) + (acc data value) + {:valid? false :validator item})))) + (constantly {:valid? true}) + (reverse items))) + +(defn- compile-coerce-fn + [items] + (reduce (fn [acc item] + (let [coerce (:coerce item identity)] + #(coerce (acc %)))) + identity + (reverse items))) + +(defn- compile-schema-entry + [[key & validators]] + (let [validators (mapv compile-validator validators)] + {:path (if (vector? key) key [key]) + :vfn (compile-validation-fn validators) + :cfn (compile-coerce-fn validators)})) + +(defn- schema-map->vec + [schema] + (reduce-kv (fn [acc k v] + (if (vector? v) + (conj acc (cons k v)) + (conj acc (cons k (list v))))) + [] + schema)) + +(defn compile-schema + [schema] + (let [items (cond + (vector? schema) (seq schema) + (map? schema) (schema-map->vec schema) + :else (throw (ex-info "Invalid schema." {})))] + {::schema true + ::items (mapv compile-schema-entry items)})) + +(defn- format-error + [result value] + (let [validator (:validator result) + msg (:message validator nil) + msg (if (fn? msg) (msg validator) msg)] + (assoc validator + :message msg + :value value))) + +(defn- impl-validate + [data items] + (reduce (fn [_ {:keys [path vfn] :as item}] + (let [value (get-in data path)] + (or (vfn data value) + (reduced false)))) + true + items)) + +(defn- impl-validate-and-coerce + [data items opts] + (reduce (fn [acc {:keys [path vfn cfn] :as item}] + (let [value (get-in data path) + result (vfn data value)] + (if (:valid? result) + (let [val (cfn value)] + (if (nil? val) + acc + (update acc :data assoc-in path val))) + (let [validator (:validator result) + error (format-error result value)] + (-> acc + (update :data dissoc-in path) + (update :errors assoc-in path error)))))) + (if (:strip opts) {:data {}} {:data data}) + items)) + +(defn- resolve-schema [schema] (cond - (vector? schema) - (persistent! - (reduce normalize-step-entry (transient []) schema)) + (delay? schema) + (resolve-schema @schema) - (map? schema) - (persistent! - (reduce-kv normalize-step-map-entry (transient []) schema)) + (true? (::schema schema)) + schema + + (or (map? schema) + (vector? schema)) + (compile-schema schema) :else - (throw (ex-info "Invalid schema." {})))) - -(defn- strip-values - [data steps] - (reduce (fn [acc path] - (let [value (get-in data path ::notexists)] - (if (not= value ::notexists) - (assoc-in acc path value) - acc))) - {} - (into #{} (map' :path steps)))) - -(defn- validate-internal - [data steps opts] - (loop [skip #{} - errors nil - data data - steps steps] - (if-let [step (first steps)] - (let [path (:path step) - value (get-in data path)] - (cond - (contains? skip path) - (recur skip errors data (rest steps)) - - (and (nil? value) (:optional step)) - (recur skip errors data (rest steps)) - - (apply-validation step data value) - (let [value ((:coerce step identity) value)] - (recur skip errors (assoc-in data path value) (rest steps))) - - :else - (let [message (prepare-message opts step)] - (recur (conj skip path) - (assoc-in errors path message) - (dissoc-in data path) - (rest steps))))) - [errors data]))) + (throw (ex-info "Invalid value for schema." {:schema schema})))) ;; --- Public Api +#?(:clj + (defmacro defs + [namesym schema] + {:pre [(symbol? namesym) + (or (map? schema) + (vector? schema))]} + `(def ~namesym + (delay (compile-schema ~schema))))) + (defn validate "Validate data with specified schema. @@ -125,20 +172,17 @@ as third argument." ([data schema] (validate data schema nil)) - ([data schema {:keys [strip] - :or {strip false} - :as opts}] - (let [steps (build-steps schema) - data (if strip (strip-values data steps) data)] - (validate-internal data steps opts)))) - -(defn validate-single - "A helper that used just for validate one value." - ([data schema] (validate-single data schema nil)) ([data schema opts] - (let [data {:field data} - steps (build-steps {:field schema})] - (mapv :field (validate-internal data steps opts))))) + (let [schema (resolve-schema schema) + result (impl-validate-and-coerce data (::items schema) opts)] + [(:errors result) + (:data result)]))) + +(defn valid? + [data schema] + (let [schema (resolve-schema schema) + result (impl-validate data (::items schema))] + (:valid? result))) (defn validate! "Analogous function to the `validate` that instead of return @@ -146,7 +190,7 @@ them are or just return the validated data. This function accepts the same parameters as `validate` with - an additional `:message` that serves for customize the exception + an additional `:msg` that serves for customize the exception message." ([data schema] (validate! data schema nil)) @@ -156,174 +200,162 @@ (throw (ex-info message errors)) data)))) -(defn valid? - "Return true if the data matches the schema, otherwise - return false." - [data schema] - (nil? (first (validate data schema {::nomsg true})))) - -(defn valid-single? - "Analogous function to `valid?` that just validates single value." - [data schema] - (nil? (first (validate-single data schema {::nomsg true})))) - ;; --- Validators (def keyword - {:message "must be a keyword" + {:type ::keyword :optional true - :validate keyword? - :coerce identity}) + :validate #(keyword? %2)}) (def uuid - {:message "must be an uuid" + {:type ::uuid :optional true - :validate #?(:clj #(instance? java.util.UUID %) - :cljs #(instance? cljs.core.UUID %))}) + :validate #?(:clj #(instance? java.util.UUID %2) + :cljs #(instance? cljs.core.UUID %2))}) (def ^:const ^:private +uuid-re+ #"^[0-9a-f]{8}-[0-9a-f]{4}-[1-5][0-9a-f]{3}-[89ab][0-9a-f]{3}-[0-9a-f]{12}$") (def uuid-str - {:message "must be an uuid" + {:type ::uuid-str :optional true - :validate #(and (string? %) - (re-seq +uuid-re+ %)) + :validate #(and (string? %2) + (re-seq +uuid-re+ %2)) :coerce #?(:clj #(java.util.UUID/fromString %) :cljs #(uuid %))}) (def email (let [rx #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$"] - {:message "must be a valid email" + {:type ::email :optional true - :validate #(and (string? %) - (re-seq rx %))})) + :validate #(and (string? %2) + (re-seq rx %2))})) (def required - {:message "this field is mandatory" + {:type ::required :optional false - :validate #(if (string? %) - (not (empty? %)) - (not (nil? %)))}) + :validate #(if (string? %2) + (not (empty? %2)) + (not (nil? %2)))}) (def number - {:message "must be a number" + {:type ::number :optional true - :validate number?}) + :validate #(number? %2)}) (def number-str - {:message "must be a number" + {:type ::number-str :optional true - :validate #(or (number? %) (and (string? %) (str/numeric? %))) - :coerce #(if (number? %) % (str/parse-number %))}) + :validate #(or (number? %2) (and (string? %2) (util/numeric? %2))) + :coerce #(if (number? %) % (util/parse-number %))}) (def integer - {:message "must be a integer" + {:type ::integer :optional true - :validate #?(:cljs #(js/Number.isInteger %) - :clj #(integer? %))}) + :validate #?(:cljs #(js/Number.isInteger %2) + :clj #(integer? %2))}) (def integer-str - {:message "must be a long" + {:type ::integer-str :optional true - :validate #(or (number? %) (and (string? %) (str/numeric? %))) - :coerce #(if (number? %) (int %) (str/parse-int %))}) + :validate #(or (number? %2) (and (string? %2) (util/numeric? %2))) + :coerce #(if (number? %) (int %) (util/parse-int %))}) (def boolean - {:message "must be a boolean" + {:type ::boolean :optional true - :validate #(or (= false %) (= true %))}) + :validate #(or (= false %2) (= true %2))}) (def boolean-str - {:message "must be a boolean" + {:type ::boolean-str :optional true - :validate #(and (string? %) - (re-seq #"^(?:t|true|false|f|0|1)$" %)) + :validate #(and (string? %2) + (re-seq #"^(?:t|true|false|f|0|1)$" %2)) :coerce #(contains? #{"t" "true" "1"} %)}) (def string - {:message "must be a string" + {:type ::string :optional true - :validate string?}) + :validate #(string? %2)}) (def string-like - {:message "must be a string" + {:type ::string-like :optional true + :validate (constantly true) :coerce str}) (def in-range - {:message "not in range %s and %s" + {:type ::in-range :optional true - :validate #(and (number? %1) - (number? %2) + :validate #(and (number? %2) (number? %3) - (<= %2 %1 %3))}) + (number? %4) + (<= %3 %2 %4))}) (def positive - {:message "must be positive" + {:type ::positive :optional true - :validate pos?}) + :validate #(pos? %2)}) (def negative - {:message "must be negative" + {:type ::negative :optional true - :validate neg?}) + :validate #(neg? %)}) (def map - {:message "must be a map" + {:type ::map :optional true - :validate map?}) + :validate #(map? %2)}) (def set - {:message "must be a set" + {:type ::set :optional true - :validate set?}) + :validate #(set? %2)}) (def coll - {:message "must be a collection" + {:type ::coll :optional true - :validate coll?}) + :validate #(coll? %2)}) (def vector - {:message "must be a vector instance" + {:type ::vector :optional true - :validate vector?}) + :validate #(vector? %2)}) (def every - {:message "must match the predicate" + {:type ::every :optional true - :validate #(every? %2 %1)}) + :validate #(every? %3 %2)}) (def member - {:message "not in coll" + {:type ::member :optional true - :validate #(some #{%1} %2)}) + :validate #(some #{%2} %3)}) (def function - {:message "must be a function" + {:type ::function :optional true - :validate ifn?}) + :validate #(fn? %2)}) (def identical-to - {:message "does not match" + {:type ::identical-to :optional true - :state true :validate (fn [state v ref] (let [prev (get state ref)] (= prev v)))}) (def min-count - (letfn [(validate [v minimum] + (letfn [(validate [_ v minimum] {:pre [(number? minimum)]} (>= (count v) minimum))] - {:message "less than the minimum %s" + {:type ::min-count :optional true :validate validate})) (def max-count - (letfn [(validate [v maximum] + (letfn [(validate [_ v maximum] {:pre [(number? maximum)]} (<= (count v) maximum))] - {:message "longer than the maximum %s" + {:type ::max-count :optional true :validate validate})) diff --git a/src/struct/util.cljc b/src/struct/util.cljc new file mode 100644 index 0000000..90daa5c --- /dev/null +++ b/src/struct/util.cljc @@ -0,0 +1,27 @@ +(ns struct.util + (:require #?(:cljs [cljs.reader :as edn] + :clj [clojure.edn :as edn]))) + +(defn numeric? + [s] + (when (string? s) + (boolean (re-matches #"^[+-]?([0-9]*\.?[0-9]+|[0-9]+\.?[0-9]*)([eE][+-]?[0-9]+)?$" s)))) + +(defn parse-number + [s] + (when (numeric? s) + (edn/read-string s))) + +(defn parse-int + "Return the number value in integer form." + [s] + (cond + (number? s) + (int s) + + (numeric? s) + #?(:clj (.longValue (java.math.BigDecimal. ^String s)) + :cljs (js/parseInt s 10)) + + :else nil)) + diff --git a/test/struct/tests.cljc b/test/struct/tests.cljc index f7af2bc..8d939be 100644 --- a/test/struct/tests.cljc +++ b/test/struct/tests.cljc @@ -1,7 +1,11 @@ (ns struct.tests - (:require #?(:cljs [cljs.test :as t] - :clj [clojure.test :as t]) - [struct.core :as st])) + (:require + ;; #?(:clj [criterium.core :refer [quick-bench]]) + ;; #?(:cljs [cljs.spec.alpha :as s] + ;; :clj [clojure.spec.alpha :as s]) + #?(:cljs [cljs.test :as t] + :clj [clojure.test :as t]) + [struct.core :as st])) ;; --- Tests @@ -17,116 +21,116 @@ (let [scheme {:max st/number :scope st/string} input {:scope "foobar" :max "d"} - errors {:max "must be a number"} - result (st/validate input scheme)] - (t/is (= errors (first result))) - (t/is (= {:scope "foobar"} (second result))))) + [error data] (st/validate input scheme)] + (t/is (map? error)) + (t/is (= (get-in error [:max :type]) ::st/number)) + (t/is (map? data)) + (t/is (= (get data :scope) "foobar")))) + +(t/deftest test-predicate-validators + (let [scheme {:max [st/required number?]} + input1 {:max "foo"} + input2 {:max 2} + [error1 data1] (st/validate input1 scheme) + [error2 data2] (st/validate input2 scheme)] + + (t/is (map? error1)) + (t/is (map? data1)) + (t/is (empty? data1)) + (t/is (= (get-in error1 [:max :type]) ::st/custom-predicate)) + + (t/is (nil? error2)) + (t/is (map? data2)) + (t/is (= (get data2 :max) 2)))) (t/deftest test-neested-validators (let [scheme {[:a :b] st/number [:c :d :e] st/string} input {:a {:b "foo"} :c {:d {:e "bar"}}} - errors {:a {:b "must be a number"}} - result (st/validate input scheme)] - (t/is (= errors (first result))) - (t/is (= {:c {:d {:e "bar"}}} (second result))))) - -(t/deftest test-single-validators - (let [result1 (st/validate-single 2 st/number) - result2 (st/validate-single nil st/number) - result3 (st/validate-single nil [st/required st/number])] - (t/is (= [nil 2] result1)) - (t/is (= [nil nil] result2)) - (t/is (= ["this field is mandatory" nil] result3)))) + [errors data] (st/validate input scheme)] + (t/is (map? errors)) + (t/is (= (get-in errors [:a :b :type]) ::st/number)) + (t/is (map? data)) + (t/is (= (get-in data [:c :d :e]) "bar")))) (t/deftest test-parametric-validators - (let [result1 (st/validate - {:name "foo"} - {:name [[st/min-count 4]]}) - result2 (st/validate - {:name "bar"} - {:name [[st/max-count 2]]})] - (t/is (= {:name "less than the minimum 4"} (first result1))) - (t/is (= {:name "longer than the maximum 2"} (first result2))))) + (let [[errors1 data1] (st/validate {:name "foo"} + {:name [[st/min-count 4]]}) + [errors2 data2] (st/validate {:name "bar"} + {:name [[st/max-count 2]]})] + (t/is (map? data1)) + (t/is (map? data2)) + (t/is (empty? data1)) + (t/is (empty? data2)) + (t/is (= (get-in errors1 [:name :type]) ::st/min-count)) + (t/is (= (get-in errors2 [:name :type]) ::st/max-count)) + (t/is (= (get-in errors1 [:name :value]) "foo")) + (t/is (= (get-in errors2 [:name :value]) "bar")))) (t/deftest test-simple-validators-with-vector-schema (let [scheme [[:max st/number] [:scope st/string]] input {:scope "foobar" :max "d"} - errors {:max "must be a number"} - result (st/validate input scheme)] - (t/is (= errors (first result))) - (t/is (= {:scope "foobar"} (second result))))) + [errors data] (st/validate input scheme)] -(t/deftest test-simple-validators-with-translate - (let [scheme [[:max st/number] - [:scope st/string]] + (t/is (map? errors)) + (t/is (= (get-in errors [:max :type]) ::st/number)) + (t/is (map? data)) + (t/is (= (get data :scope) "foobar")))) + +(t/deftest test-simple-validators-message + (let [scheme [[:max [st/number :message (constantly "a")]] + [:scope [st/string :message (constantly "b")]]] input {:scope "foobar" :max "d"} - errors {:max "a"} - result (st/validate input scheme {:translate (constantly "a")})] - (t/is (= errors (first result))) - (t/is (= {:scope "foobar"} (second result))))) + [errros data] (st/validate input scheme)] + (t/is (map? errros)) + (t/is (map? data)) + (t/is (= (get-in errros [:max :type]) ::st/number)) + (t/is (= (get-in errros [:max :message]) "a")) + (t/is (= (get data :scope) "foobar")))) (t/deftest test-dependent-validators-1 (let [scheme [[:password1 st/string] [:password2 [st/identical-to :password1]]] input {:password1 "foobar" :password2 "foobar."} - errors {:password2 "does not match"} - result (st/validate input scheme)] - (t/is (= errors (first result))) - (t/is (= {:password1 "foobar"} (second result))))) + [errors data] (st/validate input scheme)] + (t/is (map? errors)) + (t/is (map? data)) + (t/is (= (get-in errors [:password2 :type]) ::st/identical-to)) + (t/is (= (get data :password1) "foobar")))) (t/deftest test-dependent-validators-2 (let [scheme [[:password1 st/string] [:password2 [st/identical-to :password1]]] input {:password1 "foobar" :password2 "foobar"} - result (st/validate input scheme)] - (t/is (= nil (first result))) - (t/is (= {:password1 "foobar" - :password2 "foobar"} (second result))))) + [errors data] (st/validate input scheme)] + (t/is (nil? errors)) + (t/is (map? data)) + (t/is (= (get data :password1) "foobar")) + (t/is (= (get data :password2) "foobar")))) (t/deftest test-multiple-validators (let [scheme {:max [st/required st/number] :scope st/string} input {:scope "foobar"} - errors {:max "this field is mandatory"} - result (st/validate input scheme)] - (t/is (= errors (first result))) - (t/is (= {:scope "foobar"} (second result))))) + [errors data] (st/validate input scheme)] + (t/is (map? errors)) + (t/is (map? data)) + (t/is (= (get-in errors [:max :type]) ::st/required)) + (t/is (= (get data :scope) "foobar")))) (t/deftest test-validation-with-coersion - (let [scheme {:max st/integer-str - :scope st/string} - input {:max "2" :scope "foobar"} - result (st/validate input scheme)] - (t/is (= nil (first result))) - (t/is (= {:max 2 :scope "foobar"} (second result))))) - -(t/deftest test-validation-with-custom-coersion - (let [scheme {:max [[st/number-str :coerce (constantly :foo)]] - :scope st/string} + (let [scheme {:max [st/required st/integer-str] + :scope [[st/string :coerce (constantly :foo)]]} input {:max "2" :scope "foobar"} - result (st/validate input scheme)] - (t/is (= nil (first result))) - (t/is (= {:max :foo :scope "foobar"} (second result))))) - -(t/deftest test-validation-with-custom-message - (let [scheme {:max [[st/number-str :message "custom msg"]] - :scope st/string} - input {:max "g" :scope "foobar"} - errors {:max "custom msg"} - result (st/validate input scheme)] - (t/is (= errors (first result))) - (t/is (= {:scope "foobar"} (second result))))) - -(t/deftest test-coersion-with-valid-values - (let [scheme {:a st/number-str - :b st/integer-str} - input {:a 2.3 :b 3.3} [errors data] (st/validate input scheme)] - (t/is (= {:a 2.3 :b 3} data)))) + + (t/is (nil? errors)) + (t/is (map? data)) + (t/is (= (get data :max) 2)) + (t/is (= (get data :scope) :foo)))) (t/deftest test-validation-nested-data-in-a-vector (let [scheme {:a [st/vector [st/every number?]]} @@ -134,41 +138,84 @@ input2 {:a [1 2 3 4 "a"]} [errors1 data1] (st/validate input1 scheme) [errors2 data2] (st/validate input2 scheme)] - (t/is (= data1 input1)) - (t/is (= errors1 nil)) - (t/is (= data2 {})) - (t/is (= errors2 {:a "must match the predicate"})))) - -(t/deftest test-in-range-validator - (t/is (= {:age "not in range 18 and 26"} - (-> {:age 17} - (st/validate {:age [[st/in-range 18 26]]}) - first)))) - -(t/deftest test-honor-nested-data - (let [scheme {[:a :b] [st/required - st/string - [st/min-count 2 :message "foobar"] - [st/max-count 5]]} - input1 {:a {:b "abcd"}} - input2 {:a {:b "abcdefgh"}} - input3 {:a {:b "a"}} - [errors1 data1] (st/validate input1 scheme) - [errors2 data2] (st/validate input2 scheme) - [errors3 data3] (st/validate input3 scheme)] - (t/is (= data1 input1)) - (t/is (= errors1 nil)) - (t/is (= data2 {})) - (t/is (= errors2 {:a {:b "longer than the maximum 5"}})) - (t/is (= data3 {})) - (t/is (= errors3 {:a {:b "foobar"}})))) + + + (t/is (map? data1)) + (t/is (nil? errors1)) + (t/is (= (get data1 :a) [1 2 3 4])) + + (t/is (map? data2)) + (t/is (map? errors2)) + (t/is (empty? data2)) + (t/is (= (get-in errors2 [:a :type] ::st/every))))) + +;; (def email-rx +;; #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$") + +;; (defn email? +;; [v] +;; (and string? +;; (re-matches email-rx v))) + +;; (s/def ::username string?) +;; (s/def ::age number?) +;; (s/def ::email email?) +;; ;; +;; (s/def ::bench-form +;; (s/keys :req-un [::username ::age ::email])) + +;; (st/defs bench-form +;; {:username [st/required st/string] +;; :age [st/required st/number] +;; :email [st/required st/email]}) + +;; (defn bench-fn-using-spec +;; [data] +;; (let [result (s/valid? ::bench-form data)] +;; (assert result "should be valid"))) + +;; (defn bench-fn-using-struct +;; [data] +;; (let [result (st/valid? data bench-form)] +;; (assert result "should be valid"))) + +;; #?(:cljs +;; (defn bench1 +;; [] +;; (simple-benchmark [data {:username "foo" :age 10 :email "foo@bar.com"}] +;; (bench-fn-using-spec data) +;; 100000)) +;; :clj +;; (defn bench1 +;; [] +;; (let [data {:username "foo" :age 10 :email "foo@bar.com"}] +;; (quick-bench (bench-fn-using-spec data))))) + +;; #?(:cljs +;; (defn bench2 +;; [] +;; (simple-benchmark [data {:username "foo" :age 10 :email "foo@bar.com"}] +;; (bench-fn-using-struct data) +;; 100000)) +;; :clj +;; (defn bench2 +;; [] +;; (let [data {:username "foo" :age 10 :email "foo@bar.com"}] +;; (quick-bench (bench-fn-using-struct data))))) ;; --- Entry point #?(:cljs (do (enable-console-print!) - (set! *main-cli-fn* #(t/run-tests)))) + (set! *main-cli-fn* #(t/run-tests))) + :clj + (defn -main + [& args] + (let [{:keys [fail]} (t/run-all-tests #"^struct.tests.*")] + (if (pos? fail) + (System/exit fail) + (System/exit 0))))) #?(:cljs (defmethod t/report [:cljs.test/default :end-run-tests] diff --git a/test/user.clj b/test/user.clj new file mode 100644 index 0000000..9be4630 --- /dev/null +++ b/test/user.clj @@ -0,0 +1,17 @@ +(ns user + (:require [clojure.tools.namespace.repl :as r] + [clojure.test :as test])) + +(defn run-tests + ([] (run-tests #"^struct.tests.*")) + ([o] + (r/refresh) + (cond + (instance? java.util.regex.Pattern o) + (test/run-all-tests o) + + (symbol? o) + (if-let [sns (namespace o)] + (do (require (symbol sns)) + (test/test-vars [(resolve o)])) + (test/test-ns o))))) diff --git a/tools.clj b/tools.clj index d689311..23b0f5b 100644 --- a/tools.clj +++ b/tools.clj @@ -5,8 +5,7 @@ '[rebel-readline.clojure.line-reader] '[rebel-readline.clojure.service.local] '[rebel-readline.cljs.service.local] - '[rebel-readline.cljs.repl] - '[eftest.runner :as ef]) + '[rebel-readline.cljs.repl]) (require '[cljs.build.api :as api] '[cljs.repl :as repl] '[cljs.repl.node :as node]) @@ -20,30 +19,28 @@ (println "Unknown or missing task. Choose one of:" interposed) (System/exit 1))) -(defmethod task "repl" - [[_ type]] - (case type - (nil "clj") - (rebel-readline.core/with-line-reader - (rebel-readline.clojure.line-reader/create - (rebel-readline.clojure.service.local/create)) - (clojure.main/repl - :prompt (fn []) ;; prompt is handled by line-reader - :read (rebel-readline.clojure.main/create-repl-read))) - - "node" - (rebel-readline.core/with-line-reader - (rebel-readline.clojure.line-reader/create (rebel-readline.cljs.service.local/create)) - (cljs.repl/repl - (node/repl-env) - :prompt (fn []) ;; prompt is handled by line-reader - :read (rebel-readline.cljs.repl/create-repl-read) - :output-dir "out" - :cache-analysis false)) - (println "Unknown repl: " type) - (System/exit 1))) - -(def options +(defmethod task "repl:jvm" + [args] + (rebel-readline.core/with-line-reader + (rebel-readline.clojure.line-reader/create + (rebel-readline.clojure.service.local/create)) + (clojure.main/repl + :prompt (fn []) ;; prompt is handled by line-reader + :read (rebel-readline.clojure.main/create-repl-read)))) + +(defmethod task "repl:node" + [args] + (rebel-readline.core/with-line-reader + (rebel-readline.clojure.line-reader/create + (rebel-readline.cljs.service.local/create)) + (cljs.repl/repl + (node/repl-env) + :prompt (fn []) ;; prompt is handled by line-reader + :read (rebel-readline.cljs.repl/create-repl-read) + :output-dir "out" + :cache-analysis false))) + +(def build-options {:main 'struct.tests :output-to "out/tests.js" :output-dir "out/tests" @@ -54,58 +51,9 @@ :language-out :ecmascript5 :verbose true}) -(defmethod task "test" - [[_ exclude]] - (let [tests (ef/find-tests "test") - tests (if (string? exclude) - (ef/find-tests (symbol exclude)) - tests)] - (ef/run-tests tests - {:fail-fast? true - :capture-output? false - :multithread? false}) - (System/exit 1))) - - -(defmethod task "test-cljs" - [[_ type]] - (letfn [(build [optimizations] - (api/build (api/inputs "src" "test") - (cond-> (assoc options :optimizations optimizations) - (= optimizations :none) (assoc :source-map true)))) - - (run-tests [] - (let [{:keys [out err]} (shell/sh "node" "out/tests.js")] - (println out err))) - - (test-once [] - (build :none) - (run-tests) - (shutdown-agents)) - - (test-watch [] - (println "Start watch loop...") - (try - (api/watch (api/inputs "src", "test") - (assoc options - :parallel-build false - :watch-fn run-tests - :cache-analysis false - :optimizations :none - :source-map true)) - (catch Exception e - (println "ERROR:" e) - (Thread/sleep 2000) - (test-watch))))] - - (case type - (nil "once") (test-once) - "watch" (test-watch) - "build-none" (build :none) - "build-simple" (build :simple) - "build-advanced" (build :advanced) - (do (println "Unknown argument to test task:" type) - (System/exit 1))))) +(defmethod task "build:tests" + [args] + (api/build (api/inputs "src" "test") build-options)) ;;; Build script entrypoint. This should be the last expression. From 6ad24d80e642939fbc2d055f888e2c3f91c8a235 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Wed, 28 Aug 2019 18:30:46 +0200 Subject: [PATCH 02/13] Remove unused data from error object. --- doc/content.adoc | 2 -- src/struct/core.cljc | 12 ++++++------ 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/doc/content.adoc b/doc/content.adoc index 28d9faa..92cdcd7 100644 --- a/doc/content.adoc +++ b/doc/content.adoc @@ -101,8 +101,6 @@ The error has the following structure: [source, clojure] ---- {:type :struct.core/required, - :optional false, - :validate #object[function], :message nil, :value nil} ---- diff --git a/src/struct/core.cljc b/src/struct/core.cljc index 3341167..9fed0ec 100644 --- a/src/struct/core.cljc +++ b/src/struct/core.cljc @@ -103,12 +103,12 @@ (defn- format-error [result value] - (let [validator (:validator result) - msg (:message validator nil) - msg (if (fn? msg) (msg validator) msg)] - (assoc validator - :message msg - :value value))) + (let [vdata (:validator result) + msg (:message vdata nil) + msg (if (fn? msg) (msg vdata) msg)] + {:type (:type vdata) + :message msg + :value value})) (defn- impl-validate [data items] From fcf2f236fcd2902e10dc859c23f80411578b6256 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Wed, 28 Aug 2019 18:36:48 +0200 Subject: [PATCH 03/13] Invert call signatures (make them identical to spec.alpha). --- src/struct/core.cljc | 24 ++++++++++++------------ test/struct/tests.cljc | 32 +++++++++++++++----------------- 2 files changed, 27 insertions(+), 29 deletions(-) diff --git a/src/struct/core.cljc b/src/struct/core.cljc index 9fed0ec..6399ecd 100644 --- a/src/struct/core.cljc +++ b/src/struct/core.cljc @@ -111,7 +111,7 @@ :value value})) (defn- impl-validate - [data items] + [items data] (reduce (fn [_ {:keys [path vfn] :as item}] (let [value (get-in data path)] (or (vfn data value) @@ -120,7 +120,7 @@ items)) (defn- impl-validate-and-coerce - [data items opts] + [items data opts] (reduce (fn [acc {:keys [path vfn cfn] :as item}] (let [value (get-in data path) result (vfn data value)] @@ -170,18 +170,18 @@ This function by default strips all data that are not defined in schema, but this behavior can be changed by passing `{:strip false}` as third argument." - ([data schema] - (validate data schema nil)) - ([data schema opts] + ([schema data] + (validate schema data nil)) + ([schema data opts] (let [schema (resolve-schema schema) - result (impl-validate-and-coerce data (::items schema) opts)] + result (impl-validate-and-coerce (::items schema) data opts)] [(:errors result) (:data result)]))) (defn valid? - [data schema] + [schema data] (let [schema (resolve-schema schema) - result (impl-validate data (::items schema))] + result (impl-validate (::items schema) data)] (:valid? result))) (defn validate! @@ -192,10 +192,10 @@ This function accepts the same parameters as `validate` with an additional `:msg` that serves for customize the exception message." - ([data schema] - (validate! data schema nil)) - ([data schema {:keys [message] :or {message "Schema validation error"} :as opts}] - (let [[errors data] (validate data schema opts)] + ([schema data] + (validate! schema data nil)) + ([schema data {:keys [message] :or {message "Schema validation error"} :as opts}] + (let [[errors data] (validate schema data opts)] (if (seq errors) (throw (ex-info message errors)) data)))) diff --git a/test/struct/tests.cljc b/test/struct/tests.cljc index 8d939be..4dc3780 100644 --- a/test/struct/tests.cljc +++ b/test/struct/tests.cljc @@ -13,7 +13,7 @@ (let [scheme {:max st/number :scope st/string} input {:scope "foobar"} - result (st/validate input scheme)] + result (st/validate scheme input)] (t/is (= nil (first result))) (t/is (= input (second result))))) @@ -21,7 +21,7 @@ (let [scheme {:max st/number :scope st/string} input {:scope "foobar" :max "d"} - [error data] (st/validate input scheme)] + [error data] (st/validate scheme input)] (t/is (map? error)) (t/is (= (get-in error [:max :type]) ::st/number)) (t/is (map? data)) @@ -31,8 +31,8 @@ (let [scheme {:max [st/required number?]} input1 {:max "foo"} input2 {:max 2} - [error1 data1] (st/validate input1 scheme) - [error2 data2] (st/validate input2 scheme)] + [error1 data1] (st/validate scheme input1) + [error2 data2] (st/validate scheme input2)] (t/is (map? error1)) (t/is (map? data1)) @@ -47,17 +47,15 @@ (let [scheme {[:a :b] st/number [:c :d :e] st/string} input {:a {:b "foo"} :c {:d {:e "bar"}}} - [errors data] (st/validate input scheme)] + [errors data] (st/validate scheme input)] (t/is (map? errors)) (t/is (= (get-in errors [:a :b :type]) ::st/number)) (t/is (map? data)) (t/is (= (get-in data [:c :d :e]) "bar")))) (t/deftest test-parametric-validators - (let [[errors1 data1] (st/validate {:name "foo"} - {:name [[st/min-count 4]]}) - [errors2 data2] (st/validate {:name "bar"} - {:name [[st/max-count 2]]})] + (let [[errors1 data1] (st/validate {:name [[st/min-count 4]]} {:name "foo"}) + [errors2 data2] (st/validate {:name [[st/max-count 2]]} {:name "bar"})] (t/is (map? data1)) (t/is (map? data2)) (t/is (empty? data1)) @@ -71,7 +69,7 @@ (let [scheme [[:max st/number] [:scope st/string]] input {:scope "foobar" :max "d"} - [errors data] (st/validate input scheme)] + [errors data] (st/validate scheme input)] (t/is (map? errors)) (t/is (= (get-in errors [:max :type]) ::st/number)) @@ -82,7 +80,7 @@ (let [scheme [[:max [st/number :message (constantly "a")]] [:scope [st/string :message (constantly "b")]]] input {:scope "foobar" :max "d"} - [errros data] (st/validate input scheme)] + [errros data] (st/validate scheme input)] (t/is (map? errros)) (t/is (map? data)) (t/is (= (get-in errros [:max :type]) ::st/number)) @@ -94,7 +92,7 @@ [:password2 [st/identical-to :password1]]] input {:password1 "foobar" :password2 "foobar."} - [errors data] (st/validate input scheme)] + [errors data] (st/validate scheme input)] (t/is (map? errors)) (t/is (map? data)) (t/is (= (get-in errors [:password2 :type]) ::st/identical-to)) @@ -105,7 +103,7 @@ [:password2 [st/identical-to :password1]]] input {:password1 "foobar" :password2 "foobar"} - [errors data] (st/validate input scheme)] + [errors data] (st/validate scheme input)] (t/is (nil? errors)) (t/is (map? data)) (t/is (= (get data :password1) "foobar")) @@ -115,7 +113,7 @@ (let [scheme {:max [st/required st/number] :scope st/string} input {:scope "foobar"} - [errors data] (st/validate input scheme)] + [errors data] (st/validate scheme input)] (t/is (map? errors)) (t/is (map? data)) (t/is (= (get-in errors [:max :type]) ::st/required)) @@ -125,7 +123,7 @@ (let [scheme {:max [st/required st/integer-str] :scope [[st/string :coerce (constantly :foo)]]} input {:max "2" :scope "foobar"} - [errors data] (st/validate input scheme)] + [errors data] (st/validate scheme input)] (t/is (nil? errors)) (t/is (map? data)) @@ -136,8 +134,8 @@ (let [scheme {:a [st/vector [st/every number?]]} input1 {:a [1 2 3 4]} input2 {:a [1 2 3 4 "a"]} - [errors1 data1] (st/validate input1 scheme) - [errors2 data2] (st/validate input2 scheme)] + [errors1 data1] (st/validate scheme input1) + [errors2 data2] (st/validate scheme input2)] (t/is (map? data1)) From a3757441391333bd265765265aea16b42f2e71c1 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Thu, 29 Aug 2019 09:16:15 +0200 Subject: [PATCH 04/13] Replace :type with :code. --- src/struct/core.cljc | 62 ++++++++++++++++++++---------------------- test/struct/tests.cljc | 20 +++++++------- 2 files changed, 39 insertions(+), 43 deletions(-) diff --git a/src/struct/core.cljc b/src/struct/core.cljc index 6399ecd..2f310d5 100644 --- a/src/struct/core.cljc +++ b/src/struct/core.cljc @@ -3,10 +3,6 @@ (:require [struct.util :as util]) #?(:cljs (:require-macros struct.core))) -#?(:clj (set! *warn-on-reflection* true) - :cljs (set! *warn-on-infer* true)) - - (def ^:private map' #?(:cljs cljs.core/map :clj clojure.core/map)) @@ -26,7 +22,7 @@ (dissoc m k))) (def ^:private opts-params - #{:coerce :message :optional :type}) + #{:coerce :message :optional :code}) (def ^:private notopts? (complement opts-params)) @@ -38,7 +34,7 @@ data (fn? data) - {:type ::custom-predicate + {:code ::custom-predicate :optional true :validate #(data %2)} @@ -106,7 +102,7 @@ (let [vdata (:validator result) msg (:message vdata nil) msg (if (fn? msg) (msg vdata) msg)] - {:type (:type vdata) + {:code (:code vdata) :message msg :value value})) @@ -203,12 +199,12 @@ ;; --- Validators (def keyword - {:type ::keyword + {:code ::keyword :optional true :validate #(keyword? %2)}) (def uuid - {:type ::uuid + {:code ::uuid :optional true :validate #?(:clj #(instance? java.util.UUID %2) :cljs #(instance? cljs.core.UUID %2))}) @@ -217,7 +213,7 @@ #"^[0-9a-f]{8}-[0-9a-f]{4}-[1-5][0-9a-f]{3}-[89ab][0-9a-f]{3}-[0-9a-f]{12}$") (def uuid-str - {:type ::uuid-str + {:code ::uuid-str :optional true :validate #(and (string? %2) (re-seq +uuid-re+ %2)) @@ -226,66 +222,66 @@ (def email (let [rx #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$"] - {:type ::email + {:code ::email :optional true :validate #(and (string? %2) (re-seq rx %2))})) (def required - {:type ::required + {:code ::required :optional false :validate #(if (string? %2) (not (empty? %2)) (not (nil? %2)))}) (def number - {:type ::number + {:code ::number :optional true :validate #(number? %2)}) (def number-str - {:type ::number-str + {:code ::number-str :optional true :validate #(or (number? %2) (and (string? %2) (util/numeric? %2))) :coerce #(if (number? %) % (util/parse-number %))}) (def integer - {:type ::integer + {:code ::integer :optional true :validate #?(:cljs #(js/Number.isInteger %2) :clj #(integer? %2))}) (def integer-str - {:type ::integer-str + {:code ::integer-str :optional true :validate #(or (number? %2) (and (string? %2) (util/numeric? %2))) :coerce #(if (number? %) (int %) (util/parse-int %))}) (def boolean - {:type ::boolean + {:code ::boolean :optional true :validate #(or (= false %2) (= true %2))}) (def boolean-str - {:type ::boolean-str + {:code ::boolean-str :optional true :validate #(and (string? %2) (re-seq #"^(?:t|true|false|f|0|1)$" %2)) :coerce #(contains? #{"t" "true" "1"} %)}) (def string - {:type ::string + {:code ::string :optional true :validate #(string? %2)}) (def string-like - {:type ::string-like + {:code ::string-like :optional true :validate (constantly true) :coerce str}) (def in-range - {:type ::in-range + {:code ::in-range :optional true :validate #(and (number? %2) (number? %3) @@ -293,52 +289,52 @@ (<= %3 %2 %4))}) (def positive - {:type ::positive + {:code ::positive :optional true :validate #(pos? %2)}) (def negative - {:type ::negative + {:code ::negative :optional true :validate #(neg? %)}) (def map - {:type ::map + {:code ::map :optional true :validate #(map? %2)}) (def set - {:type ::set + {:code ::set :optional true :validate #(set? %2)}) (def coll - {:type ::coll + {:code ::coll :optional true :validate #(coll? %2)}) (def vector - {:type ::vector + {:code ::vector :optional true :validate #(vector? %2)}) (def every - {:type ::every + {:code ::every :optional true :validate #(every? %3 %2)}) (def member - {:type ::member + {:code ::member :optional true :validate #(some #{%2} %3)}) (def function - {:type ::function + {:code ::function :optional true :validate #(fn? %2)}) (def identical-to - {:type ::identical-to + {:code ::identical-to :optional true :validate (fn [state v ref] (let [prev (get state ref)] @@ -348,7 +344,7 @@ (letfn [(validate [_ v minimum] {:pre [(number? minimum)]} (>= (count v) minimum))] - {:type ::min-count + {:code ::min-count :optional true :validate validate})) @@ -356,6 +352,6 @@ (letfn [(validate [_ v maximum] {:pre [(number? maximum)]} (<= (count v) maximum))] - {:type ::max-count + {:code ::max-count :optional true :validate validate})) diff --git a/test/struct/tests.cljc b/test/struct/tests.cljc index 4dc3780..560c571 100644 --- a/test/struct/tests.cljc +++ b/test/struct/tests.cljc @@ -23,7 +23,7 @@ input {:scope "foobar" :max "d"} [error data] (st/validate scheme input)] (t/is (map? error)) - (t/is (= (get-in error [:max :type]) ::st/number)) + (t/is (= (get-in error [:max :code]) ::st/number)) (t/is (map? data)) (t/is (= (get data :scope) "foobar")))) @@ -37,7 +37,7 @@ (t/is (map? error1)) (t/is (map? data1)) (t/is (empty? data1)) - (t/is (= (get-in error1 [:max :type]) ::st/custom-predicate)) + (t/is (= (get-in error1 [:max :code]) ::st/custom-predicate)) (t/is (nil? error2)) (t/is (map? data2)) @@ -49,7 +49,7 @@ input {:a {:b "foo"} :c {:d {:e "bar"}}} [errors data] (st/validate scheme input)] (t/is (map? errors)) - (t/is (= (get-in errors [:a :b :type]) ::st/number)) + (t/is (= (get-in errors [:a :b :code]) ::st/number)) (t/is (map? data)) (t/is (= (get-in data [:c :d :e]) "bar")))) @@ -60,8 +60,8 @@ (t/is (map? data2)) (t/is (empty? data1)) (t/is (empty? data2)) - (t/is (= (get-in errors1 [:name :type]) ::st/min-count)) - (t/is (= (get-in errors2 [:name :type]) ::st/max-count)) + (t/is (= (get-in errors1 [:name :code]) ::st/min-count)) + (t/is (= (get-in errors2 [:name :code]) ::st/max-count)) (t/is (= (get-in errors1 [:name :value]) "foo")) (t/is (= (get-in errors2 [:name :value]) "bar")))) @@ -72,7 +72,7 @@ [errors data] (st/validate scheme input)] (t/is (map? errors)) - (t/is (= (get-in errors [:max :type]) ::st/number)) + (t/is (= (get-in errors [:max :code]) ::st/number)) (t/is (map? data)) (t/is (= (get data :scope) "foobar")))) @@ -83,7 +83,7 @@ [errros data] (st/validate scheme input)] (t/is (map? errros)) (t/is (map? data)) - (t/is (= (get-in errros [:max :type]) ::st/number)) + (t/is (= (get-in errros [:max :code]) ::st/number)) (t/is (= (get-in errros [:max :message]) "a")) (t/is (= (get data :scope) "foobar")))) @@ -95,7 +95,7 @@ [errors data] (st/validate scheme input)] (t/is (map? errors)) (t/is (map? data)) - (t/is (= (get-in errors [:password2 :type]) ::st/identical-to)) + (t/is (= (get-in errors [:password2 :code]) ::st/identical-to)) (t/is (= (get data :password1) "foobar")))) (t/deftest test-dependent-validators-2 @@ -116,7 +116,7 @@ [errors data] (st/validate scheme input)] (t/is (map? errors)) (t/is (map? data)) - (t/is (= (get-in errors [:max :type]) ::st/required)) + (t/is (= (get-in errors [:max :code]) ::st/required)) (t/is (= (get data :scope) "foobar")))) (t/deftest test-validation-with-coersion @@ -145,7 +145,7 @@ (t/is (map? data2)) (t/is (map? errors2)) (t/is (empty? data2)) - (t/is (= (get-in errors2 [:a :type] ::st/every))))) + (t/is (= (get-in errors2 [:a :code] ::st/every))))) ;; (def email-rx ;; #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$") From fe014425ff068a922b652762a87a9696c0e6bd6e Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Thu, 29 Aug 2019 09:20:55 +0200 Subject: [PATCH 05/13] Improve coerce logic. --- src/struct/core.cljc | 139 ++++++++++++++++++++++++++++--------------- 1 file changed, 90 insertions(+), 49 deletions(-) diff --git a/src/struct/core.cljc b/src/struct/core.cljc index 2f310d5..9871b9f 100644 --- a/src/struct/core.cljc +++ b/src/struct/core.cljc @@ -46,38 +46,50 @@ ofn (:validate vdata) nfn (fn [data val] (apply ofn data val args))] - (merge vdata opts {:validate nfn})) + (merge vdata opts {:validate nfn :args args})) :else (throw (ex-info (pr-str "Invalid validator data:" data) {:data data})))) -(defn compile-validation-fn - [items] - (reduce (fn [acc item] - (let [validate-fn (:validate item) - optional? (:optional item)] +(defn- compile-validation-fn + [validators] + (reduce (fn [acc validator] + (let [validate-fn (:validate validator) + optional? (:optional validator)] (fn [data value] (if (or (and (nil? value) optional?) (validate-fn data value)) (acc data value) - {:valid? false :validator item})))) + {:valid? false :validator validator})))) (constantly {:valid? true}) - (reverse items))) + (reverse validators))) + +(defn- compile-validation-and-coerce-fn + [validators] + (reduce (fn [acc validator] + (let [validate-fn (:validate validator) + optional? (:optional validator) + coerce (:coerce validator identity)] + (fn [data value] + (cond + (and (nil? value) optional?) + (acc data value) -(defn- compile-coerce-fn - [items] - (reduce (fn [acc item] - (let [coerce (:coerce item identity)] - #(coerce (acc %)))) - identity - (reverse items))) + (validate-fn data value) + (update (acc data value) :value coerce) + + :else + {:valid? false :validator validator})))) + (fn [data value] + {:valid? true :value value}) + (reverse validators))) (defn- compile-schema-entry - [[key & validators]] + [key validators] (let [validators (mapv compile-validator validators)] {:path (if (vector? key) key [key]) :vfn (compile-validation-fn validators) - :cfn (compile-coerce-fn validators)})) + :cfn (compile-validation-and-coerce-fn validators)})) (defn- schema-map->vec [schema] @@ -90,12 +102,14 @@ (defn compile-schema [schema] - (let [items (cond - (vector? schema) (seq schema) - (map? schema) (schema-map->vec schema) - :else (throw (ex-info "Invalid schema." {})))] - {::schema true - ::items (mapv compile-schema-entry items)})) + (let [entries (cond + (vector? schema) (seq schema) + (map? schema) (schema-map->vec schema) + :else (throw (ex-info "Invalid schema." {})))] + (reduce (fn [acc [key & validators]] + (assoc acc key (compile-schema-entry key validators))) + {::compiled true} + entries))) (defn- format-error [result value] @@ -103,35 +117,36 @@ msg (:message vdata nil) msg (if (fn? msg) (msg vdata) msg)] {:code (:code vdata) + :type (:type vdata) :message msg :value value})) (defn- impl-validate - [items data] - (reduce (fn [_ {:keys [path vfn] :as item}] - (let [value (get-in data path)] - (or (vfn data value) - (reduced false)))) - true - items)) + [schema data] + (reduce-kv (fn [_ _ {:keys [path vfn] :as item}] + (let [value (get-in data path)] + (or (vfn data value) + (reduced false)))) + true + (dissoc schema ::compiled))) (defn- impl-validate-and-coerce - [items data opts] - (reduce (fn [acc {:keys [path vfn cfn] :as item}] - (let [value (get-in data path) - result (vfn data value)] - (if (:valid? result) - (let [val (cfn value)] - (if (nil? val) - acc - (update acc :data assoc-in path val))) - (let [validator (:validator result) - error (format-error result value)] - (-> acc - (update :data dissoc-in path) - (update :errors assoc-in path error)))))) - (if (:strip opts) {:data {}} {:data data}) - items)) + [schema data opts] + (reduce-kv (fn [acc key {:keys [path vfn cfn] :as entry}] + (let [value (get-in data path) + result (cfn data value) + result-value (:value result)] + (if (:valid? result) + (if (nil? result-value) + acc + (update acc :data assoc-in path result-value)) + (let [validator (:validator result) + error (format-error result value)] + (-> acc + (update :data dissoc-in path) + (update :errors assoc-in path error)))))) + (if (:strip opts) {:data {}} {:data data}) + (dissoc schema ::compiled))) (defn- resolve-schema [schema] @@ -139,7 +154,7 @@ (delay? schema) (resolve-schema @schema) - (true? (::schema schema)) + (true? (::compiled schema)) schema (or (map? schema) @@ -170,14 +185,14 @@ (validate schema data nil)) ([schema data opts] (let [schema (resolve-schema schema) - result (impl-validate-and-coerce (::items schema) data opts)] + result (impl-validate-and-coerce schema data opts)] [(:errors result) (:data result)]))) (defn valid? [schema data] (let [schema (resolve-schema schema) - result (impl-validate (::items schema) data)] + result (impl-validate schema data)] (:valid? result))) (defn validate! @@ -200,11 +215,13 @@ (def keyword {:code ::keyword + :type ::builtin :optional true :validate #(keyword? %2)}) (def uuid {:code ::uuid + :type ::builtin :optional true :validate #?(:clj #(instance? java.util.UUID %2) :cljs #(instance? cljs.core.UUID %2))}) @@ -214,6 +231,7 @@ (def uuid-str {:code ::uuid-str + :type ::builtin :optional true :validate #(and (string? %2) (re-seq +uuid-re+ %2)) @@ -223,12 +241,14 @@ (def email (let [rx #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$"] {:code ::email + :type ::builtin :optional true :validate #(and (string? %2) (re-seq rx %2))})) (def required {:code ::required + :type ::builtin :optional false :validate #(if (string? %2) (not (empty? %2)) @@ -236,34 +256,40 @@ (def number {:code ::number + :type ::builtin :optional true :validate #(number? %2)}) (def number-str {:code ::number-str + :type ::builtin :optional true :validate #(or (number? %2) (and (string? %2) (util/numeric? %2))) :coerce #(if (number? %) % (util/parse-number %))}) (def integer {:code ::integer + :type ::builtin :optional true :validate #?(:cljs #(js/Number.isInteger %2) :clj #(integer? %2))}) (def integer-str {:code ::integer-str + :type ::builtin :optional true :validate #(or (number? %2) (and (string? %2) (util/numeric? %2))) :coerce #(if (number? %) (int %) (util/parse-int %))}) (def boolean {:code ::boolean + :type ::builtin :optional true :validate #(or (= false %2) (= true %2))}) (def boolean-str {:code ::boolean-str + :type ::builtin :optional true :validate #(and (string? %2) (re-seq #"^(?:t|true|false|f|0|1)$" %2)) @@ -271,17 +297,20 @@ (def string {:code ::string + :type ::builtin :optional true :validate #(string? %2)}) (def string-like {:code ::string-like + :type ::builtin :optional true :validate (constantly true) :coerce str}) (def in-range {:code ::in-range + :type ::builtin :optional true :validate #(and (number? %2) (number? %3) @@ -290,51 +319,61 @@ (def positive {:code ::positive + :type ::builtin :optional true :validate #(pos? %2)}) (def negative {:code ::negative + :type ::builtin :optional true :validate #(neg? %)}) (def map {:code ::map + :type ::builtin :optional true :validate #(map? %2)}) (def set {:code ::set + :type ::builtin :optional true :validate #(set? %2)}) (def coll {:code ::coll + :type ::builtin :optional true :validate #(coll? %2)}) (def vector {:code ::vector + :type ::builtin :optional true :validate #(vector? %2)}) (def every {:code ::every + :type ::builtin :optional true :validate #(every? %3 %2)}) (def member {:code ::member + :type ::builtin :optional true :validate #(some #{%2} %3)}) (def function {:code ::function + :type ::builtin :optional true :validate #(fn? %2)}) (def identical-to {:code ::identical-to + :type ::builtin :optional true :validate (fn [state v ref] (let [prev (get state ref)] @@ -345,6 +384,7 @@ {:pre [(number? minimum)]} (>= (count v) minimum))] {:code ::min-count + :type ::builtin :optional true :validate validate})) @@ -353,5 +393,6 @@ {:pre [(number? maximum)]} (<= (count v) maximum))] {:code ::max-count + :type ::builtin :optional true :validate validate})) From 1ea7ebda9ac941b675bcd1919b79dd47a08fc150 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Thu, 29 Aug 2019 05:13:32 +0200 Subject: [PATCH 06/13] Add the ability to define specs in a registry. Instead of on the current ns. --- src/struct/core.cljc | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/src/struct/core.cljc b/src/struct/core.cljc index 9871b9f..394a718 100644 --- a/src/struct/core.cljc +++ b/src/struct/core.cljc @@ -3,6 +3,8 @@ (:require [struct.util :as util]) #?(:cljs (:require-macros struct.core))) +(def ^:dynamic *registry* (atom {})) + (def ^:private map' #?(:cljs cljs.core/map :clj clojure.core/map)) @@ -148,9 +150,13 @@ (if (:strip opts) {:data {}} {:data data}) (dissoc schema ::compiled))) + (defn- resolve-schema [schema] (cond + (keyword? schema) + (resolve-schema (get @*registry* schema)) + (delay? schema) (resolve-schema @schema) @@ -168,12 +174,15 @@ #?(:clj (defmacro defs - [namesym schema] - {:pre [(symbol? namesym) - (or (map? schema) + [nsym schema] + {:pre [(or (map? schema) (vector? schema))]} - `(def ~namesym - (delay (compile-schema ~schema))))) + (cond + (keyword? nsym) + `(swap! *registry* assoc ~nsym (delay (compile-schema ~schema))) + + (symbol? nsym) + `(def ~nsym (delay (compile-schema ~schema)))))) (defn validate "Validate data with specified schema. From fb0e203c6c6b9ee7d49c1f8195388f4d1953b881 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Fri, 30 Aug 2019 08:56:11 +0200 Subject: [PATCH 07/13] Allow use schema as validator. --- src/struct/core.cljc | 124 ++++++++++++++++++++++++++++++------------- 1 file changed, 87 insertions(+), 37 deletions(-) diff --git a/src/struct/core.cljc b/src/struct/core.cljc index 394a718..6e5fff1 100644 --- a/src/struct/core.cljc +++ b/src/struct/core.cljc @@ -5,13 +5,11 @@ (def ^:dynamic *registry* (atom {})) +;; --- Impl details + (def ^:private map' #?(:cljs cljs.core/map :clj clojure.core/map)) -(def ^:private vector' #?(:cljs cljs.core/vector - :clj clojure.core/vector)) -;; --- Impl details - (defn- dissoc-in [m [k & ks]] (if ks @@ -24,19 +22,39 @@ (dissoc m k))) (def ^:private opts-params - #{:coerce :message :optional :code}) + #{:coerce :message :optional :code :type}) (def ^:private notopts? (complement opts-params)) +(declare impl-validate-and-coerce) +(declare impl-validate-only) +(declare impl-coerce-only) +(declare resolve-schema) + +(defn- schema->validator + [schema] + {:code (::name schema) + :type ::builtin + :optional true + :validate (fn [data value] + (let [{:keys [valid?] :as result} (impl-validate-only schema value)] + valid?)) + :coerce (fn [value] + (impl-coerce-only schema value))}) + (defn- compile-validator [data] (cond (map? data) data + (keyword? data) + (schema->validator (resolve-schema data)) + (fn? data) {:code ::custom-predicate + :type ::builtin :optional true :validate #(data %2)} @@ -66,6 +84,14 @@ (constantly {:valid? true}) (reverse validators))) +(defn- compile-coerce-fn + [items] + (reduce (fn [acc item] + (let [coerce (:coerce item identity)] + #(coerce (acc %)))) + identity + (reverse items))) + (defn- compile-validation-and-coerce-fn [validators] (reduce (fn [acc validator] @@ -91,7 +117,8 @@ (let [validators (mapv compile-validator validators)] {:path (if (vector? key) key [key]) :vfn (compile-validation-fn validators) - :cfn (compile-validation-and-coerce-fn validators)})) + :cfn (compile-coerce-fn validators) + :cvfn (compile-validation-and-coerce-fn validators)})) (defn- schema-map->vec [schema] @@ -103,14 +130,15 @@ schema)) (defn compile-schema - [schema] + [sname schema] (let [entries (cond (vector? schema) (seq schema) (map? schema) (schema-map->vec schema) :else (throw (ex-info "Invalid schema." {})))] (reduce (fn [acc [key & validators]] - (assoc acc key (compile-schema-entry key validators))) - {::compiled true} + (assoc-in acc [:fields key] (compile-schema-entry key validators))) + {::compiled true + ::name sname} entries))) (defn- format-error @@ -123,21 +151,52 @@ :message msg :value value})) -(defn- impl-validate +(defn- resolve-schema + [schema] + (cond + (keyword? schema) + (resolve-schema (get @*registry* schema)) + + (delay? schema) + (resolve-schema @schema) + + (true? (::compiled schema)) + schema + + (or (map? schema) + (vector? schema)) + (compile-schema (gensym "struct") schema) + + (nil? schema) + (throw (ex-info "Undefined schema" {})) + + :else + (throw (ex-info "Invalid value for schema." {:schema schema})))) + +(defn- impl-validate-only [schema data] (reduce-kv (fn [_ _ {:keys [path vfn] :as item}] (let [value (get-in data path)] (or (vfn data value) (reduced false)))) true - (dissoc schema ::compiled))) + (:fields schema))) + +(defn- impl-coerce-only + [schema data] + (reduce-kv (fn [acc _ {:keys [path cfn] :as item}] + (let [value (get-in data path)] + (assoc-in acc path (cfn value)))) + {} + (:fields schema))) (defn- impl-validate-and-coerce [schema data opts] - (reduce-kv (fn [acc key {:keys [path vfn cfn] :as entry}] + (reduce-kv (fn [acc key {:keys [path cvfn] :as entry}] (let [value (get-in data path) - result (cfn data value) + result (cvfn data value) result-value (:value result)] + (if (:valid? result) (if (nil? result-value) acc @@ -148,27 +207,7 @@ (update :data dissoc-in path) (update :errors assoc-in path error)))))) (if (:strip opts) {:data {}} {:data data}) - (dissoc schema ::compiled))) - - -(defn- resolve-schema - [schema] - (cond - (keyword? schema) - (resolve-schema (get @*registry* schema)) - - (delay? schema) - (resolve-schema @schema) - - (true? (::compiled schema)) - schema - - (or (map? schema) - (vector? schema)) - (compile-schema schema) - - :else - (throw (ex-info "Invalid value for schema." {:schema schema})))) + (:fields schema))) ;; --- Public Api @@ -179,10 +218,11 @@ (vector? schema))]} (cond (keyword? nsym) - `(swap! *registry* assoc ~nsym (delay (compile-schema ~schema))) + `(swap! *registry* assoc ~nsym (delay (compile-schema ~nsym ~schema))) (symbol? nsym) - `(def ~nsym (delay (compile-schema ~schema)))))) + (let [foo# (symbol (str *ns*) (str nsym))] + `(def ~nsym (delay (compile-schema (quote ~foo#) ~schema))))))) (defn validate "Validate data with specified schema. @@ -201,7 +241,7 @@ (defn valid? [schema data] (let [schema (resolve-schema schema) - result (impl-validate schema data)] + result (impl-validate-only schema data)] (:valid? result))) (defn validate! @@ -405,3 +445,13 @@ :type ::builtin :optional true :validate validate})) + +(defn pred + [f & {:keys [code message coerce]}] + {:optional true + :code code + :message message + :type ::user-defined + :validate #(f %2) + :coerce (if (fn? coerce) coerce identity)}) + From f74b40a54b7751f54377c9f35a1e9fe886d4a550 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Sun, 1 Sep 2019 18:54:15 +0200 Subject: [PATCH 08/13] Add struct.alpha namespace with new approach for defining specs. --- src/struct/alpha.cljc | 171 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 171 insertions(+) create mode 100644 src/struct/alpha.cljc diff --git a/src/struct/alpha.cljc b/src/struct/alpha.cljc new file mode 100644 index 0000000..146b98c --- /dev/null +++ b/src/struct/alpha.cljc @@ -0,0 +1,171 @@ +(ns struct.alpha + (:refer-clojure :exclude [and]) + (:require [struct.util :as util]) + #?(:cljs (:require-macros struct.alpha))) + +(def ^:dynamic *registry* (atom {})) + +;; --- Impl + +(defprotocol ISpec + (-conform [_ _]) + (-explain [_ _ _])) + +(defrecord FnSpec [pred name coerce] + ISpec + (-conform [_ value] + (if (pred value) + (if (fn? coerce) + (coerce value) + value) + ::invalid)) + (-explain [self path val] + (if (= ::invalid (-conform self val)) + [{:path path :name name :val val}] + []))) + +(defrecord AndSpec [specs name] + ISpec + (-conform [_ value] + (reduce (fn [acc s] + (let [result (-conform s acc)] + (if (= result ::invalid) + (reduced ::invalid) + result))) + value + specs)) + + (-explain [_ path val] + (let [[val errors] (reduce (fn [[val _] s] + (let [res (-conform s val)] + (if (= res ::invalid) + (reduced [nil (-explain s path val)]) + [res nil]))) + [val nil] + specs)] + errors))) + +(defrecord OptSpec [spec name] + ISpec + (-conform [_ data] + (if (nil? data) + data + (-conform spec data))) + + (-explain [_ path data] + (if (nil? data) + [] + (-explain spec path data)))) + +(defrecord MapSpec [pairs name] + ISpec + (-conform [_ data] + (if-not (map? data) + ::invalid + (reduce (fn [acc [k s]] + (let [val (get data k) + res (-conform s val)] + (if (= res ::invalid) + (reduced ::invalid) + (assoc acc k res)))) + {} + pairs))) + + (-explain [_ path data] + (if (map? data) + (reduce (fn [acc [k s]] + (into acc (-explain s (conj path k) (get data k)))) + [] + pairs) + (if (empty? path) + [{:path path :name ::map :val data}] + [{:path path :name name :val data}])))) + +(defn- get-spec + [spec] + (let [spec (cond + (satisfies? ISpec spec) + spec + + (fn? spec) + (->FnSpec spec nil nil) + + (keyword? spec) + (get @*registry* spec) + + :else + (throw (ex-info "unsupported type for spec lookup" {:spec spec})))] + (when (nil? spec) + (throw (ex-info "Spec not found" {:spec spec}))) + spec)) + +(defn defs-impl + [spec name] + (cond + (fn? spec) + (->FnSpec spec name nil) + + (keyword? spec) + (let [spec (get-spec spec)] + (assoc spec :name name)) + + (satisfies? ISpec spec) + (assoc spec :name name) + + :else + (throw (ex-info "spec can't be resolved" {:spec spec})))) + +;; --- Public API + +(defn pred + "Programatically create a spec instance from predicate + and optionaly a coercer and name." + [f c n] + (assoc (get-spec f) :coerce c :name n)) + +(defn opt + [spec] + (let [spec (get-spec spec)] + (->OptSpec spec (:name spec)))) + +(defn and + [& specs] + (let [specs (map get-spec specs)] + (->AndSpec specs nil))) + +(defn dict + [& keypairs] + (assert (even? (count keypairs)) "an even number of pairs is mandatory") + (let [pairs (map (fn [[k s]] [k (get-spec s)]) (partition 2 keypairs))] + (->MapSpec pairs nil))) + +#?(:clj + (defmacro defs + [name spec] + `(swap! *registry* assoc ~name (defs-impl ~spec ~name)))) + +(defn conform + [spec data] + (-conform (get-spec spec) data)) + +(defn explain + [spec data] + (let [problems (-explain (get-spec spec) [] data)] + (if (empty? problems) + nil + problems))) + +;; (defs ::number number?) +;; (defs ::string string?) + +;; (defs ::width ::number) +;; (defs ::height ::number) + +;; (defs ::even even?) + +;; (defs ::size +;; (map :width (and ::number ::even) +;; :height ::height +;; :desc (opt ::string))) +;; ;; ) + From b3381cecd0910e91da8621a2ee1b90cf3edd610c Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Sun, 1 Sep 2019 19:28:05 +0200 Subject: [PATCH 09/13] Add deploy (to clojars) script. --- deploy.clj | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 deploy.clj diff --git a/deploy.clj b/deploy.clj new file mode 100644 index 0000000..119768d --- /dev/null +++ b/deploy.clj @@ -0,0 +1,34 @@ +(require '[clojure.java.shell :as shell] + '[clojure.main]) +(require '[badigeon.jar] + '[badigeon.deploy]) + +(defmulti task first) + +(defmethod task "jar" + [args] + (badigeon.jar/jar 'funcool/struct + {:mvn/version "2.0.0-SNAPSHOT"} + {:out-path "target/struct.jar" + :mvn/repos '{"clojars" {:url "https://repo.clojars.org/"}} + :allow-all-dependencies? false})) + +(defmethod task "deploy" + [args] + (let [artifacts [{:file-path "target/struct.jar" :extension "jar"} + {:file-path "pom.xml" :extension "pom"}]] + (badigeon.deploy/deploy + 'funcool/struct "2.0.0-SNAPSHOT" + artifacts + {:id "clojars" :url "https://repo.clojars.org/"} + {:allow-unsigned? true}))) + + +(defmethod task :default + [args] + (task ["jar"]) + (task ["deploy"])) + +;;; Build script entrypoint. This should be the last expression. + +(task *command-line-args*) From 12359fc24b5ab15d86821616653627c85a7e48a9 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Sun, 1 Sep 2019 20:44:01 +0200 Subject: [PATCH 10/13] Add default specs on struct.alpha ns. --- src/struct/alpha.cljc | 70 +++++++++++++++++++++++++++++-------------- 1 file changed, 48 insertions(+), 22 deletions(-) diff --git a/src/struct/alpha.cljc b/src/struct/alpha.cljc index 146b98c..9b25679 100644 --- a/src/struct/alpha.cljc +++ b/src/struct/alpha.cljc @@ -1,15 +1,15 @@ (ns struct.alpha - (:refer-clojure :exclude [and]) + ;; (:refer-clojure :exclude [and]) (:require [struct.util :as util]) - #?(:cljs (:require-macros struct.alpha))) + #?(:cljs (:require-macros [struct.alpha :refer [defs]]))) (def ^:dynamic *registry* (atom {})) ;; --- Impl (defprotocol ISpec - (-conform [_ _]) - (-explain [_ _ _])) + (-conform [it val]) + (-explain [it path val])) (defrecord FnSpec [pred name coerce] ISpec @@ -120,15 +120,17 @@ (defn pred "Programatically create a spec instance from predicate and optionaly a coercer and name." - [f c n] - (assoc (get-spec f) :coerce c :name n)) + ([f c] + (assoc (get-spec f) :coerce c)) + ([f c n] + (assoc (get-spec f) :coerce c :name n))) (defn opt [spec] (let [spec (get-spec spec)] (->OptSpec spec (:name spec)))) -(defn and +(defn && [& specs] (let [specs (map get-spec specs)] (->AndSpec specs nil))) @@ -146,7 +148,8 @@ (defn conform [spec data] - (-conform (get-spec spec) data)) + (let [spec (get-spec spec)] + (-conform spec data))) (defn explain [spec data] @@ -155,17 +158,40 @@ nil problems))) -;; (defs ::number number?) -;; (defs ::string string?) - -;; (defs ::width ::number) -;; (defs ::height ::number) - -;; (defs ::even even?) - -;; (defs ::size -;; (map :width (and ::number ::even) -;; :height ::height -;; :desc (opt ::string))) -;; ;; ) - +(def ^:const ^:private +uuid-re+ + #"^[0-9a-f]{8}-[0-9a-f]{4}-[1-5][0-9a-f]{3}-[89ab][0-9a-f]{3}-[0-9a-f]{12}$") + +(def ^:const ^:private +email-re+ + #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$") + +(defs ::string string?) +(defs ::number number?) +(defs ::keyword keyword?) +(defs ::boolean boolean?) +(defs ::positive pos?) +(defs ::negative neg?) +(defs ::map map?) +(defs ::set set?) +(defs ::coll coll?) +(defs ::vector vector?) + +(defs ::uuid #?(:clj #(instance? java.util.UUID %) + :cljs #(instance? cljs.core.UUID %))) +(defs ::uuid-str + (pred #(and (string? %) (re-seq +uuid-re+ %)) + #?(:clj #(java.util.UUID/fromString %) + :cljs #(uuid %)))) + +(defs ::email #(and (string? %) (re-seq +email-re+ %))) + +(defs ::number-str + (pred #(or (number? %) (and (string? %) (util/numeric? %))) + #(if (number? %) % (util/parse-number %)))) + +(defs ::integer-str + (pred #(or (number? %) (and (string? %) (util/numeric? %))) + #(if (number? %) (int %) (util/parse-int %)))) + +(defs ::boolean-str + (pred #(and (string? %) (re-seq #"^(?:t|true|false|f|0|1)$" %)) + #(contains? #{"t" "true" "1"} %))) From 0f3f5494cc2177e194af30fd43329085728d1639 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Mon, 2 Sep 2019 19:49:55 +0200 Subject: [PATCH 11/13] Add coll-of among other improvements. --- deps.edn | 8 +- src/struct/alpha.cljc | 113 ++++++++++++++++---- test/struct/benchmarks.cljc | 68 ++++++++++++ test/struct/tests_alpha.cljc | 106 ++++++++++++++++++ test/struct/{tests.cljc => tests_core.cljc} | 56 +--------- test/struct/tests_main.cljc | 27 +++++ tools.clj | 13 ++- 7 files changed, 311 insertions(+), 80 deletions(-) create mode 100644 test/struct/benchmarks.cljc create mode 100644 test/struct/tests_alpha.cljc rename test/struct/{tests.cljc => tests_core.cljc} (79%) create mode 100644 test/struct/tests_main.cljc diff --git a/deps.edn b/deps.edn index b7da09a..10ab790 100644 --- a/deps.edn +++ b/deps.edn @@ -11,9 +11,11 @@ :deploy {:extra-deps {badigeon/badigeon {:git/url "https://github.com/EwenG/badigeon.git" :sha "db25a8f7053dec65afeb7fb0d1a5351dcdbe78bd" - :tag "0.0.8"}}} + :tag "0.0.8"}} + :main-opts ["deploy.clj"]} - :ancient {:main-opts ["-m" "deps-ancient.deps-ancient"] - :extra-deps {deps-ancient {:mvn/version "RELEASE"}}} + :ancient + {:main-opts ["-m" "deps-ancient.deps-ancient"] + :extra-deps {deps-ancient {:mvn/version "RELEASE"}}} }} diff --git a/src/struct/alpha.cljc b/src/struct/alpha.cljc index 9b25679..4d4218e 100644 --- a/src/struct/alpha.cljc +++ b/src/struct/alpha.cljc @@ -3,13 +3,13 @@ (:require [struct.util :as util]) #?(:cljs (:require-macros [struct.alpha :refer [defs]]))) -(def ^:dynamic *registry* (atom {})) +(defonce registry (atom {})) ;; --- Impl (defprotocol ISpec (-conform [it val]) - (-explain [it path val])) + (-explain [it path via val])) (defrecord FnSpec [pred name coerce] ISpec @@ -19,9 +19,9 @@ (coerce value) value) ::invalid)) - (-explain [self path val] + (-explain [self path via val] (if (= ::invalid (-conform self val)) - [{:path path :name name :val val}] + [{:path path :name name :val val :via via}] []))) (defrecord AndSpec [specs name] @@ -35,11 +35,11 @@ value specs)) - (-explain [_ path val] + (-explain [_ path via val] (let [[val errors] (reduce (fn [[val _] s] (let [res (-conform s val)] (if (= res ::invalid) - (reduced [nil (-explain s path val)]) + (reduced [nil (-explain s path (conj via (:name s)) val)]) [res nil]))) [val nil] specs)] @@ -52,10 +52,10 @@ data (-conform spec data))) - (-explain [_ path data] + (-explain [_ path via data] (if (nil? data) [] - (-explain spec path data)))) + (-explain spec path via data)))) (defrecord MapSpec [pairs name] ISpec @@ -63,24 +63,66 @@ (if-not (map? data) ::invalid (reduce (fn [acc [k s]] - (let [val (get data k) - res (-conform s val)] + (let [res (-conform s (get data k))] (if (= res ::invalid) (reduced ::invalid) (assoc acc k res)))) {} pairs))) - (-explain [_ path data] + (-explain [_ path via data] (if (map? data) (reduce (fn [acc [k s]] - (into acc (-explain s (conj path k) (get data k)))) + (into acc (-explain s (conj path k) (conj via (:name s)) (get data k)))) [] pairs) (if (empty? path) [{:path path :name ::map :val data}] [{:path path :name name :val data}])))) +(defrecord CollSpec [spec into kind name] + ISpec + (-conform [_ data] + ;; (prn "CollSpec$conform" spec into kind name) + (cond + (and (satisfies? ISpec kind) + (= ::invalid (-conform kind data))) + ::invalid + + (not (coll? data)) + ::invalid + + :else + (reduce (fn [acc item] + (let [res (-conform spec item)] + (if (= ::invalid res) + (reduced res) + (conj acc res)))) + into + data))) + + (-explain [_ path via data] + (cond + (and (satisfies? ISpec kind) + (= ::invalid (-conform kind data))) + [{:path path :name (:name kind) :val data :via via}] + + (not (coll? data)) + [{:path path :name ::coll :val data :via via}] + + :else + (reduce (fn [acc [i item]] + (let [res (-conform spec item)] + (if (= ::invalid res) + (reduced [{:path (conj path i) + :name (:name spec name) + :cause (first (-explain spec path (conj via (:name spec)) item)) + :via (conj via (:name spec)) + :val item}]) + acc))) + [] + (map-indexed vector data))))) + (defn- get-spec [spec] (let [spec (cond @@ -91,12 +133,12 @@ (->FnSpec spec nil nil) (keyword? spec) - (get @*registry* spec) + (get @registry spec) :else (throw (ex-info "unsupported type for spec lookup" {:spec spec})))] (when (nil? spec) - (throw (ex-info "Spec not found" {:spec spec}))) + (throw (ex-info "spec not found" {:spec spec}))) spec)) (defn defs-impl @@ -135,6 +177,17 @@ (let [specs (map get-spec specs)] (->AndSpec specs nil))) +(defn coll-of + [spec & {:keys [into kind] + :or {into []} + :as opts}] + (let [spec (get-spec spec) + kind (cond + (keyword? kind) (get-spec kind) + (nil? kind) nil + :else (throw (ex-info "`kind` only accepts specs" {})))] + (->CollSpec spec into kind nil))) + (defn dict [& keypairs] (assert (even? (count keypairs)) "an even number of pairs is mandatory") @@ -144,7 +197,15 @@ #?(:clj (defmacro defs [name spec] - `(swap! *registry* assoc ~name (defs-impl ~spec ~name)))) + (cond + (keyword? name) + `(swap! registry assoc ~name (defs-impl ~spec ~name)) + + (symbol? name) + `(def ~name (defs-impl ~spec ~name)) + + :else + (throw (ex-info "unexpected arguments" {}))))) (defn conform [spec data] @@ -153,36 +214,46 @@ (defn explain [spec data] - (let [problems (-explain (get-spec spec) [] data)] + (let [spec (get-spec spec) + problems (-explain spec [] [(:name spec)] data)] (if (empty? problems) nil problems))) -(def ^:const ^:private +uuid-re+ +(defn valid? + [spec data] + (let [res (conform spec data)] + (not= ::invalid res))) + +;; --- Builtin Specs + +(def ^:private uuid-re #"^[0-9a-f]{8}-[0-9a-f]{4}-[1-5][0-9a-f]{3}-[89ab][0-9a-f]{3}-[0-9a-f]{12}$") -(def ^:const ^:private +email-re+ +(def ^:private email-re #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$") (defs ::string string?) (defs ::number number?) (defs ::keyword keyword?) (defs ::boolean boolean?) +(defs ::integer integer?) +(defs ::inst inst?) (defs ::positive pos?) (defs ::negative neg?) (defs ::map map?) (defs ::set set?) (defs ::coll coll?) (defs ::vector vector?) - +(defs ::email #(and (string? %) (re-seq email-re %))) (defs ::uuid #?(:clj #(instance? java.util.UUID %) :cljs #(instance? cljs.core.UUID %))) + (defs ::uuid-str - (pred #(and (string? %) (re-seq +uuid-re+ %)) + (pred #(and (string? %) (re-seq uuid-re %)) #?(:clj #(java.util.UUID/fromString %) :cljs #(uuid %)))) -(defs ::email #(and (string? %) (re-seq +email-re+ %))) (defs ::number-str (pred #(or (number? %) (and (string? %) (util/numeric? %))) diff --git a/test/struct/benchmarks.cljc b/test/struct/benchmarks.cljc new file mode 100644 index 0000000..6df1dc1 --- /dev/null +++ b/test/struct/benchmarks.cljc @@ -0,0 +1,68 @@ +(ns struct.benchmarks + (:require + #?(:clj [criterium.core :refer [quick-bench]]) + #?(:cljs [cljs.spec.alpha :as s] + :clj [clojure.spec.alpha :as s]) + #?(:cljs [cljs.test :as t]) + [struct.alpha :as st])) + +(def email-rx #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$") + +(defn email? + [v] + (and (string? v) + (re-matches email-rx v))) + +(s/def ::username string?) +(s/def ::age number?) +(s/def ::email email?) + +(s/def ::bench-form + (s/keys :req-un [::username ::age ::email])) + +(st/defs ::bench-form + (st/dict :username ::st/string + :age ::st/number + :email ::st/email)) + +(defn bench-valid-using-spec + [] + (let [data {:username "foo" :age 10 :email "foo@bar.com"} + bench-fn (fn [data] + (let [result (s/valid? ::bench-form data)] + (assert result "should be valid")))] + + #?(:cljs + (simple-benchmark [data data] + (bench-fn data) + 100000) + + :clj + (quick-bench (bench-fn data))))) + +(defn bench-valid-using-struct + [] + (let [data {:username "foo" :age 10 :email "foo@bar.com"} + bench-fn (fn [data] + (let [result (st/valid? ::bench-form data)] + (assert result "should be valid")))] + + #?(:cljs + (simple-benchmark [data data] + (bench-fn data) + 100000) + + :clj + (quick-bench (bench-fn data))))) + +#?(:cljs + (do + (enable-console-print!) + (set! *main-cli-fn* + #(do + (println "Benchmark (valid?) - clojure.spec") + (bench-valid-using-spec) + (println "Benchmark (valid?) - struct.alpha") + (bench-valid-using-struct))))) + + diff --git a/test/struct/tests_alpha.cljc b/test/struct/tests_alpha.cljc new file mode 100644 index 0000000..5d4f66a --- /dev/null +++ b/test/struct/tests_alpha.cljc @@ -0,0 +1,106 @@ +(ns struct.tests-alpha + (:require + #?(:cljs [cljs.test :as t] + :clj [clojure.test :as t]) + [struct.alpha :as st])) + +;; --- Tests + +(st/defs ::number number?) +(st/defs ::string string?) + +(t/deftest test-simple-specs + ;; Basic conform + (t/is (= 1 (st/conform ::number 1))) + (t/is (= "a" (st/conform ::string "a"))) + (t/is (= "" (st/conform ::string ""))) + + ;; Invalid conform + (t/is (= ::st/invalid (st/conform ::number "1"))) + (t/is (= ::st/invalid (st/conform ::string nil))) + + (t/is (= [{:path [], :name ::number, :val "1" :via [::number]}] + (st/explain ::number "1"))) + (t/is (= [{:path [], :name ::string, :val nil :via [::string]}] + (st/explain ::string nil)))) + +(st/defs ::number-opt (st/opt ::number)) +(st/defs ::string-opt (st/opt ::string)) + +(t/deftest test-conform-with-optionals + (t/is (= 1 (st/conform ::number-opt 1))) + (t/is (= nil (st/conform ::number-opt nil))) + (t/is (= "a" (st/conform ::string-opt "a"))) + (t/is (= "" (st/conform ::string-opt ""))) + (t/is (= nil (st/conform ::string-opt nil)))) + +(st/defs ::positive pos?) +(st/defs ::positive-number (st/&& ::number ::positive)) + +(t/deftest test-conform-with-and + (t/is (= 1 (st/conform ::positive-number 1))) + (t/is (= ::st/invalid (st/conform ::positive-number -1))) + (t/is (= ::st/invalid (st/conform ::positive-number "1"))) + + (t/is (= [{:path [], :name ::number, :val nil :via [::positive-number ::number]}] + (st/explain ::positive-number nil))) + (t/is (= [{:path [], :name ::number, :val "1" :via [::positive-number ::number]}] + (st/explain ::positive-number "1"))) + (t/is (= [{:path [], :name ::positive, :val -1 :via [::positive-number ::positive]}] + (st/explain ::positive-number -1))) +) + +(st/defs ::author + (st/dict :name ::string)) + +(st/defs ::book + (st/dict :name ::string + :age ::number + :author ::author)) + +(t/deftest test-complex-dict + (let [data {:author {:name "Andrej Sapkowski"} + :name "Baptism of Fire" + :age 1996} + wdata {:name "Baptism of Fire" + :author {} + :age "1996"}] + (t/is (= data + (st/conform ::book data))) + (t/is (= ::st/invalid + (st/conform ::book wdata))) + + (t/is (= [{:path [:age], + :name ::number, + :val "1996", + :via [::book ::number]} + {:path [:author :name], + :name ::string, + :val nil, + :via [::book ::author ::string]}] + (st/explain ::book wdata))))) + +(st/defs ::authors (st/coll-of ::author)) + +(t/deftest test-coll-of + (let [data [{:name "Andrej Sapkowski"}] + wdata [{:name :foobar}]] + (t/is (= data + (st/conform ::authors data))) + + (t/is (= ::st/invalid + (st/conform ::authors wdata))) + + (t/is (= [{:path [0], + :name ::author, + :cause {:path [:name], + :name ::string, + :val :foobar, + :via [::authors ::author ::string]}, + :via [::authors ::author], + :val {:name :foobar}}] + (st/explain ::authors wdata))))) + + + + diff --git a/test/struct/tests.cljc b/test/struct/tests_core.cljc similarity index 79% rename from test/struct/tests.cljc rename to test/struct/tests_core.cljc index 560c571..75831cd 100644 --- a/test/struct/tests.cljc +++ b/test/struct/tests_core.cljc @@ -1,4 +1,4 @@ -(ns struct.tests +(ns struct.tests-core (:require ;; #?(:clj [criterium.core :refer [quick-bench]]) ;; #?(:cljs [cljs.spec.alpha :as s] @@ -147,60 +147,6 @@ (t/is (empty? data2)) (t/is (= (get-in errors2 [:a :code] ::st/every))))) -;; (def email-rx -;; #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$") - -;; (defn email? -;; [v] -;; (and string? -;; (re-matches email-rx v))) - -;; (s/def ::username string?) -;; (s/def ::age number?) -;; (s/def ::email email?) -;; ;; -;; (s/def ::bench-form -;; (s/keys :req-un [::username ::age ::email])) - -;; (st/defs bench-form -;; {:username [st/required st/string] -;; :age [st/required st/number] -;; :email [st/required st/email]}) - -;; (defn bench-fn-using-spec -;; [data] -;; (let [result (s/valid? ::bench-form data)] -;; (assert result "should be valid"))) - -;; (defn bench-fn-using-struct -;; [data] -;; (let [result (st/valid? data bench-form)] -;; (assert result "should be valid"))) - -;; #?(:cljs -;; (defn bench1 -;; [] -;; (simple-benchmark [data {:username "foo" :age 10 :email "foo@bar.com"}] -;; (bench-fn-using-spec data) -;; 100000)) -;; :clj -;; (defn bench1 -;; [] -;; (let [data {:username "foo" :age 10 :email "foo@bar.com"}] -;; (quick-bench (bench-fn-using-spec data))))) - -;; #?(:cljs -;; (defn bench2 -;; [] -;; (simple-benchmark [data {:username "foo" :age 10 :email "foo@bar.com"}] -;; (bench-fn-using-struct data) -;; 100000)) -;; :clj -;; (defn bench2 -;; [] -;; (let [data {:username "foo" :age 10 :email "foo@bar.com"}] -;; (quick-bench (bench-fn-using-struct data))))) - ;; --- Entry point #?(:cljs diff --git a/test/struct/tests_main.cljc b/test/struct/tests_main.cljc new file mode 100644 index 0000000..970c8ec --- /dev/null +++ b/test/struct/tests_main.cljc @@ -0,0 +1,27 @@ +(ns struct.tests-main + (:require + #?(:cljs [cljs.test :as t] + :clj [clojure.test :as t]) + [struct.tests-core] + [struct.tests-alpha])) + +#?(:cljs + (do + (enable-console-print!) + (set! *main-cli-fn* #(t/run-tests 'struct.tests-core + 'struct.tests-alpha))) + + :clj + (defn -main + [& args] + (let [{:keys [fail]} (t/run-all-tests #"^struct.tests.*")] + (if (pos? fail) + (System/exit fail) + (System/exit 0))))) + +#?(:cljs + (defmethod t/report [:cljs.test/default :end-run-tests] + [m] + (if (t/successful? m) + (set! (.-exitCode js/process) 0) + (set! (.-exitCode js/process) 1)))) diff --git a/tools.clj b/tools.clj index 23b0f5b..5dc0be2 100644 --- a/tools.clj +++ b/tools.clj @@ -41,7 +41,7 @@ :cache-analysis false))) (def build-options - {:main 'struct.tests + {:main 'struct.tests-main :output-to "out/tests.js" :output-dir "out/tests" :target :nodejs @@ -49,12 +49,23 @@ :optimizations :advanced :language-in :ecmascript5 :language-out :ecmascript5 + :pseudo-names true :verbose true}) (defmethod task "build:tests" [args] (api/build (api/inputs "src" "test") build-options)) + +(defmethod task "build:benchmarks" + [args] + (api/build (api/inputs "src" "test") + (assoc build-options + :main 'struct.benchmarks + :output-to "out/bench.js" + :output-dir "out/bench"))) + + ;;; Build script entrypoint. This should be the last expression. (task *command-line-args*) From cc35a296f59a494db87487363016c2acebba008e Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Mon, 2 Sep 2019 22:42:39 +0200 Subject: [PATCH 12/13] Add keys helper and enable ifn as specs. --- src/struct/alpha.cljc | 47 ++++++++++++++++++++++++++++--------------- 1 file changed, 31 insertions(+), 16 deletions(-) diff --git a/src/struct/alpha.cljc b/src/struct/alpha.cljc index 4d4218e..64facde 100644 --- a/src/struct/alpha.cljc +++ b/src/struct/alpha.cljc @@ -1,5 +1,5 @@ (ns struct.alpha - ;; (:refer-clojure :exclude [and]) + (:refer-clojure :exclude [keys]) (:require [struct.util :as util]) #?(:cljs (:require-macros [struct.alpha :refer [defs]]))) @@ -125,32 +125,32 @@ (defn- get-spec [spec] - (let [spec (cond - (satisfies? ISpec spec) - spec + (let [spec' (cond + (satisfies? ISpec spec) + spec - (fn? spec) - (->FnSpec spec nil nil) + (keyword? spec) + (get @registry spec) - (keyword? spec) - (get @registry spec) + (ifn? spec) + (->FnSpec spec nil nil) - :else - (throw (ex-info "unsupported type for spec lookup" {:spec spec})))] - (when (nil? spec) + :else + (throw (ex-info "unsupported type for spec lookup" {:spec spec})))] + (when (nil? spec') (throw (ex-info "spec not found" {:spec spec}))) - spec)) + spec')) (defn defs-impl [spec name] (cond - (fn? spec) - (->FnSpec spec name nil) - (keyword? spec) (let [spec (get-spec spec)] (assoc spec :name name)) + (ifn? spec) + (->FnSpec spec name nil) + (satisfies? ISpec spec) (assoc spec :name name) @@ -191,9 +191,24 @@ (defn dict [& keypairs] (assert (even? (count keypairs)) "an even number of pairs is mandatory") - (let [pairs (map (fn [[k s]] [k (get-spec s)]) (partition 2 keypairs))] + (let [pairs (mapv (fn [[k s]] [k (get-spec s)]) (partition 2 keypairs))] (->MapSpec pairs nil))) +(defn keys + [& {:keys [req-un opt-un] + :or {req-un [] opt-un []} + :as opts}] + (assert (or (not (empty? req-un)) + (not (empty? opt-un)))) + (assert (every? qualified-keyword? req-un)) + (assert (every? qualified-keyword? opt-un)) + (let [strip-ns #(-> % name keyword) + un-req-pair-fn #(vector (strip-ns %) (get-spec %)) + un-opt-pair-fn #(vector (strip-ns %) (opt %)) + pairs (concat (map un-req-pair-fn req-un) + (map un-opt-pair-fn opt-un))] + (->MapSpec (vec pairs) nil))) + #?(:clj (defmacro defs [name spec] From d5f64caedc17b466d8fad191daf7af3fdc5364e2 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Mon, 2 Sep 2019 23:02:24 +0200 Subject: [PATCH 13/13] Minor fix on map and and specs. --- src/struct/alpha.cljc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/struct/alpha.cljc b/src/struct/alpha.cljc index 64facde..40a0434 100644 --- a/src/struct/alpha.cljc +++ b/src/struct/alpha.cljc @@ -31,7 +31,7 @@ (let [result (-conform s acc)] (if (= result ::invalid) (reduced ::invalid) - result))) + (merge acc result)))) value specs)) @@ -67,7 +67,7 @@ (if (= res ::invalid) (reduced ::invalid) (assoc acc k res)))) - {} + data pairs))) (-explain [_ path via data]