From e09954427abf2e19e72127df129217275f88863e Mon Sep 17 00:00:00 2001 From: Henry Kupty Date: Tue, 30 Jun 2020 23:18:27 +0200 Subject: [PATCH 01/86] Initial implementation of json-schema import This allows a very basic json-schema->malli conversion and will most likely need to be adequated to: - cleanup TODOS; - ensure function names are sane; - ensure all json-schema features are supported (at least for one specific version, i.e. draft-7). --- src/malli/json_schema/import.cljc | 110 ++++++++++++++++++++++++++++++ 1 file changed, 110 insertions(+) create mode 100644 src/malli/json_schema/import.cljc diff --git a/src/malli/json_schema/import.cljc b/src/malli/json_schema/import.cljc new file mode 100644 index 000000000..b7f0a92d5 --- /dev/null +++ b/src/malli/json_schema/import.cljc @@ -0,0 +1,110 @@ +(ns malli.json-schema.import + (:require [malli.core :as m])) + +(defmulti type->malli :type) + +(defn properties->malli [{:keys [required]} [k v]] + (cond-> [k] + (nil? (required k)) (conj {:optional true}) + true (conj (type->malli v)))) + +(defn $ref [v] + ;; TODO to be improved + (keyword (last (str/split v #"/")))) + +(defn v->malli [v] + (if-let [ref- (:$ref v)] + ($ref ref-) + (let [required (into #{} + (map keyword) + (:required v)) + closed? (false? (:additionalProperties v))] + (m/schema (cond-> [:map] + closed? (conj {:closed :true}) + true (into + (map (partial properties->malli {:required required})) + (:properties v))))))) + +(defn kv->malli [[k v]] + [k (v->malli v)]) + +(defmethod type->malli "string" [p] string?) +(defmethod type->malli "integer" [p] int?) +(defmethod type->malli "number" [p] number?) +(defmethod type->malli "boolean" [p] boolean?) +(defmethod type->malli "null" [p] nil?) +(defmethod type->malli "object" [p] (v->malli p)) +(defmethod type->malli "array" [p] (let [items (:items p)] + (cond + (vector? items) (into [:tuple] + (map type->malli) + items) + (map? items) [:vector (type->malli items)] + :else (throw (ex-info "Can't produce malli schema" {:p p}))))) + +(defn parse-top-level [js-schema] + (let [keys- (set (keys js-schema))] + (cond + (keys- :oneOf) (into [:or] + (map v->malli) + (:oneOf js-schema))))) + +(defn ->malli [obj] + [:schema {:registry (into {} + (map kv->malli) + (:definitions obj))} + (parse-top-level (dissoc obj :definitions))]) + +(defn properties->malli [{:keys [required]} [k v]] + (cond-> [k] + (nil? (required k)) (conj {:optional true}) + true (conj (type->malli v)))) + +(defn $ref [v] + ;; TODO to be improved + (keyword (last (str/split v #"/")))) + +(defn v->malli [v] + (if-let [ref- (:$ref v)] + ($ref ref-) + (let [required (into #{} + (map keyword) + (:required v)) + closed? (false? (:additionalProperties v))] + (m/schema (cond-> [:map] + closed? (conj {:closed :true}) + true (into + (map (partial properties->malli {:required required})) + (:properties v))))))) + +(defn kv->malli [[k v]] + [k (v->malli v)]) + +(defmethod type->malli "string" [p] string?) +(defmethod type->malli "integer" [p] int?) +(defmethod type->malli "number" [p] + ;; TODO support decimal/double + number?) +(defmethod type->malli "boolean" [p] boolean?) +(defmethod type->malli "null" [p] nil?) +(defmethod type->malli "object" [p] (v->malli p)) +(defmethod type->malli "array" [p] (let [items (:items p)] + (cond + (vector? items) (into [:tuple] + (map type->malli) + items) + (map? items) [:vector (type->malli items)] + :else (throw (ex-info "Can't produce malli schema" {:p p}))))) + +(defn parse-top-level [js-schema] + (let [keys- (set (keys js-schema))] + (cond + (keys- :oneOf) (into [:or] + (map v->malli) + (:oneOf js-schema))))) + +(defn ->malli [obj] + [:schema {:registry (into {} + (map kv->malli) + (:definitions obj))} + (parse-top-level (dissoc obj :definitions))]) From 74f62cf4afd6e087f520c9e639e5dc16db5eb5b8 Mon Sep 17 00:00:00 2001 From: Henry Kupty Date: Thu, 2 Jul 2020 17:06:48 +0200 Subject: [PATCH 02/86] Simplify functions, rename and make code simpler Also, remove duplication. --- src/malli/json_schema/import.cljc | 80 ++++++------------------------- 1 file changed, 15 insertions(+), 65 deletions(-) diff --git a/src/malli/json_schema/import.cljc b/src/malli/json_schema/import.cljc index b7f0a92d5..a4bf6d067 100644 --- a/src/malli/json_schema/import.cljc +++ b/src/malli/json_schema/import.cljc @@ -12,10 +12,8 @@ ;; TODO to be improved (keyword (last (str/split v #"/")))) -(defn v->malli [v] - (if-let [ref- (:$ref v)] - ($ref ref-) - (let [required (into #{} +(defn object->malli [v] + (let [required (into #{} (map keyword) (:required v)) closed? (false? (:additionalProperties v))] @@ -23,63 +21,11 @@ closed? (conj {:closed :true}) true (into (map (partial properties->malli {:required required})) - (:properties v))))))) - -(defn kv->malli [[k v]] - [k (v->malli v)]) - -(defmethod type->malli "string" [p] string?) -(defmethod type->malli "integer" [p] int?) -(defmethod type->malli "number" [p] number?) -(defmethod type->malli "boolean" [p] boolean?) -(defmethod type->malli "null" [p] nil?) -(defmethod type->malli "object" [p] (v->malli p)) -(defmethod type->malli "array" [p] (let [items (:items p)] - (cond - (vector? items) (into [:tuple] - (map type->malli) - items) - (map? items) [:vector (type->malli items)] - :else (throw (ex-info "Can't produce malli schema" {:p p}))))) - -(defn parse-top-level [js-schema] - (let [keys- (set (keys js-schema))] - (cond - (keys- :oneOf) (into [:or] - (map v->malli) - (:oneOf js-schema))))) - -(defn ->malli [obj] - [:schema {:registry (into {} - (map kv->malli) - (:definitions obj))} - (parse-top-level (dissoc obj :definitions))]) - -(defn properties->malli [{:keys [required]} [k v]] - (cond-> [k] - (nil? (required k)) (conj {:optional true}) - true (conj (type->malli v)))) - -(defn $ref [v] - ;; TODO to be improved - (keyword (last (str/split v #"/")))) - -(defn v->malli [v] - (if-let [ref- (:$ref v)] - ($ref ref-) - (let [required (into #{} - (map keyword) - (:required v)) - closed? (false? (:additionalProperties v))] - (m/schema (cond-> [:map] - closed? (conj {:closed :true}) - true (into - (map (partial properties->malli {:required required})) - (:properties v))))))) - -(defn kv->malli [[k v]] - [k (v->malli v)]) + (:properties v)))))) +(defmethod type->malli nil [p] + (when-let [-ref (:$ref v)] + ($ref -ref)) (defmethod type->malli "string" [p] string?) (defmethod type->malli "integer" [p] int?) (defmethod type->malli "number" [p] @@ -87,7 +33,7 @@ number?) (defmethod type->malli "boolean" [p] boolean?) (defmethod type->malli "null" [p] nil?) -(defmethod type->malli "object" [p] (v->malli p)) +(defmethod type->malli "object" [p] (object->malli p)) (defmethod type->malli "array" [p] (let [items (:items p)] (cond (vector? items) (into [:tuple] @@ -96,15 +42,19 @@ (map? items) [:vector (type->malli items)] :else (throw (ex-info "Can't produce malli schema" {:p p}))))) -(defn parse-top-level [js-schema] +(defn- parse-top-level [js-schema] (let [keys- (set (keys js-schema))] (cond (keys- :oneOf) (into [:or] - (map v->malli) + (map type->malli) (:oneOf js-schema))))) -(defn ->malli [obj] +(defn- map-values + ([-fn] (map (fn [[k v]] [k (-fn v)]))) + ([-fn coll] (sequence (map-values -fn) coll))) + +(defn json-schema-document->malli [obj] [:schema {:registry (into {} - (map kv->malli) + (map-values type->malli) (:definitions obj))} (parse-top-level (dissoc obj :definitions))]) From 9690651720e3d63768d81a206a8024822ed7a552 Mon Sep 17 00:00:00 2001 From: Henry Kupty Date: Thu, 2 Jul 2020 21:03:12 +0200 Subject: [PATCH 03/86] Add support for anyOf and allOf --- src/malli/json_schema/import.cljc | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/malli/json_schema/import.cljc b/src/malli/json_schema/import.cljc index a4bf6d067..f3c90e11f 100644 --- a/src/malli/json_schema/import.cljc +++ b/src/malli/json_schema/import.cljc @@ -43,11 +43,23 @@ :else (throw (ex-info "Can't produce malli schema" {:p p}))))) (defn- parse-top-level [js-schema] - (let [keys- (set (keys js-schema))] + (let [-keys (keys js-schema) + -key (first -keys)] + (when (pos? (dec (count -keys))) + (throw (ex-info "Invalid declaration" + {:number-of-keys (count -keys) + :schema js-schema}))) (cond - (keys- :oneOf) (into [:or] - (map type->malli) - (:oneOf js-schema))))) + (#{:oneOf :anyOf} -key) (into + ;; TODO Split :oneOf from :anyOf and figure out + ;; how to make it exclusively select o schema + [:or] + (map type->malli) + (:oneOf js-schema)) + (= :allOf -key) (into + [:and] + (map type->malli) + (:oneOf js-schema))))) (defn- map-values ([-fn] (map (fn [[k v]] [k (-fn v)]))) From b3f6a9a01a0ca234d76e1a969b50c2b0cdcd3889 Mon Sep 17 00:00:00 2001 From: Henry Kupty Date: Fri, 3 Jul 2020 22:12:42 +0200 Subject: [PATCH 04/86] Rename import->parse Also, reorganize functions to simplify processing, reduce duplication and avoid special casing. Lastly, make schema->malli the first entry point since anything can be a schema. It then delegates to types, aggregates or `$ref`s. --- .../json_schema/{import.cljc => parse.cljc} | 87 +++++++++++-------- 1 file changed, 50 insertions(+), 37 deletions(-) rename src/malli/json_schema/{import.cljc => parse.cljc} (57%) diff --git a/src/malli/json_schema/import.cljc b/src/malli/json_schema/parse.cljc similarity index 57% rename from src/malli/json_schema/import.cljc rename to src/malli/json_schema/parse.cljc index f3c90e11f..0fe1f8cbf 100644 --- a/src/malli/json_schema/import.cljc +++ b/src/malli/json_schema/parse.cljc @@ -1,17 +1,56 @@ -(ns malli.json-schema.import - (:require [malli.core :as m])) +(ns malli.json-schema.parse + (:require [malli.core :as m] + [clojure.string :as str])) -(defmulti type->malli :type) +;; Utility Functions +(defn- map-values + ([-fn] (map (fn [[k v]] [k (-fn v)]))) + ([-fn coll] (sequence (map-values -fn) coll))) -(defn properties->malli [{:keys [required]} [k v]] - (cond-> [k] - (nil? (required k)) (conj {:optional true}) - true (conj (type->malli v)))) +;; Parsing +(defmulti type->malli :type) (defn $ref [v] ;; TODO to be improved (keyword (last (str/split v #"/")))) +(defn schema->malli [js-schema] + (let [-keys (set (keys js-schema))] + (cond + (-keys :type) (type->malli js-schema) + + ;; Aggregates + (-keys :oneOf) + (into + ;; TODO Figure out how to make it exclusively select o schema + [:or] + (map schema->malli) + (:oneOf js-schema)) + + (-keys :anyOf) + (into + [:or] + (map schema->malli) + (:anyOf js-schema)) + + (-keys :allOf) + (into + [:and] + (map schema->malli) + (:allOf js-schema)) + + (-keys :not) [:not (schema->malli (:not js-schema))] + + (-keys :$ref) ($ref (:$ref js-schema)) + + :else + (throw (ex-info "Not supported" {:js-schema js-schema}))))) + +(defn properties->malli [{:keys [required]} [k v]] + (cond-> [k] + (nil? (required k)) (conj {:optional true}) + true (conj (schema->malli v)))) + (defn object->malli [v] (let [required (into #{} (map keyword) @@ -23,9 +62,6 @@ (map (partial properties->malli {:required required})) (:properties v)))))) -(defmethod type->malli nil [p] - (when-let [-ref (:$ref v)] - ($ref -ref)) (defmethod type->malli "string" [p] string?) (defmethod type->malli "integer" [p] int?) (defmethod type->malli "number" [p] @@ -37,36 +73,13 @@ (defmethod type->malli "array" [p] (let [items (:items p)] (cond (vector? items) (into [:tuple] - (map type->malli) + (map schema->malli) items) - (map? items) [:vector (type->malli items)] + (map? items) [:vector (schema->malli items)] :else (throw (ex-info "Can't produce malli schema" {:p p}))))) -(defn- parse-top-level [js-schema] - (let [-keys (keys js-schema) - -key (first -keys)] - (when (pos? (dec (count -keys))) - (throw (ex-info "Invalid declaration" - {:number-of-keys (count -keys) - :schema js-schema}))) - (cond - (#{:oneOf :anyOf} -key) (into - ;; TODO Split :oneOf from :anyOf and figure out - ;; how to make it exclusively select o schema - [:or] - (map type->malli) - (:oneOf js-schema)) - (= :allOf -key) (into - [:and] - (map type->malli) - (:oneOf js-schema))))) - -(defn- map-values - ([-fn] (map (fn [[k v]] [k (-fn v)]))) - ([-fn coll] (sequence (map-values -fn) coll))) - (defn json-schema-document->malli [obj] [:schema {:registry (into {} - (map-values type->malli) + (map-values schema->malli) (:definitions obj))} - (parse-top-level (dissoc obj :definitions))]) + (schema->malli obj)]) From 0ad4ca57c1cfcccebf90b407d6861f4625de054e Mon Sep 17 00:00:00 2001 From: Henry Kupty Date: Sat, 4 Jul 2020 06:20:28 +0200 Subject: [PATCH 05/86] Implement properties for strings, some int checks Also, adds top-level enums (and consts) and prepares for better range checks in int/number. --- src/malli/json_schema/parse.cljc | 45 +++++++++++++++++++++++++++----- 1 file changed, 38 insertions(+), 7 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index 0fe1f8cbf..61534e38c 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -1,5 +1,6 @@ (ns malli.json-schema.parse (:require [malli.core :as m] + [malli.util :as mu] [clojure.string :as str])) ;; Utility Functions @@ -19,6 +20,11 @@ (cond (-keys :type) (type->malli js-schema) + (-keys :enum) (into [:enum] + (:enum js-schema)) + + (-keys :const) [:enum (:const js-schema)] + ;; Aggregates (-keys :oneOf) (into @@ -44,7 +50,8 @@ (-keys :$ref) ($ref (:$ref js-schema)) :else - (throw (ex-info "Not supported" {:js-schema js-schema}))))) + (throw (ex-info "Not supported" {:json-schema js-schema + :reason ::schema-type}))))) (defn properties->malli [{:keys [required]} [k v]] (cond-> [k] @@ -53,6 +60,7 @@ (defn object->malli [v] (let [required (into #{} + ;; TODO Should use the same fn as $ref (map keyword) (:required v)) closed? (false? (:additionalProperties v))] @@ -62,11 +70,33 @@ (map (partial properties->malli {:required required})) (:properties v)))))) -(defmethod type->malli "string" [p] string?) -(defmethod type->malli "integer" [p] int?) -(defmethod type->malli "number" [p] - ;; TODO support decimal/double - number?) +(defmethod type->malli "string" [{:keys [pattern minLength maxLength enum]}] + ;; `format` metadata is deliberately not considered. + ;; String enums are stricter, so they're also implemented here. + (cond + pattern [:re pattern] + enum [:and + :string + (into [:enum] enum)] + [:string (cond-> {} + minLength (assoc :min minLength) + maxLength (assoc :max maxLength))])) + +(defmethod type->malli "integer" [{:keys [minimum maximum exclusiveMinimum exclusiveMaximum multipleOf] + :or {minimum Integer/MIN_VALUE + maximum Integer/MAX_VALUE}}] + ;; On draft 4, exclusive{Minimum,Maximum} is a boolean. + ;; TODO Decide on whether draft 4 will be supported + ;; TODO Implement exclusive{Minimum,Maximum} support + ;; TODO Implement multipleOf support + ;; TODO Wrap, when it makes sense, the values below with range checkers, i.e. [:< maximum] + ;; TODO extract ranges logic and reuse with number + (cond + (pos? minimum) pos-int? + (neg? maximum) neg-int? + :else int?)) + +(defmethod type->malli "number" [p] number?) (defmethod type->malli "boolean" [p] boolean?) (defmethod type->malli "null" [p] nil?) (defmethod type->malli "object" [p] (object->malli p)) @@ -76,7 +106,8 @@ (map schema->malli) items) (map? items) [:vector (schema->malli items)] - :else (throw (ex-info "Can't produce malli schema" {:p p}))))) + :else (throw (ex-info "Not Supported" {:json-schema p + :reason ::array-items}))))) (defn json-schema-document->malli [obj] [:schema {:registry (into {} From 404e664f04ada9ca39fa72973d45c4a8dda587f8 Mon Sep 17 00:00:00 2001 From: Henry Kupty Date: Thu, 17 Sep 2020 21:36:37 +0200 Subject: [PATCH 06/86] Fix missing `:else` clause --- src/malli/json_schema/parse.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index 61534e38c..c13293aa1 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -78,7 +78,7 @@ enum [:and :string (into [:enum] enum)] - [:string (cond-> {} + :else [:string (cond-> {} minLength (assoc :min minLength) maxLength (assoc :max maxLength))])) From fc5059b0886c20eb2497f3244b9a79eeec71d9d2 Mon Sep 17 00:00:00 2001 From: Henry Kupty Date: Thu, 17 Sep 2020 21:37:17 +0200 Subject: [PATCH 07/86] Add annotations as malli properties --- src/malli/json_schema/parse.cljc | 61 ++++++++++++++++++-------------- 1 file changed, 34 insertions(+), 27 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index c13293aa1..f1fe83a93 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -1,8 +1,16 @@ (ns malli.json-schema.parse (:require [malli.core :as m] [malli.util :as mu] + [clojure.set :as set] [clojure.string :as str])) +(def annotations #{:title :description :default :examples}) + +(defn annotations->properties [js-schema] + (-> js-schema + (select-keys annotations) + (set/rename-keys {:examples :json-schema/examples}))) + ;; Utility Functions (defn- map-values ([-fn] (map (fn [[k v]] [k (-fn v)]))) @@ -17,41 +25,40 @@ (defn schema->malli [js-schema] (let [-keys (set (keys js-schema))] - (cond - (-keys :type) (type->malli js-schema) + (mu/update-properties + (cond + (-keys :type) (type->malli js-schema) - (-keys :enum) (into [:enum] - (:enum js-schema)) + (-keys :enum) (into [:enum] + (:enum js-schema)) - (-keys :const) [:enum (:const js-schema)] + (-keys :const) [:enum (:const js-schema)] - ;; Aggregates - (-keys :oneOf) - (into - ;; TODO Figure out how to make it exclusively select o schema - [:or] - (map schema->malli) - (:oneOf js-schema)) + ;; Aggregates + (-keys :oneOf) (into + ;; TODO Figure out how to make it exclusively select o schema + [:or] + (map schema->malli) + (:oneOf js-schema)) - (-keys :anyOf) - (into - [:or] - (map schema->malli) - (:anyOf js-schema)) + (-keys :anyOf) (into + [:or] + (map schema->malli) + (:anyOf js-schema)) - (-keys :allOf) - (into - [:and] - (map schema->malli) - (:allOf js-schema)) + (-keys :allOf) (into + [:and] + (map schema->malli) + (:allOf js-schema)) - (-keys :not) [:not (schema->malli (:not js-schema))] + (-keys :not) [:not (schema->malli (:not js-schema))] - (-keys :$ref) ($ref (:$ref js-schema)) + (-keys :$ref) ($ref (:$ref js-schema)) - :else - (throw (ex-info "Not supported" {:json-schema js-schema - :reason ::schema-type}))))) + :else (throw (ex-info "Not supported" {:json-schema js-schema + :reason ::schema-type}))) + merge + (annotations->properties js-schema)))) (defn properties->malli [{:keys [required]} [k v]] (cond-> [k] From 18332a6f72813c5c57f19904dbad69a638b6f1d3 Mon Sep 17 00:00:00 2001 From: Henry Kupty Date: Wed, 6 Jan 2021 14:41:36 +0100 Subject: [PATCH 08/86] Add min/max properties --- src/malli/json_schema/parse.cljc | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index f1fe83a93..ef5ef1587 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -60,11 +60,15 @@ merge (annotations->properties js-schema)))) -(defn properties->malli [{:keys [required]} [k v]] +(defn properties->malli [required [k v]] (cond-> [k] (nil? (required k)) (conj {:optional true}) true (conj (schema->malli v)))) +(defn- prop-size [pred?] (fn [-map] (pred? (count (keys -map))))) +(defn- min-properties [-min] (prop-size (partial <= -min))) +(defn- max-properties [-max] (prop-size (partial >= -max))) + (defn object->malli [v] (let [required (into #{} ;; TODO Should use the same fn as $ref @@ -74,7 +78,7 @@ (m/schema (cond-> [:map] closed? (conj {:closed :true}) true (into - (map (partial properties->malli {:required required})) + (map (partial properties->malli required)) (:properties v)))))) (defmethod type->malli "string" [{:keys [pattern minLength maxLength enum]}] From 9f380a73b5e07c11efa3e7ef21a256dfb066b7e8 Mon Sep 17 00:00:00 2001 From: Henry Kupty Date: Wed, 6 Jan 2021 14:58:13 +0100 Subject: [PATCH 09/86] add min/max properties to object --- src/malli/json_schema/parse.cljc | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index ef5ef1587..abeefef34 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -69,17 +69,33 @@ (defn- min-properties [-min] (prop-size (partial <= -min))) (defn- max-properties [-max] (prop-size (partial >= -max))) +(defn with-min-max-poperties-size [malli v] + (let [predicates [(some->> v + (:minProperties) + (min-properties) + (conj [:fn])) + (some->> v + (:maxProperties) + (max-properties) + (conj [:fn]))]] + (cond->> malli + (some some? predicates) + (conj (into [:and] + (filter some?) + predicates))))) + (defn object->malli [v] (let [required (into #{} ;; TODO Should use the same fn as $ref (map keyword) (:required v)) closed? (false? (:additionalProperties v))] - (m/schema (cond-> [:map] - closed? (conj {:closed :true}) - true (into - (map (partial properties->malli required)) - (:properties v)))))) + (m/schema (-> [:map] + (cond-> closed? (conj {:closed :true})) + (into + (map (partial properties->malli required)) + (:properties v)) + (with-min-max-poperties-size v))))) (defmethod type->malli "string" [{:keys [pattern minLength maxLength enum]}] ;; `format` metadata is deliberately not considered. From d7a9f1f342139305fbdf9af26555880e928837ac Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 00:21:09 +0200 Subject: [PATCH 10/86] Support uuid-formatted strings --- src/malli/json_schema/parse.cljc | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index abeefef34..fad43ff3e 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -97,7 +97,7 @@ (:properties v)) (with-min-max-poperties-size v))))) -(defmethod type->malli "string" [{:keys [pattern minLength maxLength enum]}] +(defmethod type->malli "string" [{:keys [pattern minLength maxLength enum format]}] ;; `format` metadata is deliberately not considered. ;; String enums are stricter, so they're also implemented here. (cond @@ -105,6 +105,7 @@ enum [:and :string (into [:enum] enum)] + (= format "uuid") uuid? :else [:string (cond-> {} minLength (assoc :min minLength) maxLength (assoc :max maxLength))])) From cf67b24adc90eb9c9fb320c90212e4752d302869 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 00:21:49 +0200 Subject: [PATCH 11/86] Support `{..., "type": ["integer","string"], ...}` syntax --- src/malli/json_schema/parse.cljc | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index fad43ff3e..bb23850c3 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -137,6 +137,13 @@ :else (throw (ex-info "Not Supported" {:json-schema p :reason ::array-items}))))) +(defmethod type->malli :default [{:keys [type] :as p}] + (cond + (vector? type) (into [:or] (map #(type->malli {:type %}) type)) + :else + (throw (ex-info "Not Supported" {:json-schema p + :reason ::unparseable-type})))) + (defn json-schema-document->malli [obj] [:schema {:registry (into {} (map-values schema->malli) From d4d32a5500ea12c69fe10caad9219a0442e1625e Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 15:49:50 +0200 Subject: [PATCH 12/86] Fix const --- src/malli/json_schema/parse.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index bb23850c3..3eb58b9d6 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -32,7 +32,7 @@ (-keys :enum) (into [:enum] (:enum js-schema)) - (-keys :const) [:enum (:const js-schema)] + (-keys :const) [:= (:const js-schema)] ;; Aggregates (-keys :oneOf) (into From 33fd1b63dbaa442e72b7595418baf80d03e8900b Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 15:54:02 +0200 Subject: [PATCH 13/86] Add test for parser --- test/malli/json_schema/parse_test.cljc | 136 +++++++++++++++++++++++++ 1 file changed, 136 insertions(+) create mode 100644 test/malli/json_schema/parse_test.cljc diff --git a/test/malli/json_schema/parse_test.cljc b/test/malli/json_schema/parse_test.cljc new file mode 100644 index 000000000..aa12b4b9b --- /dev/null +++ b/test/malli/json_schema/parse_test.cljc @@ -0,0 +1,136 @@ +(ns malli.json-schema.parse-test + (:require [clojure.test :refer [deftest is testing]] + [malli.core :as m] + [malli.core-test] + [malli.json-schema :as json-schema] + [malli.json-schema.parse :as sut] + [malli.util :as mu])) + +(def expectations + [;; predicates + [(m/schema pos-int?) {:type "integer", :minimum 1}] + [pos? {:type "number" :exclusiveMinimum 0}] + [number? {:type "number"}] + ;; comparators + [[:> 6] {:type "number", :exclusiveMinimum 6}] + [[:>= 6] {:type "number", :minimum 6}] + [[:< 6] {:type "number", :exclusiveMaximum 6}] + [[:<= 6] {:type "number", :maximum 6}] + [[:= "x"] {:const "x"}] + ;; base + [[:not string?] {:not {:type "string"}}] + [[:and int? pos-int?] {:allOf [{:type "integer"} + {:type "integer", :minimum 1}]}] + [[:or int? string?] {:anyOf [{:type "integer"} {:type "string"}]}] + [[:map + [:a string?] + [:b {:optional true} string?] + [:c string?]] {:type "object" + :properties {:a {:type "string"} + :b {:type "string"} + :c {:type "string"}} + :required [:a :c]}] + [[:or [:map [:type string?] [:size int?]] [:map [:type string?] [:name string?] [:address [:map [:country string?]]]] string?] + {:anyOf [{:type "object", + :properties {:type {:type "string"} + :size {:type "integer"}}, + :required [:type :size]} + {:type "object", + :properties {:type {:type "string"}, + :name {:type "string"}, + :address {:type "object" + :properties {:country {:type "string"}} + :required [:country]}}, + :required [:type :name :address]} + {:type "string"}]}] + [[:or [:map [:type string?] [:size int?]] [:map [:type string?] [:name string?] [:address [:map [:country string?]]]] string?] + {:oneOf [{:type "object", + :properties {:type {:type "string"} + :size {:type "integer"}}, + :required [:type :size]} + {:type "object", + :properties {:type {:type "string"}, + :name {:type "string"}, + :address {:type "object" + :properties {:country {:type "string"}} + :required [:country]}}, + :required [:type :name :address]} + {:type "string"}]}] + [[:map-of string? string?] {:type "object" + :additionalProperties {:type "string"}}] + [[:vector string?] {:type "array", :items {:type "string"}}] + [[:sequential string?] {:type "array", :items {:type "string"}}] + [[:set string?] {:type "array" + :items {:type "string"} + :uniqueItems true}] + [[:enum 1 2 "3"] {:enum [1 2 "3"]}] + [[:enum 1 2 3] {:type "integer" :enum [1 2 3]}] + [[:enum 1.1 2.2 3.3] {:type "number" :enum [1.1 2.2 3.3]}] + [[:enum "kikka" "kukka"] {:type "string" :enum ["kikka" "kukka"]}] + [[:enum :kikka :kukka] {:type "string" :enum [:kikka :kukka]}] + [[:enum 'kikka 'kukka] {:type "string" :enum ['kikka 'kukka]}] + [[:maybe string?] {:oneOf [{:type "string"} {:type "null"}]}] + [[:tuple string? string?] {:type "array" + :items [{:type "string"} {:type "string"}] + :additionalItems false}] + [[:re "^[a-z]+\\.[a-z]+$"] {:type "string", :pattern "^[a-z]+\\.[a-z]+$"}] + [[:fn {:gen/elements [1]} int?] {}] + [:any {}] + [:some {}] + [:nil {:type "null"}] + [[:string {:min 1, :max 4}] {:type "string", :minLength 1, :maxLength 4}] + [[:and [:<= 4] pos-int?] {:type "integer", :minimum 1, :maximum 4}] + [[:and [:<= 4] [:>= 1]] {:type "number", :minimum 1, :maximum 4}] + [:keyword {:type "string"}] + [:qualified-keyword {:type "string"}] + [:symbol {:type "string"}] + [:qualified-symbol {:type "string"}] + [:uuid {:type "string", :format "uuid"}] + + [[:=> :cat int?] {} :fn] + [[:function [:=> :cat int?]] {} :fn] + [ifn? {}] + + [int? {:type "integer"}] + ;; protocols + [(reify + m/Schema + (-properties [_]) + (-parent [_] (reify m/IntoSchema (-type [_]) (-type-properties [_]))) + (-form [_]) + (-validator [_] int?) + (-walk [t w p o] (m/-outer w t p nil o)) + json-schema/JsonSchema + (-accept [_ _ _] {:type "custom"})) {:type "custom"}] + ;; type-properties + [[:>= 6] {:type "integer", :format "int64", :minimum 6}] + [[:>= {:json-schema/example 42} 6] {:type "integer", :format "int64", :minimum 6, :example 42}]]) + +(deftest json-schema-test + (doseq [[schema json-schema] expectations] + (testing json-schema + (is (mu/equals (m/schema schema) + (sut/schema->malli json-schema))))) + + #_(testing "with properties" + (is (= {:allOf [{:type "integer"}] + :title "age" + :description "blabla" + :default 42} + (json-schema/transform + [:and {:title "age" + :description "blabla" + :default 42} int?]))) + (is (= {:allOf [{:type "integer"}] + :title "age2" + :description "blabla2" + :default 422 + :example 422} + (json-schema/transform + [:and {:title "age" + :json-schema/title "age2" + :description "blabla" + :json-schema/description "blabla2" + :default 42 + :json-schema/default 422 + :json-schema/example 422} int?]))))) From 90b0f39aa87e5722fb24251a6a241d8c0b8c565e Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 15:58:20 +0200 Subject: [PATCH 14/86] Fix numbers --- src/malli/json_schema/parse.cljc | 44 ++++++++++++++++++++++---------- 1 file changed, 31 insertions(+), 13 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index 3eb58b9d6..a6c79bcef 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -110,21 +110,39 @@ minLength (assoc :min minLength) maxLength (assoc :max maxLength))])) -(defmethod type->malli "integer" [{:keys [minimum maximum exclusiveMinimum exclusiveMaximum multipleOf] - :or {minimum Integer/MIN_VALUE - maximum Integer/MAX_VALUE}}] - ;; On draft 4, exclusive{Minimum,Maximum} is a boolean. - ;; TODO Decide on whether draft 4 will be supported - ;; TODO Implement exclusive{Minimum,Maximum} support +(defn- number->malli [{:keys [minimum maximum exclusiveMinimum exclusiveMaximum + multipleOf enum type] + :as schema}] + (let [integer (= type "integer") + maximum (if (number? exclusiveMaximum) exclusiveMaximum maximum) + minimum (if (number? exclusiveMinimum) exclusiveMinimum minimum)] + (cond-> (cond + (or minimum maximum) [] + enum [(into [:enum] enum)] + integer [int?] + :else [number?]) + maximum (into (cond + (and (zero? maximum) exclusiveMaximum) [(if integer neg-int? neg?)] + (and (= -1 maximum) integer) [neg-int?] + :else [[(if exclusiveMaximum :< :<=) maximum]])) + minimum (into (cond + (and (zero? minimum) exclusiveMinimum) [(if integer pos-int? pos?)] + (and (= 1 minimum) integer) [pos-int?] + :else [[(if exclusiveMinimum :> :>=) minimum]]))))) + +(defmethod type->malli "integer" [p] ;; TODO Implement multipleOf support - ;; TODO Wrap, when it makes sense, the values below with range checkers, i.e. [:< maximum] - ;; TODO extract ranges logic and reuse with number - (cond - (pos? minimum) pos-int? - (neg? maximum) neg-int? - :else int?)) + (let [ranges-logic (number->malli p)] + (if (> (count ranges-logic) 1) + (into [:and] ranges-logic) + (first ranges-logic)))) + +(defmethod type->malli "number" [{:keys [exclusiveMinimum exclusiveMaximum minimum maximum] :as p}] + (let [ranges-logic (number->malli p)] + (if (> (count ranges-logic) 1) + (into [:and] ranges-logic) + (first ranges-logic)))) -(defmethod type->malli "number" [p] number?) (defmethod type->malli "boolean" [p] boolean?) (defmethod type->malli "null" [p] nil?) (defmethod type->malli "object" [p] (object->malli p)) From a08acfc636e4d920f657bf26c1653bb0946ab830 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 16:00:45 +0200 Subject: [PATCH 15/86] Tweak string parsing (omit :min/:max when {min,max}Length is missing) --- src/malli/json_schema/parse.cljc | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index a6c79bcef..4f02fbcb6 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -106,9 +106,12 @@ :string (into [:enum] enum)] (= format "uuid") uuid? - :else [:string (cond-> {} - minLength (assoc :min minLength) - maxLength (assoc :max maxLength))])) + :else (let [attrs (cond-> nil + minLength (assoc :min minLength) + maxLength (assoc :max maxLength))] + (if attrs + [:string attrs] + string?)))) (defn- number->malli [{:keys [minimum maximum exclusiveMinimum exclusiveMaximum multipleOf enum type] From 5d2ac57eeafcb4b1106d5da7f34c67999bc112ce Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 16:01:33 +0200 Subject: [PATCH 16/86] Prefer :nil over nil? --- src/malli/json_schema/parse.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index 4f02fbcb6..f457924dd 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -147,7 +147,7 @@ (first ranges-logic)))) (defmethod type->malli "boolean" [p] boolean?) -(defmethod type->malli "null" [p] nil?) +(defmethod type->malli "null" [p] :nil) (defmethod type->malli "object" [p] (object->malli p)) (defmethod type->malli "array" [p] (let [items (:items p)] (cond From 69722c825c8e19c00088e5af6740c3695e17cc06 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 17:02:01 +0200 Subject: [PATCH 17/86] Remove ambiguous test cases --- test/malli/json_schema/parse_test.cljc | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/test/malli/json_schema/parse_test.cljc b/test/malli/json_schema/parse_test.cljc index aa12b4b9b..3e2b4b2d1 100644 --- a/test/malli/json_schema/parse_test.cljc +++ b/test/malli/json_schema/parse_test.cljc @@ -69,7 +69,7 @@ [[:enum "kikka" "kukka"] {:type "string" :enum ["kikka" "kukka"]}] [[:enum :kikka :kukka] {:type "string" :enum [:kikka :kukka]}] [[:enum 'kikka 'kukka] {:type "string" :enum ['kikka 'kukka]}] - [[:maybe string?] {:oneOf [{:type "string"} {:type "null"}]}] + [[:or string? :nil] {:oneOf [{:type "string"} {:type "null"}]}] [[:tuple string? string?] {:type "array" :items [{:type "string"} {:type "string"}] :additionalItems false}] @@ -81,10 +81,6 @@ [[:string {:min 1, :max 4}] {:type "string", :minLength 1, :maxLength 4}] [[:and [:<= 4] pos-int?] {:type "integer", :minimum 1, :maximum 4}] [[:and [:<= 4] [:>= 1]] {:type "number", :minimum 1, :maximum 4}] - [:keyword {:type "string"}] - [:qualified-keyword {:type "string"}] - [:symbol {:type "string"}] - [:qualified-symbol {:type "string"}] [:uuid {:type "string", :format "uuid"}] [[:=> :cat int?] {} :fn] From 7e25ef07c23fb51619fdcc85d4af7e58b8064375 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 17:02:41 +0200 Subject: [PATCH 18/86] Fix string enums --- src/malli/json_schema/parse.cljc | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index f457924dd..946204ec1 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -102,10 +102,8 @@ ;; String enums are stricter, so they're also implemented here. (cond pattern [:re pattern] - enum [:and - :string - (into [:enum] enum)] - (= format "uuid") uuid? + enum (into [:enum] enum) + (= format "uuid") :uuid :else (let [attrs (cond-> nil minLength (assoc :min minLength) maxLength (assoc :max maxLength))] From f54739a2ca505da42f3d3e5bd863eafdd6d8d8e8 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 17:11:13 +0200 Subject: [PATCH 19/86] Remove ambiguous/invalid test cases --- test/malli/json_schema/parse_test.cljc | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/test/malli/json_schema/parse_test.cljc b/test/malli/json_schema/parse_test.cljc index 3e2b4b2d1..8eb389683 100644 --- a/test/malli/json_schema/parse_test.cljc +++ b/test/malli/json_schema/parse_test.cljc @@ -74,30 +74,14 @@ :items [{:type "string"} {:type "string"}] :additionalItems false}] [[:re "^[a-z]+\\.[a-z]+$"] {:type "string", :pattern "^[a-z]+\\.[a-z]+$"}] - [[:fn {:gen/elements [1]} int?] {}] [:any {}] - [:some {}] [:nil {:type "null"}] [[:string {:min 1, :max 4}] {:type "string", :minLength 1, :maxLength 4}] [[:and [:<= 4] pos-int?] {:type "integer", :minimum 1, :maximum 4}] [[:and [:<= 4] [:>= 1]] {:type "number", :minimum 1, :maximum 4}] [:uuid {:type "string", :format "uuid"}] - [[:=> :cat int?] {} :fn] - [[:function [:=> :cat int?]] {} :fn] - [ifn? {}] - [int? {:type "integer"}] - ;; protocols - [(reify - m/Schema - (-properties [_]) - (-parent [_] (reify m/IntoSchema (-type [_]) (-type-properties [_]))) - (-form [_]) - (-validator [_] int?) - (-walk [t w p o] (m/-outer w t p nil o)) - json-schema/JsonSchema - (-accept [_ _ _] {:type "custom"})) {:type "custom"}] ;; type-properties [[:>= 6] {:type "integer", :format "int64", :minimum 6}] [[:>= {:json-schema/example 42} 6] {:type "integer", :format "int64", :minimum 6, :example 42}]]) From 61b174e57d4f2aedcd3998e708cd6b2781b8bf5e Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 17:11:27 +0200 Subject: [PATCH 20/86] Fix case of empty json schema --- src/malli/json_schema/parse.cljc | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index 946204ec1..3864f9393 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -55,6 +55,8 @@ (-keys :$ref) ($ref (:$ref js-schema)) + (empty -keys) :any + :else (throw (ex-info "Not supported" {:json-schema js-schema :reason ::schema-type}))) merge From 0bc83f049257a8b51605cb25ab9f35763cb117f5 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 17:18:47 +0200 Subject: [PATCH 21/86] Remove ambiguous test case --- test/malli/json_schema/parse_test.cljc | 1 - 1 file changed, 1 deletion(-) diff --git a/test/malli/json_schema/parse_test.cljc b/test/malli/json_schema/parse_test.cljc index 8eb389683..f57e7240b 100644 --- a/test/malli/json_schema/parse_test.cljc +++ b/test/malli/json_schema/parse_test.cljc @@ -59,7 +59,6 @@ [[:map-of string? string?] {:type "object" :additionalProperties {:type "string"}}] [[:vector string?] {:type "array", :items {:type "string"}}] - [[:sequential string?] {:type "array", :items {:type "string"}}] [[:set string?] {:type "array" :items {:type "string"} :uniqueItems true}] From 1fbf35a922a463f2678d6adc68041d8a82ac022f Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 17:19:22 +0200 Subject: [PATCH 22/86] Fix set parsing --- src/malli/json_schema/parse.cljc | 1 + 1 file changed, 1 insertion(+) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index 3864f9393..47a3434d6 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -154,6 +154,7 @@ (vector? items) (into [:tuple] (map schema->malli) items) + (:uniqueItems p) [:set (schema->malli items)] (map? items) [:vector (schema->malli items)] :else (throw (ex-info "Not Supported" {:json-schema p :reason ::array-items}))))) From 22572dce4c42ed9130f409f75f66748a69987906 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 18:19:35 +0200 Subject: [PATCH 23/86] Fix additionalProperties in objects --- src/malli/json_schema/parse.cljc | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index 47a3434d6..157313ad5 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -86,13 +86,15 @@ (filter some?) predicates))))) -(defn object->malli [v] +(defn object->malli [{:keys [additionalProperties] :as v}] (let [required (into #{} ;; TODO Should use the same fn as $ref (map keyword) (:required v)) - closed? (false? (:additionalProperties v))] - (m/schema (-> [:map] + closed? (false? additionalProperties)] + (m/schema (-> (if (:type additionalProperties) + (let [va (schema->malli additionalProperties)] [:map-of va va]) + [:map]) (cond-> closed? (conj {:closed :true})) (into (map (partial properties->malli required)) From b849ddbd5be7db776cfc939009a6fb043b18d796 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 22:46:25 +0200 Subject: [PATCH 24/86] Fix typo --- src/malli/json_schema/parse.cljc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index 157313ad5..aeb0f5b3a 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -71,7 +71,7 @@ (defn- min-properties [-min] (prop-size (partial <= -min))) (defn- max-properties [-max] (prop-size (partial >= -max))) -(defn with-min-max-poperties-size [malli v] +(defn with-min-max-properties-size [malli v] (let [predicates [(some->> v (:minProperties) (min-properties) @@ -99,7 +99,7 @@ (into (map (partial properties->malli required)) (:properties v)) - (with-min-max-poperties-size v))))) + (with-min-max-properties-size v))))) (defmethod type->malli "string" [{:keys [pattern minLength maxLength enum format]}] ;; `format` metadata is deliberately not considered. From 2abfde4f2e58939ba097e29ba440bbe9bc5923bb Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 22:47:42 +0200 Subject: [PATCH 25/86] Prefer string keyword --- src/malli/json_schema/parse.cljc | 2 +- test/malli/json_schema/parse_test.cljc | 24 ++++++++++++------------ 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index aeb0f5b3a..57f3e530f 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -113,7 +113,7 @@ maxLength (assoc :max maxLength))] (if attrs [:string attrs] - string?)))) + :string)))) (defn- number->malli [{:keys [minimum maximum exclusiveMinimum exclusiveMaximum multipleOf enum type] diff --git a/test/malli/json_schema/parse_test.cljc b/test/malli/json_schema/parse_test.cljc index f57e7240b..631419dc3 100644 --- a/test/malli/json_schema/parse_test.cljc +++ b/test/malli/json_schema/parse_test.cljc @@ -18,19 +18,19 @@ [[:<= 6] {:type "number", :maximum 6}] [[:= "x"] {:const "x"}] ;; base - [[:not string?] {:not {:type "string"}}] + [[:not :string] {:not {:type "string"}}] [[:and int? pos-int?] {:allOf [{:type "integer"} {:type "integer", :minimum 1}]}] - [[:or int? string?] {:anyOf [{:type "integer"} {:type "string"}]}] + [[:or int? :string] {:anyOf [{:type "integer"} {:type "string"}]}] [[:map - [:a string?] - [:b {:optional true} string?] - [:c string?]] {:type "object" + [:a :string] + [:b {:optional true} :string] + [:c :string]] {:type "object" :properties {:a {:type "string"} :b {:type "string"} :c {:type "string"}} :required [:a :c]}] - [[:or [:map [:type string?] [:size int?]] [:map [:type string?] [:name string?] [:address [:map [:country string?]]]] string?] + [[:or [:map [:type :string] [:size int?]] [:map [:type :string] [:name :string] [:address [:map [:country :string]]]] :string] {:anyOf [{:type "object", :properties {:type {:type "string"} :size {:type "integer"}}, @@ -43,7 +43,7 @@ :required [:country]}}, :required [:type :name :address]} {:type "string"}]}] - [[:or [:map [:type string?] [:size int?]] [:map [:type string?] [:name string?] [:address [:map [:country string?]]]] string?] + [[:or [:map [:type :string] [:size int?]] [:map [:type :string] [:name :string] [:address [:map [:country :string]]]] :string] {:oneOf [{:type "object", :properties {:type {:type "string"} :size {:type "integer"}}, @@ -56,10 +56,10 @@ :required [:country]}}, :required [:type :name :address]} {:type "string"}]}] - [[:map-of string? string?] {:type "object" + [[:map-of :string :string] {:type "object" :additionalProperties {:type "string"}}] - [[:vector string?] {:type "array", :items {:type "string"}}] - [[:set string?] {:type "array" + [[:vector :string] {:type "array", :items {:type "string"}}] + [[:set :string] {:type "array" :items {:type "string"} :uniqueItems true}] [[:enum 1 2 "3"] {:enum [1 2 "3"]}] @@ -68,8 +68,8 @@ [[:enum "kikka" "kukka"] {:type "string" :enum ["kikka" "kukka"]}] [[:enum :kikka :kukka] {:type "string" :enum [:kikka :kukka]}] [[:enum 'kikka 'kukka] {:type "string" :enum ['kikka 'kukka]}] - [[:or string? :nil] {:oneOf [{:type "string"} {:type "null"}]}] - [[:tuple string? string?] {:type "array" + [[:or :string :nil] {:oneOf [{:type "string"} {:type "null"}]}] + [[:tuple :string :string] {:type "array" :items [{:type "string"} {:type "string"}] :additionalItems false}] [[:re "^[a-z]+\\.[a-z]+$"] {:type "string", :pattern "^[a-z]+\\.[a-z]+$"}] From a4ebd9da56570044ad268d81b1dfb84742136fe8 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 23:58:38 +0200 Subject: [PATCH 26/86] Prefer keywords --- src/malli/json_schema/parse.cljc | 21 ++++++++----------- test/malli/json_schema/parse_test.cljc | 28 +++++++++++++------------- 2 files changed, 22 insertions(+), 27 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index 57f3e530f..02891996e 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -119,21 +119,16 @@ multipleOf enum type] :as schema}] (let [integer (= type "integer") + explicit-double (not (or minimum maximum integer enum + (number? exclusiveMaximum) (number? exclusiveMinimum))) maximum (if (number? exclusiveMaximum) exclusiveMaximum maximum) minimum (if (number? exclusiveMinimum) exclusiveMinimum minimum)] - (cond-> (cond - (or minimum maximum) [] - enum [(into [:enum] enum)] - integer [int?] - :else [number?]) - maximum (into (cond - (and (zero? maximum) exclusiveMaximum) [(if integer neg-int? neg?)] - (and (= -1 maximum) integer) [neg-int?] - :else [[(if exclusiveMaximum :< :<=) maximum]])) - minimum (into (cond - (and (zero? minimum) exclusiveMinimum) [(if integer pos-int? pos?)] - (and (= 1 minimum) integer) [pos-int?] - :else [[(if exclusiveMinimum :> :>=) minimum]]))))) + (cond-> (if integer [:int] []) + (or minimum maximum) identity + enum (into [(into [:enum] enum)]) + maximum (into [[(if exclusiveMaximum :< :<=) maximum]]) + minimum (into [[(if exclusiveMinimum :> :>=) minimum]]) + explicit-double (into [[:double]])))) (defmethod type->malli "integer" [p] ;; TODO Implement multipleOf support diff --git a/test/malli/json_schema/parse_test.cljc b/test/malli/json_schema/parse_test.cljc index 631419dc3..6df06ca71 100644 --- a/test/malli/json_schema/parse_test.cljc +++ b/test/malli/json_schema/parse_test.cljc @@ -7,10 +7,10 @@ [malli.util :as mu])) (def expectations - [;; predicates - [(m/schema pos-int?) {:type "integer", :minimum 1}] - [pos? {:type "number" :exclusiveMinimum 0}] - [number? {:type "number"}] + [ ;; predicates + [[:and :int [:>= 1]] {:type "integer", :minimum 1}] + [[:> 0] {:type "number" :exclusiveMinimum 0}] + [:double {:type "number"}] ;; comparators [[:> 6] {:type "number", :exclusiveMinimum 6}] [[:>= 6] {:type "number", :minimum 6}] @@ -19,9 +19,9 @@ [[:= "x"] {:const "x"}] ;; base [[:not :string] {:not {:type "string"}}] - [[:and int? pos-int?] {:allOf [{:type "integer"} - {:type "integer", :minimum 1}]}] - [[:or int? :string] {:anyOf [{:type "integer"} {:type "string"}]}] + [[:and :int [:and :int [:>= 1]]] {:allOf [{:type "integer"} + {:type "integer", :minimum 1}]}] + [[:or :int :string] {:anyOf [{:type "integer"} {:type "string"}]}] [[:map [:a :string] [:b {:optional true} :string] @@ -30,7 +30,7 @@ :b {:type "string"} :c {:type "string"}} :required [:a :c]}] - [[:or [:map [:type :string] [:size int?]] [:map [:type :string] [:name :string] [:address [:map [:country :string]]]] :string] + [[:or [:map [:type :string] [:size :int]] [:map [:type :string] [:name :string] [:address [:map [:country :string]]]] :string] {:anyOf [{:type "object", :properties {:type {:type "string"} :size {:type "integer"}}, @@ -43,7 +43,7 @@ :required [:country]}}, :required [:type :name :address]} {:type "string"}]}] - [[:or [:map [:type :string] [:size int?]] [:map [:type :string] [:name :string] [:address [:map [:country :string]]]] :string] + [[:or [:map [:type :string] [:size :int]] [:map [:type :string] [:name :string] [:address [:map [:country :string]]]] :string] {:oneOf [{:type "object", :properties {:type {:type "string"} :size {:type "integer"}}, @@ -63,7 +63,7 @@ :items {:type "string"} :uniqueItems true}] [[:enum 1 2 "3"] {:enum [1 2 "3"]}] - [[:enum 1 2 3] {:type "integer" :enum [1 2 3]}] + [[:and :int [:enum 1 2 3]] {:type "integer" :enum [1 2 3]}] [[:enum 1.1 2.2 3.3] {:type "number" :enum [1.1 2.2 3.3]}] [[:enum "kikka" "kukka"] {:type "string" :enum ["kikka" "kukka"]}] [[:enum :kikka :kukka] {:type "string" :enum [:kikka :kukka]}] @@ -76,14 +76,14 @@ [:any {}] [:nil {:type "null"}] [[:string {:min 1, :max 4}] {:type "string", :minLength 1, :maxLength 4}] - [[:and [:<= 4] pos-int?] {:type "integer", :minimum 1, :maximum 4}] + [[:and :int [:<= 4] [:>= 1]] {:type "integer", :minimum 1, :maximum 4}] [[:and [:<= 4] [:>= 1]] {:type "number", :minimum 1, :maximum 4}] [:uuid {:type "string", :format "uuid"}] - [int? {:type "integer"}] + [:int {:type "integer"}] ;; type-properties - [[:>= 6] {:type "integer", :format "int64", :minimum 6}] - [[:>= {:json-schema/example 42} 6] {:type "integer", :format "int64", :minimum 6, :example 42}]]) + [[:and :int [:>= 6]] {:type "integer", :format "int64", :minimum 6}] + [[:and {:json-schema/example 42} :int [:>= 6]] {:type "integer", :format "int64", :minimum 6, :example 42}]]) (deftest json-schema-test (doseq [[schema json-schema] expectations] From 18a49e669e7efc6957e0abcaf81d4afed75b1169 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sat, 4 Mar 2023 23:58:58 +0200 Subject: [PATCH 27/86] Add support for more types - custom (when single attribute) and file --- src/malli/json_schema/parse.cljc | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index 02891996e..f6e370357 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -156,9 +156,13 @@ :else (throw (ex-info "Not Supported" {:json-schema p :reason ::array-items}))))) +(defmethod type->malli "file" [p] + [:map {:json-schema {:type "file"}} [:file any?]]) + (defmethod type->malli :default [{:keys [type] :as p}] (cond (vector? type) (into [:or] (map #(type->malli {:type %}) type)) + (and type (= 1 (count (keys p)))) {:json-schema/type type} :else (throw (ex-info "Not Supported" {:json-schema p :reason ::unparseable-type})))) From 66a5e943393ed64998902432543aac679d983898 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sun, 5 Mar 2023 00:04:04 +0200 Subject: [PATCH 28/86] Add tests for schema properties and improve test case diffs --- src/malli/json_schema/parse.cljc | 2 +- test/malli/json_schema/parse_test.cljc | 56 +++++++++++++++----------- 2 files changed, 33 insertions(+), 25 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index f6e370357..80353e489 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -157,7 +157,7 @@ :reason ::array-items}))))) (defmethod type->malli "file" [p] - [:map {:json-schema {:type "file"}} [:file any?]]) + [:map {:json-schema {:type "file"}} [:file :any]]) (defmethod type->malli :default [{:keys [type] :as p}] (cond diff --git a/test/malli/json_schema/parse_test.cljc b/test/malli/json_schema/parse_test.cljc index 6df06ca71..35e4a8d16 100644 --- a/test/malli/json_schema/parse_test.cljc +++ b/test/malli/json_schema/parse_test.cljc @@ -88,28 +88,36 @@ (deftest json-schema-test (doseq [[schema json-schema] expectations] (testing json-schema - (is (mu/equals (m/schema schema) - (sut/schema->malli json-schema))))) + (is (= schema + (m/form (sut/schema->malli json-schema)))))) - #_(testing "with properties" - (is (= {:allOf [{:type "integer"}] - :title "age" - :description "blabla" - :default 42} - (json-schema/transform - [:and {:title "age" - :description "blabla" - :default 42} int?]))) - (is (= {:allOf [{:type "integer"}] - :title "age2" - :description "blabla2" - :default 422 - :example 422} - (json-schema/transform - [:and {:title "age" - :json-schema/title "age2" - :description "blabla" - :json-schema/description "blabla2" - :default 42 - :json-schema/default 422 - :json-schema/example 422} int?]))))) + (testing "full override" + (is (= [:map {:json-schema {:type "file"}} [:file :any]] + (m/form (sut/schema->malli {:type "file"}))))) + + (testing "with properties" + (is (= [:map + [:x1 [:string {:json-schema/title "x"}]] + [:x2 [:any #:json-schema{:default "x" :title "x"}]] + [:x3 [:string #:json-schema{:title "x" :default "x"}]] + [:x4 {:optional true} [:any #:json-schema{:title "x-string" :default "x2"}]]] + + (m/form (sut/schema->malli {:type "object", + :properties {:x1 {:title "x", :type "string"} + :x2 {:title "x", :default "x"} + :x3 {:title "x", :type "string", :default "x"} + :x4 {:title "x-string", :default "x2"}}, + :required [:x1 :x2 :x3]})))) + + #_(testing "custom type" + (is (= [:map + [:x5 {:json-schema/type "x-string"} :string]] + (m/form (sut/schema->malli {:type "object", :properties {:x5 {:type "x-string"}}, :required [:x5]}))))) + + (is (= [:and {:json-schema/title "age" + :json-schema/description "blabla" + :json-schema/default 42} :int] + (m/form (sut/schema->malli {:allOf [{:type "integer"}] + :title "age" + :description "blabla" + :default 42})))))) From c40e18bd44c50d4e109cc9bd3c4bb2d777317342 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sun, 5 Mar 2023 00:05:10 +0200 Subject: [PATCH 29/86] Support annotations --- src/malli/json_schema/parse.cljc | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index 80353e489..6e1e03391 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -4,12 +4,16 @@ [clojure.set :as set] [clojure.string :as str])) -(def annotations #{:title :description :default :examples}) +(def annotations #{:title :description :default :examples :example}) (defn annotations->properties [js-schema] (-> js-schema (select-keys annotations) - (set/rename-keys {:examples :json-schema/examples}))) + (set/rename-keys {:examples :json-schema/examples + :example :json-schema/example + :title :json-schema/title + :description :json-schema/description + :default :json-schema/default}))) ;; Utility Functions (defn- map-values From 169d9ea340b742746ad69698c9df843ef47686af Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sun, 5 Mar 2023 02:13:25 +0200 Subject: [PATCH 30/86] Specify one-way expectations (mutating conversions) --- test/malli/json_schema/parse_test.cljc | 42 +++++++++++--------------- 1 file changed, 18 insertions(+), 24 deletions(-) diff --git a/test/malli/json_schema/parse_test.cljc b/test/malli/json_schema/parse_test.cljc index 35e4a8d16..c8e38f9e5 100644 --- a/test/malli/json_schema/parse_test.cljc +++ b/test/malli/json_schema/parse_test.cljc @@ -8,7 +8,8 @@ (def expectations [ ;; predicates - [[:and :int [:>= 1]] {:type "integer", :minimum 1}] + [[:and :int [:>= 1]] {:type "integer", :minimum 1} :one-way true] + [[:and :int [:>= 1]] {:allOf [{:type "integer"} {:type "number", :minimum 1}]}] [[:> 0] {:type "number" :exclusiveMinimum 0}] [:double {:type "number"}] ;; comparators @@ -20,7 +21,7 @@ ;; base [[:not :string] {:not {:type "string"}}] [[:and :int [:and :int [:>= 1]]] {:allOf [{:type "integer"} - {:type "integer", :minimum 1}]}] + {:type "integer", :minimum 1}]} :one-way true] [[:or :int :string] {:anyOf [{:type "integer"} {:type "string"}]}] [[:map [:a :string] @@ -30,19 +31,6 @@ :b {:type "string"} :c {:type "string"}} :required [:a :c]}] - [[:or [:map [:type :string] [:size :int]] [:map [:type :string] [:name :string] [:address [:map [:country :string]]]] :string] - {:anyOf [{:type "object", - :properties {:type {:type "string"} - :size {:type "integer"}}, - :required [:type :size]} - {:type "object", - :properties {:type {:type "string"}, - :name {:type "string"}, - :address {:type "object" - :properties {:country {:type "string"}} - :required [:country]}}, - :required [:type :name :address]} - {:type "string"}]}] [[:or [:map [:type :string] [:size :int]] [:map [:type :string] [:name :string] [:address [:map [:country :string]]]] :string] {:oneOf [{:type "object", :properties {:type {:type "string"} @@ -55,7 +43,7 @@ :properties {:country {:type "string"}} :required [:country]}}, :required [:type :name :address]} - {:type "string"}]}] + {:type "string"}]} :one-way true] [[:map-of :string :string] {:type "object" :additionalProperties {:type "string"}}] [[:vector :string] {:type "array", :items {:type "string"}}] @@ -63,12 +51,13 @@ :items {:type "string"} :uniqueItems true}] [[:enum 1 2 "3"] {:enum [1 2 "3"]}] - [[:and :int [:enum 1 2 3]] {:type "integer" :enum [1 2 3]}] + [[:and :int [:enum 1 2 3]] {:type "integer" :enum [1 2 3]} :one-way true] [[:enum 1.1 2.2 3.3] {:type "number" :enum [1.1 2.2 3.3]}] [[:enum "kikka" "kukka"] {:type "string" :enum ["kikka" "kukka"]}] [[:enum :kikka :kukka] {:type "string" :enum [:kikka :kukka]}] [[:enum 'kikka 'kukka] {:type "string" :enum ['kikka 'kukka]}] - [[:or :string :nil] {:oneOf [{:type "string"} {:type "null"}]}] + [[:or :string :nil] {:oneOf [{:type "string"} {:type "null"}]} :one-way true] + [[:or :string :nil] {:anyOf [{:type "string"} {:type "null"}]}] [[:tuple :string :string] {:type "array" :items [{:type "string"} {:type "string"}] :additionalItems false}] @@ -76,20 +65,25 @@ [:any {}] [:nil {:type "null"}] [[:string {:min 1, :max 4}] {:type "string", :minLength 1, :maxLength 4}] - [[:and :int [:<= 4] [:>= 1]] {:type "integer", :minimum 1, :maximum 4}] - [[:and [:<= 4] [:>= 1]] {:type "number", :minimum 1, :maximum 4}] + [[:and :int [:<= 4] [:>= 1]] {:type "integer", :minimum 1, :maximum 4} :one-way true] + [[:and [:<= 4] [:>= 1]] {:type "number", :minimum 1, :maximum 4} :one-way true] [:uuid {:type "string", :format "uuid"}] [:int {:type "integer"}] ;; type-properties - [[:and :int [:>= 6]] {:type "integer", :format "int64", :minimum 6}] - [[:and {:json-schema/example 42} :int [:>= 6]] {:type "integer", :format "int64", :minimum 6, :example 42}]]) + [[:and :int [:>= 6]] {:type "integer", :format "int64", :minimum 6} :one-way true] + [[:and {:json-schema/example 42} :int [:>= 6]] {:type "integer", :format "int64", :minimum 6, :example 42} :one-way true]]) (deftest json-schema-test - (doseq [[schema json-schema] expectations] + (doseq [[schema json-schema & {:keys [one-way]}] expectations] (testing json-schema (is (= schema - (m/form (sut/schema->malli json-schema)))))) + (m/form (sut/schema->malli json-schema))))) + + (when-not one-way + (testing (str "round trip " json-schema "\n" schema) + (is (= json-schema + (-> json-schema sut/schema->malli malli.json-schema/transform)))))) (testing "full override" (is (= [:map {:json-schema {:type "file"}} [:file :any]] From 81fd361b91d2444d846e48e7da50e0d6896d4c38 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sun, 5 Mar 2023 02:15:33 +0200 Subject: [PATCH 31/86] Tweak --- src/malli/json_schema/parse.cljc | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index 6e1e03391..f95f81c9b 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -123,8 +123,8 @@ multipleOf enum type] :as schema}] (let [integer (= type "integer") - explicit-double (not (or minimum maximum integer enum - (number? exclusiveMaximum) (number? exclusiveMinimum))) + implicit-double (or minimum maximum integer enum + (number? exclusiveMaximum) (number? exclusiveMinimum)) maximum (if (number? exclusiveMaximum) exclusiveMaximum maximum) minimum (if (number? exclusiveMinimum) exclusiveMinimum minimum)] (cond-> (if integer [:int] []) @@ -132,7 +132,7 @@ enum (into [(into [:enum] enum)]) maximum (into [[(if exclusiveMaximum :< :<=) maximum]]) minimum (into [[(if exclusiveMinimum :> :>=) minimum]]) - explicit-double (into [[:double]])))) + (not implicit-double) (into [[:double]])))) (defmethod type->malli "integer" [p] ;; TODO Implement multipleOf support From dcf63bd30c0c3c5d458f4b65e4dea1114ed19d37 Mon Sep 17 00:00:00 2001 From: Pavlos Melissinos Date: Sun, 5 Mar 2023 02:16:41 +0200 Subject: [PATCH 32/86] Fix indentation --- src/malli/json_schema/parse.cljc | 59 ++++++++++++++++---------------- 1 file changed, 30 insertions(+), 29 deletions(-) diff --git a/src/malli/json_schema/parse.cljc b/src/malli/json_schema/parse.cljc index f95f81c9b..4af83fa24 100644 --- a/src/malli/json_schema/parse.cljc +++ b/src/malli/json_schema/parse.cljc @@ -30,41 +30,42 @@ (defn schema->malli [js-schema] (let [-keys (set (keys js-schema))] (mu/update-properties - (cond - (-keys :type) (type->malli js-schema) + (cond + (-keys :type) (type->malli js-schema) - (-keys :enum) (into [:enum] - (:enum js-schema)) + (-keys :enum) (into [:enum] + (:enum js-schema)) (-keys :const) [:= (:const js-schema)] - ;; Aggregates - (-keys :oneOf) (into - ;; TODO Figure out how to make it exclusively select o schema - [:or] - (map schema->malli) - (:oneOf js-schema)) + ;; Aggregates + (-keys :oneOf) (into + ;; TODO Figure out how to make it exclusively select o schema + ;; how about `m/multi`? + [:or] + (map schema->malli) + (:oneOf js-schema)) - (-keys :anyOf) (into - [:or] - (map schema->malli) - (:anyOf js-schema)) + (-keys :anyOf) (into + [:or] + (map schema->malli) + (:anyOf js-schema)) - (-keys :allOf) (into - [:and] - (map schema->malli) - (:allOf js-schema)) + (-keys :allOf) (into + [:and] + (map schema->malli) + (:allOf js-schema)) - (-keys :not) [:not (schema->malli (:not js-schema))] + (-keys :not) [:not (schema->malli (:not js-schema))] - (-keys :$ref) ($ref (:$ref js-schema)) + (-keys :$ref) ($ref (:$ref js-schema)) - (empty -keys) :any + (empty -keys) :any - :else (throw (ex-info "Not supported" {:json-schema js-schema - :reason ::schema-type}))) - merge - (annotations->properties js-schema)))) + :else (throw (ex-info "Not supported" {:json-schema js-schema + :reason ::schema-type}))) + merge + (annotations->properties js-schema)))) (defn properties->malli [required [k v]] (cond-> [k] @@ -101,8 +102,8 @@ [:map]) (cond-> closed? (conj {:closed :true})) (into - (map (partial properties->malli required)) - (:properties v)) + (map (partial properties->malli required)) + (:properties v)) (with-min-max-properties-size v))))) (defmethod type->malli "string" [{:keys [pattern minLength maxLength enum format]}] @@ -153,8 +154,8 @@ (defmethod type->malli "array" [p] (let [items (:items p)] (cond (vector? items) (into [:tuple] - (map schema->malli) - items) + (map schema->malli) + items) (:uniqueItems p) [:set (schema->malli items)] (map? items) [:vector (schema->malli items)] :else (throw (ex-info "Not Supported" {:json-schema p From f9ad572711eebf7ec8d854c1ba350af683ae944a Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Fri, 10 Mar 2023 09:25:16 +0200 Subject: [PATCH 33/86] BREAKING: -simple-schema :compile --- README.md | 42 ++++++++++++++++++++++++--------------- src/malli/core.cljc | 20 ++++++++----------- test/malli/core_test.cljc | 20 ++++++++++--------- 3 files changed, 45 insertions(+), 37 deletions(-) diff --git a/README.md b/README.md index fa94ae820..a7b157fd0 100644 --- a/README.md +++ b/README.md @@ -2299,26 +2299,36 @@ register the types: ### Content dependent simple schema -You can also build content-dependent schemas by using a callback function of `properties children -> opts` instead of static `opts`: +You can also build content-dependent schemas by using a callback function `:compile` of type `properties children options -> opts`: ```clojure -(def Over +(def Between (m/-simple-schema - (fn [{:keys [value]} _] - (assert (int? value)) - {:type :user/over - :pred #(and (int? %) (> % value)) - :type-properties {:error/fn (fn [error _] (str "should be over " value ", was " (:value error))) - :decode/string mt/-string->long - :json-schema/type "integer" - :json-schema/format "int64" - :json-schema/minimum value - :gen/gen (gen/large-integer* {:min (inc value)})}}))) - -(-> [Over {:value 12}] - (m/explain 10) + {:type :user/between + :compile (fn [_properties [min max] _options] + (when-not (and (int? min) (int? max)) + (m/-fail! ::invalid-children {:min min, :max max})) + {:pred #(and (int? %) (>= min % max)) + :min 2 ;; at least 1 child + :max 2 ;; at most 1 child + :type-properties {:error/fn (fn [error _] (str "should be betweeb " min " and " max ", was " (:value error))) + :decode/string mt/-string->long + :json-schema {:type "integer" + :format "int64" + :minimum min + :maximum max} + :gen/gen (gen/large-integer* {:min (inc min), :max max})}})})) + +(m/form [Between 10 20]) +; => [:user/between 10 20] + +(-> [Between 10 20] + (m/explain 8) (me/humanize)) -; => ["should be over 12, was 10"] +; => ["should be betweeb 10 and 20, was 8"] + +(mg/sample [Between -10 10]) +; => (-1 0 -2 -4 -4 0 -2 7 1 0) ``` ## Schema registry diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 13c3dfb0b..2243c0658 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -618,9 +618,10 @@ ;; Schemas ;; -(defn -simple-schema [?props] - (let [{:keys [type type-properties pred property-pred min max from-ast to-ast] - :or {min 0, max 0, from-ast -from-value-ast, to-ast -to-type-ast}} (when (map? ?props) ?props)] +(defn -simple-schema [props] + (let [{:keys [type type-properties pred property-pred min max from-ast to-ast compile] + :or {min 0, max 0, from-ast -from-value-ast, to-ast -to-type-ast}} props] + (when (fn? props) (-deprecated! "-simple-schema doesn't take fn-props, use :compiled property instead")) ^{:type ::into-schema} (reify AST @@ -631,8 +632,8 @@ (-properties-schema [_ _]) (-children-schema [_ _]) (-into-schema [parent properties children options] - (if (fn? ?props) - (-into-schema (-simple-schema (?props properties children)) properties children options) + (if compile + (-into-schema (-simple-schema (merge (dissoc props :compile) (compile properties children options))) properties children options) (let [form (delay (-simple-form parent properties children identity options)) cache (-create-cache options)] (-check-children! type properties children min max) @@ -2331,13 +2332,8 @@ (defn comparator-schemas [] (->> {:> >, :>= >=, :< <, :<= <=, := =, :not= not=} - (-vmap (fn [[k v]] [k (-simple-schema (fn [_ [child]] - {:type k - :pred (-safe-pred #(v % child)) - :from-ast -from-value-ast - :to-ast -to-value-ast - :min 1 - :max 1}))])) + (-vmap (fn [[k v]] [k (-simple-schema {:type k :from-ast -from-value-ast :to-ast -to-value-ast :min 1 :max 1 + :compile (fn [_ [child] _] {:pred (-safe-pred #(v % child))})})])) (into {}) (reduce-kv assoc nil))) (defn type-schemas [] diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 8f4f8e2f1..35ddf5cb1 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -2277,18 +2277,20 @@ (testing "with instance-based type-properties" (let [Over (m/-simple-schema - (fn [{:keys [value]} _] - (assert (int? value)) - {:type :user/over - :pred #(and (int? %) (> % value)) - :type-properties {:error/message (str "should be over " value) - :decode/string mt/-string->long - :json-schema/type "integer" - :json-schema/format "int64" - :json-schema/minimum value}}))] + {:type :user/over + :compile (fn [{:keys [value]} _ _] + (assert (int? value)) + {:pred #(and (int? %) (> % value)) + :type-properties {:error/message (str "should be over " value) + :decode/string mt/-string->long + :json-schema/type "integer" + :json-schema/format "int64" + :json-schema/minimum value}})})] (testing "over6" (let [schema [Over {:value 6}]] + (testing "type" + (is (= :user/over (m/-type Over) (m/type schema)))) (testing "form" (is (= [:user/over {:value 6}] (m/form schema)))) (testing "validation" From 8e6e4ed9e414177c6793f53005ed525fdd37d6d4 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Fri, 10 Mar 2023 09:25:47 +0200 Subject: [PATCH 34/86] BREAKING: -collection-schema :compile --- src/malli/core.cljc | 165 +++++++++++++++++++------------------- test/malli/core_test.cljc | 19 ++--- 2 files changed, 92 insertions(+), 92 deletions(-) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 2243c0658..06c3dcaf2 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -1149,89 +1149,88 @@ (-get [_ key default] (get children key default)) (-set [this key value] (-set-assoc-children this key value)))))))) -(defn -collection-schema [?props] - (let [props* (atom (when (map? ?props) ?props))] - ^{:type ::into-schema} - (reify - AST - (-from-ast [parent ast options] (-from-child-ast parent ast options)) - IntoSchema - (-type [_] (:type @props*)) - (-type-properties [_] (:type-properties @props*)) - (-properties-schema [_ _]) - (-children-schema [_ _]) - (-into-schema [parent {:keys [min max] :as properties} children options] - (if (fn? ?props) - (-into-schema (-collection-schema (?props properties children)) properties children options) - (let [{:keys [type parse unparse], fpred :pred, fempty :empty, fin :in :or {fin (fn [i _] i)}} ?props] - (reset! props* ?props) - (-check-children! type properties children 1 1) - (let [[schema :as children] (-vmap #(schema % options) children) - form (delay (-simple-form parent properties children -form options)) - cache (-create-cache options) - validate-limits (-validate-limits min max) - ->parser (fn [f g] (let [child-parser (f schema)] - (fn [x] - (cond - (not (fpred x)) ::invalid - (not (validate-limits x)) ::invalid - :else (let [x' (reduce - (fn [acc v] - (let [v' (child-parser v)] - (if (miu/-invalid? v') (reduced ::invalid) (conj acc v')))) - [] x)] - (cond - (miu/-invalid? x') x' - g (g x') - fempty (into fempty x') - :else x'))))))] - ^{:type ::schema} - (reify - AST - (-to-ast [this _] (-to-child-ast this)) - Schema - (-validator [_] - (let [validator (-validator schema)] - (fn [x] (and (fpred x) - (validate-limits x) - (reduce (fn [acc v] (if (validator v) acc (reduced false))) true x))))) - (-explainer [this path] - (let [explainer (-explainer schema (conj path 0))] - (fn [x in acc] - (cond - (not (fpred x)) (conj acc (miu/-error path in this x ::invalid-type)) - (not (validate-limits x)) (conj acc (miu/-error path in this x ::limits)) - :else (let [size (count x)] - (loop [acc acc, i 0, [x & xs] x] - (if (< i size) - (cond-> (or (explainer x (conj in (fin i x)) acc) acc) xs (recur (inc i) xs)) - acc))))))) - (-parser [_] (->parser -parser parse)) - (-unparser [_] (->parser -unparser unparse)) - (-transformer [this transformer method options] - (let [collection? #(or (sequential? %) (set? %)) - this-transformer (-value-transformer transformer this method options) - child-transformer (-transformer schema transformer method options) - ->child (when child-transformer - (if fempty - (-collection-transformer child-transformer fempty) - #(-vmap child-transformer %))) - ->child (-guard collection? ->child)] - (-intercepting this-transformer ->child))) - (-walk [this walker path options] - (when (-accept walker this path options) - (-outer walker this path [(-inner walker schema (conj path ::in) options)] options))) - (-properties [_] properties) - (-options [_] options) - (-children [_] children) - (-parent [_] parent) - (-form [_] @form) - Cached - (-cache [_] cache) - LensSchema - (-keep [_] true) - (-get [_ _ _] schema) - (-set [this _ value] (-set-children this [value])))))))))) +(defn -collection-schema [props] + (when (fn? props) (-deprecated! "-collection-schema doesn't take fn-props, use :compiled property instead")) + ^{:type ::into-schema} + (reify + AST + (-from-ast [parent ast options] (-from-child-ast parent ast options)) + IntoSchema + (-type [_] (:type props)) + (-type-properties [_] (:type-properties props)) + (-properties-schema [_ _]) + (-children-schema [_ _]) + (-into-schema [parent {:keys [min max] :as properties} children options] + (if-let [compile (:compile props)] + (-into-schema (-collection-schema (merge (dissoc props :compile) (compile properties children options))) properties children options) + (let [{:keys [type parse unparse], fpred :pred, fempty :empty, fin :in :or {fin (fn [i _] i)}} props] + (-check-children! type properties children 1 1) + (let [[schema :as children] (-vmap #(schema % options) children) + form (delay (-simple-form parent properties children -form options)) + cache (-create-cache options) + validate-limits (-validate-limits min max) + ->parser (fn [f g] (let [child-parser (f schema)] + (fn [x] + (cond + (not (fpred x)) ::invalid + (not (validate-limits x)) ::invalid + :else (let [x' (reduce + (fn [acc v] + (let [v' (child-parser v)] + (if (miu/-invalid? v') (reduced ::invalid) (conj acc v')))) + [] x)] + (cond + (miu/-invalid? x') x' + g (g x') + fempty (into fempty x') + :else x'))))))] + ^{:type ::schema} + (reify + AST + (-to-ast [this _] (-to-child-ast this)) + Schema + (-validator [_] + (let [validator (-validator schema)] + (fn [x] (and (fpred x) + (validate-limits x) + (reduce (fn [acc v] (if (validator v) acc (reduced false))) true x))))) + (-explainer [this path] + (let [explainer (-explainer schema (conj path 0))] + (fn [x in acc] + (cond + (not (fpred x)) (conj acc (miu/-error path in this x ::invalid-type)) + (not (validate-limits x)) (conj acc (miu/-error path in this x ::limits)) + :else (let [size (count x)] + (loop [acc acc, i 0, [x & xs] x] + (if (< i size) + (cond-> (or (explainer x (conj in (fin i x)) acc) acc) xs (recur (inc i) xs)) + acc))))))) + (-parser [_] (->parser -parser parse)) + (-unparser [_] (->parser -unparser unparse)) + (-transformer [this transformer method options] + (let [collection? #(or (sequential? %) (set? %)) + this-transformer (-value-transformer transformer this method options) + child-transformer (-transformer schema transformer method options) + ->child (when child-transformer + (if fempty + (-collection-transformer child-transformer fempty) + #(-vmap child-transformer %))) + ->child (-guard collection? ->child)] + (-intercepting this-transformer ->child))) + (-walk [this walker path options] + (when (-accept walker this path options) + (-outer walker this path [(-inner walker schema (conj path ::in) options)] options))) + (-properties [_] properties) + (-options [_] options) + (-children [_] children) + (-parent [_] parent) + (-form [_] @form) + Cached + (-cache [_] cache) + LensSchema + (-keep [_] true) + (-get [_ _ _] schema) + (-set [this _ value] (-set-children this [value]))))))))) (defn -tuple-schema ([] diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 35ddf5cb1..84f8929eb 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -2541,16 +2541,17 @@ (deftest custom-collection-test (let [List (m/-collection-schema - (fn [properties [child]] - {:type :list - :pred list? - :empty '() - :type-properties {:error/message "should be a list" - :gen/schema [:vector properties child] - :gen/fmap #(or (list* %) '())}}))] - + {:type :list + :compile (fn [properties [child] _options] + {:pred list? + :empty '() + :type-properties {:error/message "should be a list" + :gen/schema [:vector properties child] + :gen/fmap #(or (list* %) '())}})})] (is (m/validate [List :int] '(1 2))) - (is (not (m/validate [List :int] [1 2]))))) + (is (not (m/validate [List :int] [1 2]))) + (is (= :list (m/-type List))) + (is (= :list (m/type [List :int]))))) (defn function-schema-registry-test-fn []) From 6f5014f4729d71ebc23fd839cb873cd7d0b6e9bd Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Fri, 10 Mar 2023 09:25:58 +0200 Subject: [PATCH 35/86] add missing type-hint for :schema --- src/malli/core.cljc | 1 + 1 file changed, 1 insertion(+) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 06c3dcaf2..ff3f7fecf 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -1636,6 +1636,7 @@ ^{:type ::into-schema} (let [internal (or id raw) type (if internal ::schema :schema)] + ^{:type ::into-schema} (reify AST (-from-ast [parent ast options] ((if internal -from-value-ast -from-child-ast) parent ast options)) From 3a8341b4421c7723c01be9223eb98edb8939ec3a Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Mon, 13 Mar 2023 10:05:14 +0200 Subject: [PATCH 36/86] allow old style with DEPRECATED message --- CHANGELOG.md | 4 + src/malli/core.cljc | 259 ++++++++++++++++++++++---------------------- 2 files changed, 136 insertions(+), 127 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index be6d15d6f..67ff0aa08 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,10 @@ We use [Break Versioning][breakver]. The version numbers follow a `. props`. Old 2-arity top-level callback function is `m/deprecated!` and support for it will be removed in future versions. [#866](https://github.com/metosin/malli/pull/866) + ## 0.10.2 (2023-03-05) * Implement `malli.experimental.time` schemas for clojurescript using js-joda [#853](https://github.com/metosin/malli/pull/853) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index ff3f7fecf..d205539ac 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -621,52 +621,55 @@ (defn -simple-schema [props] (let [{:keys [type type-properties pred property-pred min max from-ast to-ast compile] :or {min 0, max 0, from-ast -from-value-ast, to-ast -to-type-ast}} props] - (when (fn? props) (-deprecated! "-simple-schema doesn't take fn-props, use :compiled property instead")) - ^{:type ::into-schema} - (reify - AST - (-from-ast [parent ast options] (from-ast parent ast options)) - IntoSchema - (-type [_] type) - (-type-properties [_] type-properties) - (-properties-schema [_ _]) - (-children-schema [_ _]) - (-into-schema [parent properties children options] - (if compile - (-into-schema (-simple-schema (merge (dissoc props :compile) (compile properties children options))) properties children options) - (let [form (delay (-simple-form parent properties children identity options)) - cache (-create-cache options)] - (-check-children! type properties children min max) - ^{:type ::schema} - (reify - AST - (-to-ast [this _] (to-ast this)) - Schema - (-validator [_] - (if-let [pvalidator (when property-pred (property-pred properties))] - (fn [x] (and (pred x) (pvalidator x))) pred)) - (-explainer [this path] - (let [validator (-validator this)] - (fn explain [x in acc] - (if-not (validator x) (conj acc (miu/-error path in this x)) acc)))) - (-parser [this] - (let [validator (-validator this)] - (fn [x] (if (validator x) x ::invalid)))) - (-unparser [this] (-parser this)) - (-transformer [this transformer method options] - (-intercepting (-value-transformer transformer this method options))) - (-walk [this walker path options] (-walk-leaf this walker path options)) - (-properties [_] properties) - (-options [_] options) - (-children [_] children) - (-parent [_] parent) - (-form [_] @form) - Cached - (-cache [_] cache) - LensSchema - (-keep [_]) - (-get [_ _ default] default) - (-set [this key _] (-fail! ::non-associative-schema {:schema this, :key key}))))))))) + (if (fn? props) + (do + (-deprecated! "-simple-schema doesn't take fn-props, use :compiled property instead") + (-simple-schema {:compile (fn [c p _] (props c p))})) + ^{:type ::into-schema} + (reify + AST + (-from-ast [parent ast options] (from-ast parent ast options)) + IntoSchema + (-type [_] type) + (-type-properties [_] type-properties) + (-properties-schema [_ _]) + (-children-schema [_ _]) + (-into-schema [parent properties children options] + (if compile + (-into-schema (-simple-schema (merge (dissoc props :compile) (compile properties children options))) properties children options) + (let [form (delay (-simple-form parent properties children identity options)) + cache (-create-cache options)] + (-check-children! type properties children min max) + ^{:type ::schema} + (reify + AST + (-to-ast [this _] (to-ast this)) + Schema + (-validator [_] + (if-let [pvalidator (when property-pred (property-pred properties))] + (fn [x] (and (pred x) (pvalidator x))) pred)) + (-explainer [this path] + (let [validator (-validator this)] + (fn explain [x in acc] + (if-not (validator x) (conj acc (miu/-error path in this x)) acc)))) + (-parser [this] + (let [validator (-validator this)] + (fn [x] (if (validator x) x ::invalid)))) + (-unparser [this] (-parser this)) + (-transformer [this transformer method options] + (-intercepting (-value-transformer transformer this method options))) + (-walk [this walker path options] (-walk-leaf this walker path options)) + (-properties [_] properties) + (-options [_] options) + (-children [_] children) + (-parent [_] parent) + (-form [_] @form) + Cached + (-cache [_] cache) + LensSchema + (-keep [_]) + (-get [_ _ default] default) + (-set [this key _] (-fail! ::non-associative-schema {:schema this, :key key})))))))))) (defn -nil-schema [] (-simple-schema {:type :nil, :pred nil?})) (defn -any-schema [] (-simple-schema {:type :any, :pred any?})) @@ -1150,87 +1153,89 @@ (-set [this key value] (-set-assoc-children this key value)))))))) (defn -collection-schema [props] - (when (fn? props) (-deprecated! "-collection-schema doesn't take fn-props, use :compiled property instead")) - ^{:type ::into-schema} - (reify - AST - (-from-ast [parent ast options] (-from-child-ast parent ast options)) - IntoSchema - (-type [_] (:type props)) - (-type-properties [_] (:type-properties props)) - (-properties-schema [_ _]) - (-children-schema [_ _]) - (-into-schema [parent {:keys [min max] :as properties} children options] - (if-let [compile (:compile props)] - (-into-schema (-collection-schema (merge (dissoc props :compile) (compile properties children options))) properties children options) - (let [{:keys [type parse unparse], fpred :pred, fempty :empty, fin :in :or {fin (fn [i _] i)}} props] - (-check-children! type properties children 1 1) - (let [[schema :as children] (-vmap #(schema % options) children) - form (delay (-simple-form parent properties children -form options)) - cache (-create-cache options) - validate-limits (-validate-limits min max) - ->parser (fn [f g] (let [child-parser (f schema)] - (fn [x] - (cond - (not (fpred x)) ::invalid - (not (validate-limits x)) ::invalid - :else (let [x' (reduce - (fn [acc v] - (let [v' (child-parser v)] - (if (miu/-invalid? v') (reduced ::invalid) (conj acc v')))) - [] x)] - (cond - (miu/-invalid? x') x' - g (g x') - fempty (into fempty x') - :else x'))))))] - ^{:type ::schema} - (reify - AST - (-to-ast [this _] (-to-child-ast this)) - Schema - (-validator [_] - (let [validator (-validator schema)] - (fn [x] (and (fpred x) - (validate-limits x) - (reduce (fn [acc v] (if (validator v) acc (reduced false))) true x))))) - (-explainer [this path] - (let [explainer (-explainer schema (conj path 0))] - (fn [x in acc] - (cond - (not (fpred x)) (conj acc (miu/-error path in this x ::invalid-type)) - (not (validate-limits x)) (conj acc (miu/-error path in this x ::limits)) - :else (let [size (count x)] - (loop [acc acc, i 0, [x & xs] x] - (if (< i size) - (cond-> (or (explainer x (conj in (fin i x)) acc) acc) xs (recur (inc i) xs)) - acc))))))) - (-parser [_] (->parser -parser parse)) - (-unparser [_] (->parser -unparser unparse)) - (-transformer [this transformer method options] - (let [collection? #(or (sequential? %) (set? %)) - this-transformer (-value-transformer transformer this method options) - child-transformer (-transformer schema transformer method options) - ->child (when child-transformer - (if fempty - (-collection-transformer child-transformer fempty) - #(-vmap child-transformer %))) - ->child (-guard collection? ->child)] - (-intercepting this-transformer ->child))) - (-walk [this walker path options] - (when (-accept walker this path options) - (-outer walker this path [(-inner walker schema (conj path ::in) options)] options))) - (-properties [_] properties) - (-options [_] options) - (-children [_] children) - (-parent [_] parent) - (-form [_] @form) - Cached - (-cache [_] cache) - LensSchema - (-keep [_] true) - (-get [_ _ _] schema) - (-set [this _ value] (-set-children this [value]))))))))) + (if (fn? props) + (do (-deprecated! "-collection-schema doesn't take fn-props, use :compiled property instead") + (-collection-schema {:compile (fn [c p _] (props c p))})) + ^{:type ::into-schema} + (reify + AST + (-from-ast [parent ast options] (-from-child-ast parent ast options)) + IntoSchema + (-type [_] (:type props)) + (-type-properties [_] (:type-properties props)) + (-properties-schema [_ _]) + (-children-schema [_ _]) + (-into-schema [parent {:keys [min max] :as properties} children options] + (if-let [compile (:compile props)] + (-into-schema (-collection-schema (merge (dissoc props :compile) (compile properties children options))) properties children options) + (let [{:keys [type parse unparse], fpred :pred, fempty :empty, fin :in :or {fin (fn [i _] i)}} props] + (-check-children! type properties children 1 1) + (let [[schema :as children] (-vmap #(schema % options) children) + form (delay (-simple-form parent properties children -form options)) + cache (-create-cache options) + validate-limits (-validate-limits min max) + ->parser (fn [f g] (let [child-parser (f schema)] + (fn [x] + (cond + (not (fpred x)) ::invalid + (not (validate-limits x)) ::invalid + :else (let [x' (reduce + (fn [acc v] + (let [v' (child-parser v)] + (if (miu/-invalid? v') (reduced ::invalid) (conj acc v')))) + [] x)] + (cond + (miu/-invalid? x') x' + g (g x') + fempty (into fempty x') + :else x'))))))] + ^{:type ::schema} + (reify + AST + (-to-ast [this _] (-to-child-ast this)) + Schema + (-validator [_] + (let [validator (-validator schema)] + (fn [x] (and (fpred x) + (validate-limits x) + (reduce (fn [acc v] (if (validator v) acc (reduced false))) true x))))) + (-explainer [this path] + (let [explainer (-explainer schema (conj path 0))] + (fn [x in acc] + (cond + (not (fpred x)) (conj acc (miu/-error path in this x ::invalid-type)) + (not (validate-limits x)) (conj acc (miu/-error path in this x ::limits)) + :else (let [size (count x)] + (loop [acc acc, i 0, [x & xs] x] + (if (< i size) + (cond-> (or (explainer x (conj in (fin i x)) acc) acc) xs (recur (inc i) xs)) + acc))))))) + (-parser [_] (->parser -parser parse)) + (-unparser [_] (->parser -unparser unparse)) + (-transformer [this transformer method options] + (let [collection? #(or (sequential? %) (set? %)) + this-transformer (-value-transformer transformer this method options) + child-transformer (-transformer schema transformer method options) + ->child (when child-transformer + (if fempty + (-collection-transformer child-transformer fempty) + #(-vmap child-transformer %))) + ->child (-guard collection? ->child)] + (-intercepting this-transformer ->child))) + (-walk [this walker path options] + (when (-accept walker this path options) + (-outer walker this path [(-inner walker schema (conj path ::in) options)] options))) + (-properties [_] properties) + (-options [_] options) + (-children [_] children) + (-parent [_] parent) + (-form [_] @form) + Cached + (-cache [_] cache) + LensSchema + (-keep [_] true) + (-get [_ _ _] schema) + (-set [this _ value] (-set-children this [value])))))))))) (defn -tuple-schema ([] From 6c62326d83e0cea03de98b5f9486687af99a505c Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Mon, 13 Mar 2023 10:05:52 +0200 Subject: [PATCH 37/86] format --- test/malli/experimental/always_test.cljc | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/test/malli/experimental/always_test.cljc b/test/malli/experimental/always_test.cljc index 800f9c0cd..0e9bf773a 100644 --- a/test/malli/experimental/always_test.cljc +++ b/test/malli/experimental/always_test.cljc @@ -1,7 +1,8 @@ (ns malli.experimental.always-test + (:refer-clojure :exclude [destructure]) (:require [clojure.test :refer [deftest testing is]] [malli.experimental :as mx]) - #?(:clj(:require [malli.dev]))) + #?(:clj (:require [malli.dev]))) (mx/defn ^:malli/always addition :- [:int {:min 0}] [x :- [:int {:min 0}], y :- :int] @@ -69,10 +70,10 @@ {:foo 4 :bar 5})) "valid input works") (is (= :malli.core/invalid-input - (try (destructure [1 {:a 2 :b 3}] - {:foo 4 :bar 5}) - (catch #?(:clj Exception :cljs js/Error) e - (:type (ex-data e))))) + (try (destructure [1 {:a 2 :b 3}] + {:foo 4 :bar 5}) + (catch #?(:clj Exception :cljs js/Error) e + (:type (ex-data e))))) "invalid input throws") (is (= :malli.core/invalid-input (try (destructure [1 {:a "foo" :b 3}] From f303d3d93f1f22a0c48ea79e3e9491bb5c8c7aae Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Mon, 13 Mar 2023 10:25:28 +0200 Subject: [PATCH 38/86] README --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index a7b157fd0..3edea7b7c 100644 --- a/README.md +++ b/README.md @@ -2304,7 +2304,7 @@ You can also build content-dependent schemas by using a callback function `:comp ```clojure (def Between (m/-simple-schema - {:type :user/between + {:type `Between :compile (fn [_properties [min max] _options] (when-not (and (int? min) (int? max)) (m/-fail! ::invalid-children {:min min, :max max})) @@ -2320,7 +2320,7 @@ You can also build content-dependent schemas by using a callback function `:comp :gen/gen (gen/large-integer* {:min (inc min), :max max})}})})) (m/form [Between 10 20]) -; => [:user/between 10 20] +; => [user/Between 10 20] (-> [Between 10 20] (m/explain 8) From 7e823e18396432a6c1bf9eeacd06ff00b65f015b Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Tue, 14 Mar 2023 10:56:41 +0100 Subject: [PATCH 39/86] Fix inconsistencies on UUID transform helper Now it works correctly and with same behavior on cljs and clj. --- src/malli/transform.cljc | 14 +++++++------- test/malli/transform_test.cljc | 12 +++++++++--- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/src/malli/transform.cljc b/src/malli/transform.cljc index 6fcbf5008..29997469c 100644 --- a/src/malli/transform.cljc +++ b/src/malli/transform.cljc @@ -89,15 +89,15 @@ :else x) x)) +(def ^:private uuid-re + #"^[0-9a-f]{8}-[0-9a-f]{4}-[1-8][0-9a-f]{3}-[89ab][0-9a-f]{3}-[0-9a-f]{12}$") + (defn -string->uuid [x] (if (string? x) - (try - #?(:clj (UUID/fromString x) - ;; http://stackoverflow.com/questions/7905929/how-to-test-valid-uuid-guid - :cljs (if (re-find #"^[0-9a-f]{8}-[0-9a-f]{4}-[1-8][0-9a-f]{3}-[89ab][0-9a-f]{3}-[0-9a-f]{12}$" x) - (uuid x) - x)) - (catch #?(:clj Exception, :cljs js/Error) _ x)) + (if-let [x (re-matches uuid-re x)] + #?(:clj (UUID/fromString x) + :cljs (uuid x)) + x) x)) #?(:clj diff --git a/test/malli/transform_test.cljc b/test/malli/transform_test.cljc index cc32431c8..cd21e83d7 100644 --- a/test/malli/transform_test.cljc +++ b/test/malli/transform_test.cljc @@ -52,9 +52,15 @@ (is (= "abba" (mt/-string->boolean "abba")))) (deftest string->uuid - (is (= #uuid"5f60751d-9bf7-4344-97ee-48643c9949ce" (mt/-string->uuid "5f60751d-9bf7-4344-97ee-48643c9949ce"))) - (is (= #uuid"5f60751d-9bf7-4344-97ee-48643c9949ce" (mt/-string->uuid #uuid"5f60751d-9bf7-4344-97ee-48643c9949ce"))) - (is (= "abba" (mt/-string->uuid "abba")))) + (is (= #uuid "5f60751d-9bf7-4344-97ee-48643c9949ce" (mt/-string->uuid "5f60751d-9bf7-4344-97ee-48643c9949ce"))) + (is (= #uuid "5f60751d-9bf7-4344-97ee-48643c9949ce" (mt/-string->uuid #uuid"5f60751d-9bf7-4344-97ee-48643c9949ce"))) + (is (= "abba" (mt/-string->uuid "abba"))) + + ;; Regression tests: we should ensure that invalid or incomplete + ;; uuids are handled unformly in CLJ and CLJS + (is (= "5f60751d-9bf7-4344-97ee-48643c" (mt/-string->uuid "5f60751d-9bf7-4344-97ee-48643c"))) + (is (= "1-1-1-1-1" (mt/-string->uuid "1-1-1-1-1")))) + (deftest string->date (is (= #inst "2018-04-27T18:25:37Z" (mt/-string->date "2018-04-27T18:25:37Z"))) From d2e14f1a44618d9c5bb37c915a51b524647efe37 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Tue, 14 Mar 2023 11:08:48 +0100 Subject: [PATCH 40/86] Add helper script for start a REPL with rebel-readline Makes running individual tests easily with the help of tools.namespace for namespace reloading. --- bin/repl | 3 +++ deps.edn | 6 ++++++ dev/user.clj | 37 +++++++++++++++++++++++++++++++++++++ 3 files changed, 46 insertions(+) create mode 100755 bin/repl create mode 100644 dev/user.clj diff --git a/bin/repl b/bin/repl new file mode 100755 index 000000000..23a963133 --- /dev/null +++ b/bin/repl @@ -0,0 +1,3 @@ +#!/usr/bin/env bash +set -ex +clojure -M:shadow:rebel:test -m rebel-readline.main diff --git a/deps.edn b/deps.edn index e13550251..b7e97b1a0 100644 --- a/deps.edn +++ b/deps.edn @@ -37,6 +37,12 @@ :deps {jmh-clojure/jmh-clojure {:mvn/version "0.4.1"} jmh-clojure/task {:mvn/version "0.1.1"}} :main-opts ["-m" "jmh.main"]} + + :rebel + {:extra-paths ["dev"] + :extra-deps {com.bhauman/rebel-readline {:mvn/version "RELEASE"} + org.clojure/tools.namespace {:mvn/version "RELEASE"}}} + :shadow {:extra-paths ["app"] :extra-deps {thheller/shadow-cljs {:mvn/version "2.21.0"} binaryage/devtools {:mvn/version "1.0.6"}}} diff --git a/dev/user.clj b/dev/user.clj new file mode 100644 index 000000000..e4933c9b1 --- /dev/null +++ b/dev/user.clj @@ -0,0 +1,37 @@ +(ns user + (:require + [clojure.pprint :refer [pprint]] + [clojure.test :as test] + [clojure.tools.namespace.repl :as r] + [clojure.walk :refer [macroexpand-all]])) + +(r/set-refresh-dirs "src/malli" "dev" "test/malli") + +(defn- run-test + ([] (run-test #"^malli.*test$")) + ([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))))) + +(comment + ;; Refresh changed namespaces + (r/refresh) + + ;; Run all tests + (run-test) + + ;; Run all transform tests + (run-test 'malli.transform-test) + + ;; Run a specific test case of transform tests + (run-test 'malli.transform-test/string->uuid) + + ) From fb0a174967812b0050f9658de332b008849a0e0b Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Fri, 17 Mar 2023 09:49:42 +0200 Subject: [PATCH 41/86] cleanup / deloc --- src/malli/json_schema.cljc | 10 +--- src/malli/transform.cljc | 92 ++++++++++++++-------------------- test/malli/transform_test.cljc | 16 +++--- 3 files changed, 48 insertions(+), 70 deletions(-) diff --git a/src/malli/json_schema.cljc b/src/malli/json_schema.cljc index 9011500c2..7914b6fe4 100644 --- a/src/malli/json_schema.cljc +++ b/src/malli/json_schema.cljc @@ -93,14 +93,8 @@ (defmethod accept :multi [_ _ children _] {:oneOf (mapv last children)}) -(defn- minmax-properties - [m schema kmin kmax] - (merge - m - (-> schema - m/properties - (select-keys [:min :max]) - (set/rename-keys {:min kmin, :max kmax})))) +(defn- minmax-properties [m schema kmin kmax] + (merge m (-> schema (m/properties) (select-keys [:min :max]) (set/rename-keys {:min kmin, :max kmax})))) (defmethod accept :map-of [_ schema children _] (minmax-properties diff --git a/src/malli/transform.cljc b/src/malli/transform.cljc index 29997469c..ffe6c3d2a 100644 --- a/src/malli/transform.cljc +++ b/src/malli/transform.cljc @@ -56,23 +56,21 @@ (defn -string->long [x] (if (string? x) - (try - #?(:clj (Long/parseLong x) - :cljs (let [x' (if (re-find #"\D" (subs x 1)) ##NaN (js/parseInt x 10))] - (cond - (js/isNaN x') x - (> x' js/Number.MAX_SAFE_INTEGER) x - (< x' js/Number.MIN_SAFE_INTEGER) x - :else x'))) - (catch #?(:clj Exception, :cljs js/Error) _ x)) + (try #?(:clj (Long/parseLong x) + :cljs (let [x' (if (re-find #"\D" (subs x 1)) ##NaN (js/parseInt x 10))] + (cond + (js/isNaN x') x + (> x' js/Number.MAX_SAFE_INTEGER) x + (< x' js/Number.MIN_SAFE_INTEGER) x + :else x'))) + (catch #?(:clj Exception, :cljs js/Error) _ x)) x)) (defn -string->double [x] (if (string? x) - (try - #?(:clj (Double/parseDouble x) - :cljs (let [x' (js/parseFloat x)] (if (js/isNaN x') x x'))) - (catch #?(:clj Exception, :cljs js/Error) _ x)) + (try #?(:clj (Double/parseDouble x) + :cljs (let [x' (js/parseFloat x)] (if (js/isNaN x') x x'))) + (catch #?(:clj Exception, :cljs js/Error) _ x)) x)) (defn -number->double [x] @@ -83,10 +81,9 @@ (defn -string->boolean [x] (if (string? x) - (cond - (= "true" x) true - (= "false" x) false - :else x) + (cond (= "true" x) true + (= "false" x) false + :else x) x)) (def ^:private uuid-re @@ -119,18 +116,16 @@ (defn -string->date [x] (if (string? x) - (try - #?(:clj (Date/from (Instant/from (.parse +string->date-format+ x))) - :cljs (js/Date. (.getTime (goog.date.UtcDateTime/fromIsoString x)))) - (catch #?(:clj Exception, :cljs js/Error) _ x)) + (try #?(:clj (Date/from (Instant/from (.parse +string->date-format+ x))) + :cljs (js/Date. (.getTime (goog.date.UtcDateTime/fromIsoString x)))) + (catch #?(:clj Exception, :cljs js/Error) _ x)) x)) #?(:clj (defn -string->decimal [x] (if (string? x) - (try - (BigDecimal. ^String x) - (catch Exception _ x)) + (try (BigDecimal. ^String x) + (catch Exception _ x)) x))) (defn -string->symbol [x] @@ -155,10 +150,9 @@ (defn -date->string [x] (if (inst? x) - (try - #?(:clj (.format +date->string-format+ (Instant/ofEpochMilli (inst-ms x))) - :cljs (.toISOString x)) - (catch #?(:clj Exception, :cljs js/Error) _ x)) + (try #?(:clj (.format +date->string-format+ (Instant/ofEpochMilli (inst-ms x))) + :cljs (.toISOString x)) + (catch #?(:clj Exception, :cljs js/Error) _ x)) x)) (defn -transform-map-keys [f] @@ -166,44 +160,36 @@ (defn -transform-if-valid [f schema] (let [validator (m/-validator schema)] - (fn [x] - (let [out (f x)] - (if (validator out) - out - x))))) + (fn [x] (let [out (f x)] (if (validator out) out x))))) ;; ;; sequential ;; (defn -sequential->set [x] - (cond - (set? x) x - (sequential? x) (set x) - :else x)) + (cond (set? x) x + (sequential? x) (set x) + :else x)) (defn -sequential->vector [x] - (cond - (vector? x) x - (sequential? x) (vec x) - :else x)) + (cond (vector? x) x + (sequential? x) (vec x) + :else x)) ;; ;; sequential or set ;; (defn -sequential-or-set->vector [x] - (cond - (vector? x) x - (set? x) (vec x) - (sequential? x) (vec x) - :else x)) + (cond (vector? x) x + (set? x) (vec x) + (sequential? x) (vec x) + :else x)) (defn -sequential-or-set->seq [x] - (cond - (vector? x) (seq x) - (set? x) (seq x) - :else x)) + (cond (vector? x) (seq x) + (set? x) (seq x) + :else x)) (defn -infer-child-decoder-compiler [schema _] (-> schema (m/children) (m/-infer) {:keyword -string->keyword @@ -355,8 +341,7 @@ acc))) nil chain')))))) (defn json-transformer - ([] - (json-transformer nil)) + ([] (json-transformer nil)) ([{::keys [json-vectors map-of-key-decoders] :or {map-of-key-decoders (-string-decoders)}}] (transformer {:name :json @@ -403,8 +388,7 @@ :default-encoder (transform encode :leave)})))) (defn default-value-transformer - ([] - (default-value-transformer nil)) + ([] (default-value-transformer nil)) ([{:keys [key default-fn defaults ::add-optional-keys] :or {key :default, default-fn (fn [_ x] x)}}] (let [get-default (fn [schema] (if-some [e (some-> schema m/properties (find key))] diff --git a/test/malli/transform_test.cljc b/test/malli/transform_test.cljc index cd21e83d7..3fe2a4a2a 100644 --- a/test/malli/transform_test.cljc +++ b/test/malli/transform_test.cljc @@ -58,8 +58,8 @@ ;; Regression tests: we should ensure that invalid or incomplete ;; uuids are handled unformly in CLJ and CLJS - (is (= "5f60751d-9bf7-4344-97ee-48643c" (mt/-string->uuid "5f60751d-9bf7-4344-97ee-48643c"))) - (is (= "1-1-1-1-1" (mt/-string->uuid "1-1-1-1-1")))) + (is (= "5f60751d-9bf7-4344-97ee-48643c" (mt/-string->uuid "5f60751d-9bf7-4344-97ee-48643c"))) + (is (= "1-1-1-1-1" (mt/-string->uuid "1-1-1-1-1")))) (deftest string->date @@ -433,12 +433,12 @@ (testing "extra-keys-transformer shouldn't break non map values" (is (= {:foo "bar"} (m/decode - [:map {:decode/string (fn [s] {:foo s})} - [:foo :string]] - "bar" - (mt/transformer - (mt/strip-extra-keys-transformer) - (mt/string-transformer))))))) + [:map {:decode/string (fn [s] {:foo s})} + [:foo :string]] + "bar" + (mt/transformer + (mt/strip-extra-keys-transformer) + (mt/string-transformer))))))) (deftest strip-extra-keys-transformer-test (let [strip-default (mt/strip-extra-keys-transformer) From f72e6925d93dfc28041f2c063887ea7c43ce2229 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Wed, 15 Mar 2023 12:23:08 +0200 Subject: [PATCH 42/86] validator & explain --- src/malli/core.cljc | 37 ++++++++++++++++++++++++++----------- 1 file changed, 26 insertions(+), 11 deletions(-) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index d205539ac..5e43b3ade 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -492,6 +492,8 @@ (or (:lazy props) (::lazy-entries options)) (-lazy-entry-parser ?children props options) :else (-eager-entry-parser ?children props options))) +(defn -default-entry [e] (-equals (nth e 0) ::default)) + ;; ;; transformers ;; @@ -991,7 +993,9 @@ (reduce (fn [m k] (if (contains? keyset k) m (reduced (reduced ::invalid)))) m (keys m)))))] - (fn [x] (if (pred? x) (reduce (fn [m parser] (parser m)) x parsers) ::invalid))))] + (fn [x] (if (pred? x) (reduce (fn [m parser] (parser m)) x parsers) ::invalid)))) + default-schema (delay (some-> entry-parser (-entry-entries) (->> (into {})) ::default (schema options))) + explicit-children (delay (cond->> (-entry-children entry-parser) @default-schema (remove -default-entry)))] ^{:type ::schema} (reify AST @@ -999,6 +1003,7 @@ Schema (-validator [this] (let [keyset (-entry-keyset (-entry-parser this)) + default-validator (some-> @default-schema (-validator)) validators (cond-> (-vmap (fn [[key {:keys [optional]} value]] (let [valid? (-validator value) @@ -1006,12 +1011,16 @@ #?(:bb (fn [m] (if-let [map-entry (find m key)] (valid? (val map-entry)) default)) :clj (fn [^Associative m] (if-let [map-entry (.entryAt m key)] (valid? (.val map-entry)) default)) :cljs (fn [m] (if-let [map-entry (find m key)] (valid? (val map-entry)) default))))) - (-children this)) - closed (conj (fn [m] (reduce (fn [acc k] (if (contains? keyset k) acc (reduced false))) true (keys m))))) + @explicit-children) + default-validator + (conj (fn [m] (default-validator (reduce (fn [acc k] (dissoc acc k)) m (keys keyset))))) + (and closed (not default-validator)) + (conj (fn [m] (reduce (fn [acc k] (if (contains? keyset k) acc (reduced false))) true (keys m))))) validate (miu/-every-pred validators)] (fn [m] (and (pred? m) (validate m))))) (-explainer [this path] (let [keyset (-entry-keyset (-entry-parser this)) + default-explainer (some-> @default-schema (-explainer (conj path ::default))) explainers (cond-> (-vmap (fn [[key {:keys [optional]} schema]] (let [explainer (-explainer schema (conj path key))] @@ -1021,14 +1030,20 @@ (if-not optional (conj acc (miu/-error (conj path key) (conj in key) this nil ::missing-key)) acc))))) - (-children this)) - closed (conj (fn [x in acc] - (reduce-kv - (fn [acc k v] - (if (contains? keyset k) - acc - (conj acc (miu/-error (conj path k) (conj in k) this v ::extra-key)))) - acc x))))] + @explicit-children) + default-explainer + (conj (fn [x in acc] + (default-explainer + (reduce (fn [acc k] (dissoc acc k)) x (keys keyset)) + in acc))) + (and closed not default-explainer) + (conj (fn [x in acc] + (reduce-kv + (fn [acc k v] + (if (contains? keyset k) + acc + (conj acc (miu/-error (conj path k) (conj in k) this v ::extra-key)))) + acc x))))] (fn [x in acc] (if-not (pred? x) (conj acc (miu/-error path in this x ::invalid-type)) From a782abef89950f9ea2add49a8b1393f54730ffed Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Wed, 15 Mar 2023 17:36:54 +0200 Subject: [PATCH 43/86] transform + test, WIP --- src/malli/core.cljc | 12 +++-- src/malli/transform.cljc | 2 +- test/malli/core_test.cljc | 109 +++++++++++++++++++++++++++++++++++++- 3 files changed, 118 insertions(+), 5 deletions(-) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 5e43b3ade..de2ddb656 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -493,6 +493,7 @@ :else (-eager-entry-parser ?children props options))) (defn -default-entry [e] (-equals (nth e 0) ::default)) +(defn -default-entry-schema [children] (some (fn [e] (when (-default-entry e) (nth e 2))) children)) ;; ;; transformers @@ -994,7 +995,7 @@ (fn [m k] (if (contains? keyset k) m (reduced (reduced ::invalid)))) m (keys m)))))] (fn [x] (if (pred? x) (reduce (fn [m parser] (parser m)) x parsers) ::invalid)))) - default-schema (delay (some-> entry-parser (-entry-entries) (->> (into {})) ::default (schema options))) + default-schema (delay (some-> entry-parser (-entry-children) (-default-entry-schema) (schema options))) explicit-children (delay (cond->> (-entry-children entry-parser) @default-schema (remove -default-entry)))] ^{:type ::schema} (reify @@ -1054,11 +1055,16 @@ (-parser [this] (->parser this -parser)) (-unparser [this] (->parser this -unparser)) (-transformer [this transformer method options] - (let [this-transformer (-value-transformer transformer this method options) + (let [keyset (-entry-keyset (-entry-parser this)) + this-transformer (-value-transformer transformer this method options) ->children (reduce (fn [acc [k s]] (let [t (-transformer s transformer method options)] - (cond-> acc t (conj [k t])))) [] (-entries this)) + (cond-> acc t (conj [k t])))) + [] (cond->> (-entries this) @default-schema (remove -default-entry))) apply->children (when (seq ->children) (-map-transformer ->children)) + apply->default (when-let [dt (some-> @default-schema (-transformer transformer method options))] + (fn [x] (merge (dt (reduce (fn [acc k] (dissoc acc k)) x (keys keyset))) (select-keys x (keys keyset))))) + apply->children (some->> [apply->default apply->children] (keep identity) (seq) (apply -comp)) apply->children (-guard pred? apply->children)] (-intercepting this-transformer apply->children))) (-walk [this walker path options] (-walk-entries this walker path options)) diff --git a/src/malli/transform.cljc b/src/malli/transform.cljc index ffe6c3d2a..90b1bb2de 100644 --- a/src/malli/transform.cljc +++ b/src/malli/transform.cljc @@ -349,7 +349,7 @@ (assoc :map-of {:compile (fn [schema _] (let [key-schema (some-> schema (m/children) (first))] (or (some-> key-schema (m/type) map-of-key-decoders - (-interceptor schema {}) m/-intercepting + (-interceptor schema {}) (m/-intercepting) (m/-comp m/-keyword->string) (-transform-if-valid key-schema) (-transform-map-keys)) diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 84f8929eb..1a9bfb516 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -888,8 +888,8 @@ [:y {:optional true} int?] [:z {:optional false} string?]]) valid {:x true, :y 1, :z "kikka"} - valid-with-extras {:x true, :y 1, :z "kikka", :extra "key"} valid2 {:x false, :y 1, :z "kikka"} + valid-with-extras {:x true, :y 1, :z "kikka", :extra "key"} invalid {:x true, :y "invalid", :z "kikka", :extra "ok"}] (is (true? (m/validate schema valid))) @@ -2905,3 +2905,110 @@ :value {:x "kikka"}} :schema schema :value {:x "kikka"}}} (as-data ( % name (str "_key") keyword)})))) + + (testing "::m/default transforming doesn't effect defined keys" + (is (= {:id 12 + :name :kikka + "age" 13 + "ABBA" "jabba" + "KIKKA" "kukka"} + (m/decode + [:map + [:id :int] + [:name :keyword] + ["age" :int] + [::m/default [:map-of [:string {:decode/test str/upper-case}] :string]]] + {:id 12, :name :kikka, "age" "13", "abba" "jabba", "kikka" "kukka"} + (mt/transformer + (mt/string-transformer) + (mt/transformer {:name :test})))))) + + (testing "nil-punning tranformers" + (is (= identity + (m/decoder + [:map + [:id :int] + [:name :keyword] + ["age" :int] + [::m/default [:map-of :keyword :keyword]]] + (mt/transformer))))) + + (is (true? (m/validate (over-the-wire schema) valid))) + + (testing "ast" + (is (= {:type :map, + :keys {:x {:order 0 + :value {:type :boolean}}, + :y {:order 1 + :value {:type :int} + :properties {:optional true}}, + :malli.core/default {:order 2 + :value {:type :map-of + :key {:type :int} + :value {:type :int}}}}} + + (m/ast schema))) + (is (true? (m/validate (m/from-ast (m/ast schema)) valid)))) + + (is (= [:map + [:x :boolean] + [:y {:optional true} :int] + [::m/default [:map-of :int :int]]] + (m/form schema))))) From 47bca75c5dbf55684927c5ecb76d85271010ebec Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Wed, 15 Mar 2023 20:47:16 +0200 Subject: [PATCH 44/86] fix tests --- src/malli/core.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index de2ddb656..f7e00af7c 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -1037,7 +1037,7 @@ (default-explainer (reduce (fn [acc k] (dissoc acc k)) x (keys keyset)) in acc))) - (and closed not default-explainer) + (and closed (not default-explainer)) (conj (fn [x in acc] (reduce-kv (fn [acc k v] From d42044f6da02b0fd0e324b32b255ea0d66c9e2d8 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Wed, 15 Mar 2023 21:37:29 +0200 Subject: [PATCH 45/86] parsers & unparsers --- src/malli/core.cljc | 25 +++++++++++++++++-------- test/malli/core_test.cljc | 22 ++++++++++++++-------- 2 files changed, 31 insertions(+), 16 deletions(-) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index f7e00af7c..9922afe71 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -976,8 +976,11 @@ entry-parser (-create-entry-parser children opts options) form (delay (-create-entry-form parent properties entry-parser options)) cache (-create-cache options) + default-schema (delay (some-> entry-parser (-entry-children) (-default-entry-schema) (schema options))) + explicit-children (delay (cond->> (-entry-children entry-parser) @default-schema (remove -default-entry))) ->parser (fn [this f] (let [keyset (-entry-keyset (-entry-parser this)) + default-parser (some-> @default-schema (f)) parsers (cond->> (-vmap (fn [[key {:keys [optional]} schema]] (let [parser (f schema)] @@ -989,14 +992,20 @@ (identical? v* v) m :else (assoc m key v*))) (if optional m (reduced ::invalid)))))) - (-children this)) - closed (cons (fn [m] - (reduce - (fn [m k] (if (contains? keyset k) m (reduced (reduced ::invalid)))) - m (keys m)))))] - (fn [x] (if (pred? x) (reduce (fn [m parser] (parser m)) x parsers) ::invalid)))) - default-schema (delay (some-> entry-parser (-entry-children) (-default-entry-schema) (schema options))) - explicit-children (delay (cond->> (-entry-children entry-parser) @default-schema (remove -default-entry)))] + @explicit-children) + default-parser + (cons (fn [m] + (let [m' (default-parser + (reduce (fn [acc k] (dissoc acc k)) m (keys keyset)))] + (if (miu/-invalid? m') + (reduced m') + (merge (select-keys m (keys keyset)) m'))))) + closed + (cons (fn [m] + (reduce + (fn [m k] (if (contains? keyset k) m (reduced (reduced ::invalid)))) + m (keys m)))))] + (fn [x] (if (pred? x) (reduce (fn [m parser] (parser m)) x parsers) ::invalid))))] ^{:type ::schema} (reify AST diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 1a9bfb516..141056eba 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -2949,14 +2949,20 @@ {:path [::m/default 1], :in ["123"], :schema :int, :value "123"}]} (m/explain schema {:y "invalid", "123" "123"}))) - #_(is (= valid (m/parse schema valid))) - #_(is (= valid2 (m/parse schema valid2))) - #_(is (= ::m/invalid (m/parse schema invalid))) - #_(is (= ::m/invalid (m/parse schema "not-a-map"))) - #_(is (= valid (m/unparse schema valid))) - #_(is (= valid2 (m/unparse schema valid2))) - #_(is (= ::m/invalid (m/unparse schema invalid))) - #_(is (= ::m/invalid (m/unparse schema "not-a-map"))) + (testing "parsing and unparsing" + (let [schema [:map {:registry {'int [:orn ['int :int]] + 'str [:orn ['str :string]]}} + [:id 'int] + ["name" 'str] + [::m/default [:map-of 'str 'str]]] + valid {:id 1, "name" "tommi", "kikka" "kukka", "abba" "jabba"}] + (is (= {:id ['int 1], + "name" ['str "tommi"], + ['str "kikka"] ['str "kukka"] + ['str "abba"] ['str "jabba"]} + (m/parse schema valid))) + (is (= valid (->> valid (m/parse schema) (m/unparse schema)))) + (is (= ::m/invalid (m/parse schema {"kukka" 42}))))) #_(is (= {:x true, :y 1} (m/decode schema {:x true, :y 1, :a 1} mt/strip-extra-keys-transformer))) #_(is (= {:x_key true, :y_key 2} (m/decode schema {:x true, :y 2} From 8815f36cb67668d968475e5acd8e4ebdd469e6dd Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Wed, 15 Mar 2023 21:39:26 +0200 Subject: [PATCH 46/86] reorg tests --- test/malli/core_test.cljc | 80 ++++++++++++++++++++------------------- 1 file changed, 42 insertions(+), 38 deletions(-) diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 141056eba..1d1992c61 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -2916,38 +2916,40 @@ valid2 {:x true, :y 1, 123 123, 456 456} invalid {:x true, :y 1, 123 "123", "456" 456}] - (is (true? (m/validate schema valid))) - (is (true? (m/validate schema valid2))) - (is (false? (m/validate schema invalid))) - (is (false? (m/validate schema "not-a-map"))) - - (is (nil? (m/explain schema valid))) - (is (nil? (m/explain schema valid2))) - - (is (schema= [[:x nil :boolean] - [:y {:optional true} :int] - [::m/default nil [:map-of :int :int]]] - (m/children schema))) - - (is (true? (every? map-entry? (m/entries schema)))) - (is (= [:x :y ::m/default] (map key (m/entries schema)))) - - (is (schema= [[:x [::m/val :boolean]] - [:y [::m/val {:optional true} :int]] - [::m/default [::m/val [:map-of :int :int]]]] - (m/entries schema))) - - (is (results= {:schema schema, - :value {:y "invalid", "123" "123"}, - :errors [{:path [:x], - :in [:x], - :schema schema, - :value nil, - :type :malli.core/missing-key} - {:path [:y], :in [:y], :schema :int, :value "invalid"} - {:path [::m/default 0], :in ["123"], :schema :int, :value "123"} - {:path [::m/default 1], :in ["123"], :schema :int, :value "123"}]} - (m/explain schema {:y "invalid", "123" "123"}))) + (testing "validation" + (is (true? (m/validate schema valid))) + (is (true? (m/validate schema valid2))) + (is (false? (m/validate schema invalid))) + (is (false? (m/validate schema "not-a-map")))) + + (testing "explain" + (is (nil? (m/explain schema valid))) + (is (nil? (m/explain schema valid2))) + (is (results= {:schema schema, + :value {:y "invalid", "123" "123"}, + :errors [{:path [:x], + :in [:x], + :schema schema, + :value nil, + :type :malli.core/missing-key} + {:path [:y], :in [:y], :schema :int, :value "invalid"} + {:path [::m/default 0], :in ["123"], :schema :int, :value "123"} + {:path [::m/default 1], :in ["123"], :schema :int, :value "123"}]} + (m/explain schema {:y "invalid", "123" "123"})))) + + (testing "children" + (is (schema= [[:x nil :boolean] + [:y {:optional true} :int] + [::m/default nil [:map-of :int :int]]] + (m/children schema)))) + + (testing "entries" + (is (true? (every? map-entry? (m/entries schema)))) + (is (= [:x :y ::m/default] (map key (m/entries schema)))) + (is (schema= [[:x [::m/val :boolean]] + [:y [::m/val {:optional true} :int]] + [::m/default [::m/val [:map-of :int :int]]]] + (m/entries schema)))) (testing "parsing and unparsing" (let [schema [:map {:registry {'int [:orn ['int :int]] @@ -2996,7 +2998,8 @@ [::m/default [:map-of :keyword :keyword]]] (mt/transformer))))) - (is (true? (m/validate (over-the-wire schema) valid))) + (testing "over the wire" + (is (true? (m/validate (over-the-wire schema) valid)))) (testing "ast" (is (= {:type :map, @@ -3013,8 +3016,9 @@ (m/ast schema))) (is (true? (m/validate (m/from-ast (m/ast schema)) valid)))) - (is (= [:map - [:x :boolean] - [:y {:optional true} :int] - [::m/default [:map-of :int :int]]] - (m/form schema))))) + (testing "form" + (is (= [:map + [:x :boolean] + [:y {:optional true} :int] + [::m/default [:map-of :int :int]]] + (m/form schema)))))) From e259a3b8388ac9a00bb3baca759d0b8e04f2af17 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Thu, 16 Mar 2023 09:56:14 +0200 Subject: [PATCH 47/86] parser & unparser --- src/malli/core.cljc | 8 ++++++-- test/malli/core_test.cljc | 15 +++++++-------- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 9922afe71..bcee212c4 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -996,10 +996,14 @@ default-parser (cons (fn [m] (let [m' (default-parser - (reduce (fn [acc k] (dissoc acc k)) m (keys keyset)))] + (if (= f -parser) + (reduce (fn [acc k] (dissoc acc k)) m (keys keyset)) + (::default m)))] (if (miu/-invalid? m') (reduced m') - (merge (select-keys m (keys keyset)) m'))))) + (if (= f -parser) + (assoc (select-keys m (keys keyset)) ::default m') + (dissoc (merge (select-keys m (keys keyset)) m') ::default)))))) closed (cons (fn [m] (reduce diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 1d1992c61..7458e2537 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -2907,11 +2907,10 @@ :value {:x "kikka"}}} (as-data (> valid (m/parse schema) (m/unparse schema)))) (is (= ::m/invalid (m/parse schema {"kukka" 42}))))) From 56c250b56e483727ad8f0f57854c038765ea9b76 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Thu, 16 Mar 2023 14:54:58 +0200 Subject: [PATCH 48/86] json-schema + m/explicit-keys --- src/malli/core.cljc | 9 +++++++ src/malli/json_schema.cljc | 15 ++++++++---- test/malli/core_test.cljc | 2 ++ test/malli/json_schema_test.cljc | 40 +++++++++++++++++++++++--------- 4 files changed, 51 insertions(+), 15 deletions(-) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index bcee212c4..831782048 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -2274,6 +2274,15 @@ (when-let [schema (schema ?schema options)] (when (-entry-schema? schema) (-entries schema))))) +(defn explicit-keys + ([?schema] (explicit-keys ?schema nil)) + ([?schema options] + (let [schema (schema ?schema options)] + (when (-entry-schema? schema) + (reduce + (fn [acc [k :as e]] (cond-> acc (not (-default-entry e)) (conj k))) + [] (-entries schema)))))) + (defn deref "Derefs top-level `RefSchema`s or returns original Schema." ([?schema] diff --git a/src/malli/json_schema.cljc b/src/malli/json_schema.cljc index 7914b6fe4..ef4ffa8bb 100644 --- a/src/malli/json_schema.cljc +++ b/src/malli/json_schema.cljc @@ -82,14 +82,21 @@ (defmethod accept :orn [_ _ children _] {:anyOf (map last children)}) (defmethod accept ::m/val [_ _ children _] (first children)) + (defmethod accept :map [_ schema children _] - (let [required (->> children (filter (m/-comp not :optional second)) (mapv first)) - additional-properties (:closed (m/properties schema)) + (let [ks (set (m/explicit-keys schema)) + default (some->> children (remove (m/-comp ks first)) first last) + children (filter (m/-comp ks first) children) + required (->> children (filter (m/-comp not :optional second)) (mapv first)) + cloased (:closed (m/properties schema)) object {:type "object" :properties (apply array-map (mapcat (fn [[k _ s]] [k s]) children))}] - (cond-> object + ;; should do a deep-merge instead? e.g. [:map [:x :int] [::m/default [:map [:y :int]]]] + (cond-> (merge default object) (seq required) (assoc :required required) - additional-properties (assoc :additionalProperties false)))) + cloased (assoc :additionalProperties false) + default (-> (merge (select-keys default [:additionalProperties])) + (->> (merge default)))))) (defmethod accept :multi [_ _ children _] {:oneOf (mapv last children)}) diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 7458e2537..0b114ea16 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -911,6 +911,7 @@ (is (true? (every? map-entry? (m/entries schema)))) (is (= [:x :y :z] (map key (m/entries schema)))) + (is (= [:x :y :z] (m/explicit-keys schema))) (is (schema= [[:x [::m/val 'boolean?]] [:y [::m/val {:optional true} 'int?]] @@ -2945,6 +2946,7 @@ (testing "entries" (is (true? (every? map-entry? (m/entries schema)))) (is (= [:x :y ::m/default] (map key (m/entries schema)))) + (is (= [:x :y] (m/explicit-keys schema))) (is (schema= [[:x [::m/val :boolean]] [:y [::m/val {:optional true} :int]] [::m/default [::m/val [:map-of :int :int]]]] diff --git a/test/malli/json_schema_test.cljc b/test/malli/json_schema_test.cljc index b6b3d5a07..58ef906e5 100644 --- a/test/malli/json_schema_test.cljc +++ b/test/malli/json_schema_test.cljc @@ -25,11 +25,29 @@ [[:map [:a string?] [:b {:optional true} string?] - [:c {:optional false} string?]] {:type "object" - :properties {:a {:type "string"} - :b {:type "string"} - :c {:type "string"}} - :required [:a :c]}] + [:c {:optional false} string?]] + {:type "object" + :properties {:a {:type "string"} + :b {:type "string"} + :c {:type "string"}} + :required [:a :c]}] + [[:map + [:x :int] + [::m/default [:map-of :int :int]]] + {:type "object" + :properties {:x {:type "integer"}} + :required [:x] + :additionalProperties {:type "integer"}}] + [[:map + [:x :int] + [::m/default [:fn {:json-schema/default {:x 1}} map?]]] + {:type "object" + :properties {:x {:type "integer"}} + :required [:x] + :default {:x 1}}] + ;; TODO: :map does not deep-merge ::m/default contents + #_[[:map [:x :int] [::m/default [:map [:y :int]]]] + {:type "object", :properties {:x {:type "integer"}, :y {:type "integer"}}, :required [:x :y]}] [[:multi {:dispatch :type :decode/string '(fn [x] (update x :type keyword))} [:sized [:map {:gen/fmap '#(assoc % :type :sized)} [:type keyword?] [:size int?]]] @@ -83,8 +101,8 @@ [ifn? {}] [integer? {:type "integer"}] - #?@(:clj [[ratio? {:type "number"}] - [rational? {:type "number"}]] + #?@(:clj [[ratio? {:type "number"}] + [rational? {:type "number"}]] :cljs []) ;; protocols [(reify @@ -120,10 +138,10 @@ :x5 {:type "x-string"}}} (json-schema/transform [:map - [:x1 {:json-schema/title "x" :optional true} :string] - [:x2 {:json-schema {:title "x"} :optional true} [:string {:json-schema/default "x"}]] - [:x3 {:json-schema/title "x" :optional true} [:string {:json-schema/default "x"}]] - [:x4 {:json-schema/title "x-string" :optional true} [:string {:json-schema {:default "x2"}}]] + [:x1 {:json-schema/title "x" :optional true} :string] + [:x2 {:json-schema {:title "x"} :optional true} [:string {:json-schema/default "x"}]] + [:x3 {:json-schema/title "x" :optional true} [:string {:json-schema/default "x"}]] + [:x4 {:json-schema/title "x-string" :optional true} [:string {:json-schema {:default "x2"}}]] [:x5 {:json-schema {:type "x-string"} :optional true} [:string {:json-schema {:default "x"}}]]])))) (testing "map-entry overrides" From 29592cd25bcf9f233fa2abf61279ee7846b3d8ee Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Thu, 16 Mar 2023 14:58:21 +0200 Subject: [PATCH 49/86] . --- src/malli/transform.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/malli/transform.cljc b/src/malli/transform.cljc index 90b1bb2de..b8fbc35b9 100644 --- a/src/malli/transform.cljc +++ b/src/malli/transform.cljc @@ -92,7 +92,7 @@ (defn -string->uuid [x] (if (string? x) (if-let [x (re-matches uuid-re x)] - #?(:clj (UUID/fromString x) + #?(:clj (UUID/fromString x) :cljs (uuid x)) x) x)) From a199fb4929d313fb70a4a27d9206f76e6f59d9e5 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Thu, 16 Mar 2023 15:02:54 +0200 Subject: [PATCH 50/86] fix gens --- src/malli/generator.cljc | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/malli/generator.cljc b/src/malli/generator.cljc index 7f3f4aaff..e2918c44e 100644 --- a/src/malli/generator.cljc +++ b/src/malli/generator.cljc @@ -154,8 +154,10 @@ (gen-one-of gs) (-never-gen options))) +;; TODO: handle ::m/default (defn -map-gen [schema options] - (let [entries (m/entries schema) + (let [eks (set (m/explicit-keys schema)) + entries (filter (m/-comp eks key) (m/entries schema)) value-gen (fn [k s] (let [g (generator s options)] (cond->> g (-not-unreachable g) From 597c293ebf022dd2605fc897d98728e1467cc2a1 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Thu, 16 Mar 2023 15:31:48 +0200 Subject: [PATCH 51/86] m/default-schema --- src/malli/core.cljc | 7 +++++++ test/malli/core_test.cljc | 6 ++++++ 2 files changed, 13 insertions(+) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 831782048..21ec46a2e 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -2283,6 +2283,13 @@ (fn [acc [k :as e]] (cond-> acc (not (-default-entry e)) (conj k))) [] (-entries schema)))))) +(defn default-schema + ([?schema] (default-schema ?schema nil)) + ([?schema options] + (let [schema (schema ?schema options)] + (when (-entry-schema? schema) + (-default-entry-schema (-children schema)))))) + (defn deref "Derefs top-level `RefSchema`s or returns original Schema." ([?schema] diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 0b114ea16..192693caa 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -1240,6 +1240,9 @@ {:path [::m/default 1], :in [1], :schema :string, :value :invalid}]} (m/explain schema [:so :invalid])))) + (testing "default schema" + (is (schema= [:tuple :string :string] (m/default-schema schema)))) + (testing "parser" (is (= (miu/-tagged :human [:human]) (m/parse schema [:human]))) (is (= (miu/-tagged :bear [:bear [1 2 3]]) (m/parse schema [:bear 1 2 3]))) @@ -2952,6 +2955,9 @@ [::m/default [::m/val [:map-of :int :int]]]] (m/entries schema)))) + (testing "default-schema" + (is (schema= [:map-of :int :int] (m/default-schema schema)))) + (testing "parsing and unparsing" (let [schema [:map {:registry {'int [:orn ['int :int]] 'str [:orn ['str :string]]}} From 70a23d2a87ca6668701f92293a849a3e30ad60bc Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Thu, 16 Mar 2023 16:22:23 +0200 Subject: [PATCH 52/86] deep merge like a boss --- src/malli/json_schema.cljc | 8 +++++--- test/malli/json_schema_test.cljc | 8 +++++--- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/src/malli/json_schema.cljc b/src/malli/json_schema.cljc index ef4ffa8bb..6e88393d7 100644 --- a/src/malli/json_schema.cljc +++ b/src/malli/json_schema.cljc @@ -86,17 +86,19 @@ (defmethod accept :map [_ schema children _] (let [ks (set (m/explicit-keys schema)) default (some->> children (remove (m/-comp ks first)) first last) + {additionalProperties' :additionalProperties properties' :properties required' :required} default children (filter (m/-comp ks first) children) required (->> children (filter (m/-comp not :optional second)) (mapv first)) cloased (:closed (m/properties schema)) object {:type "object" :properties (apply array-map (mapcat (fn [[k _ s]] [k s]) children))}] - ;; should do a deep-merge instead? e.g. [:map [:x :int] [::m/default [:map [:y :int]]]] (cond-> (merge default object) (seq required) (assoc :required required) cloased (assoc :additionalProperties false) - default (-> (merge (select-keys default [:additionalProperties])) - (->> (merge default)))))) + default (cond-> + additionalProperties' (assoc :additionalProperties additionalProperties') + properties' (update :properties merge properties') + required' (update :required (comp vec distinct into) required'))))) (defmethod accept :multi [_ _ children _] {:oneOf (mapv last children)}) diff --git a/test/malli/json_schema_test.cljc b/test/malli/json_schema_test.cljc index 58ef906e5..152bb2357 100644 --- a/test/malli/json_schema_test.cljc +++ b/test/malli/json_schema_test.cljc @@ -45,9 +45,11 @@ :properties {:x {:type "integer"}} :required [:x] :default {:x 1}}] - ;; TODO: :map does not deep-merge ::m/default contents - #_[[:map [:x :int] [::m/default [:map [:y :int]]]] - {:type "object", :properties {:x {:type "integer"}, :y {:type "integer"}}, :required [:x :y]}] + [[:map [:x :int] [::m/default [:map [:y :int]]]] + {:type "object" + :properties {:x {:type "integer"} + :y {:type "integer"}} + :required [:x :y]}] [[:multi {:dispatch :type :decode/string '(fn [x] (update x :type keyword))} [:sized [:map {:gen/fmap '#(assoc % :type :sized)} [:type keyword?] [:size int?]]] From 57784bcb02596b76f6eb63054e3f62cabf80df91 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Thu, 16 Mar 2023 16:38:33 +0200 Subject: [PATCH 53/86] deeply recursive test --- test/malli/json_schema_test.cljc | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/test/malli/json_schema_test.cljc b/test/malli/json_schema_test.cljc index 152bb2357..e35f692e6 100644 --- a/test/malli/json_schema_test.cljc +++ b/test/malli/json_schema_test.cljc @@ -45,11 +45,19 @@ :properties {:x {:type "integer"}} :required [:x] :default {:x 1}}] - [[:map [:x :int] [::m/default [:map [:y :int]]]] - {:type "object" - :properties {:x {:type "integer"} - :y {:type "integer"}} - :required [:x :y]}] + [[:map + [:x :int] + [::m/default [:map + [:y :int] + [::m/default [:map + [:z :int] + [::m/default [:map-of :int :int]]]]]]] + {:type "object", + :additionalProperties {:type "integer"}, + :properties {:x {:type "integer"} + :y {:type "integer"} + :z {:type "integer"}}, + :required [:x :y :z]}] [[:multi {:dispatch :type :decode/string '(fn [x] (update x :type keyword))} [:sized [:map {:gen/fmap '#(assoc % :type :sized)} [:type keyword?] [:size int?]]] From 205658a69b04f18b76e529daade5b8fa856c2789 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Thu, 16 Mar 2023 16:54:49 +0200 Subject: [PATCH 54/86] fix ::m/default generation on maps --- src/malli/generator.cljc | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/malli/generator.cljc b/src/malli/generator.cljc index e2918c44e..6c3102460 100644 --- a/src/malli/generator.cljc +++ b/src/malli/generator.cljc @@ -156,8 +156,7 @@ ;; TODO: handle ::m/default (defn -map-gen [schema options] - (let [eks (set (m/explicit-keys schema)) - entries (filter (m/-comp eks key) (m/entries schema)) + (let [entries (m/entries schema) value-gen (fn [k s] (let [g (generator s options)] (cond->> g (-not-unreachable g) @@ -168,11 +167,13 @@ gen-opt (->> entries (filter #(-> % last m/properties :optional)) (map (fn [[k s]] (let [g (-not-unreachable (value-gen k s))] - (gen-one-of (cond-> [(gen/return nil)] - g (conj g)))))) - (apply gen/tuple))] + (gen-one-of (cond-> [(gen/return nil)] g (conj g))))))) + undefault (fn [kvs] (reduce (fn [acc [k v]] (if (and (= k ::m/default) (map? v)) + (into acc (map identity v)) + (conj acc [k v]))) [] kvs))] (if (not-any? -unreachable-gen? gens-req) - (gen/fmap (fn [[req opt]] (into {} (concat req opt))) (gen/tuple (apply gen/tuple gens-req) gen-opt)) + (gen/fmap (fn [[req opt]] (into {} (concat (undefault req) (undefault opt)))) + (gen/tuple (apply gen/tuple gens-req) (apply gen/tuple gen-opt))) (-never-gen options)))) (defn -map-of-gen [schema options] From d33258d538353d2fe25f5716b10c3f3b50f0c5f5 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Thu, 16 Mar 2023 17:13:33 +0200 Subject: [PATCH 55/86] fix generators --- src/malli/generator.cljc | 9 +++++---- test/malli/json_schema_test.cljc | 5 +++-- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/malli/generator.cljc b/src/malli/generator.cljc index 6c3102460..efb0f72e3 100644 --- a/src/malli/generator.cljc +++ b/src/malli/generator.cljc @@ -168,11 +168,12 @@ (filter #(-> % last m/properties :optional)) (map (fn [[k s]] (let [g (-not-unreachable (value-gen k s))] (gen-one-of (cond-> [(gen/return nil)] g (conj g))))))) - undefault (fn [kvs] (reduce (fn [acc [k v]] (if (and (= k ::m/default) (map? v)) - (into acc (map identity v)) - (conj acc [k v]))) [] kvs))] + undefault (fn [kvs] (reduce (fn [acc [k v]] + (cond (and (= k ::m/default) (map? v)) (into acc (map identity v)) + (and (nil? k) (nil? v)) acc + :else (conj acc [k v]))) [] kvs))] (if (not-any? -unreachable-gen? gens-req) - (gen/fmap (fn [[req opt]] (into {} (concat (undefault req) (undefault opt)))) + (gen/fmap (fn [[req opt]] (into {} (undefault (concat req opt)))) (gen/tuple (apply gen/tuple gens-req) (apply gen/tuple gen-opt))) (-never-gen options)))) diff --git a/test/malli/json_schema_test.cljc b/test/malli/json_schema_test.cljc index e35f692e6..a3d8b256c 100644 --- a/test/malli/json_schema_test.cljc +++ b/test/malli/json_schema_test.cljc @@ -1,5 +1,6 @@ (ns malli.json-schema-test - (:require [clojure.test :refer [deftest is testing]] + (:require [clojure.test.check.generators :as gen] + [clojure.test :refer [deftest is testing]] [malli.core :as m] [malli.core-test] [malli.json-schema :as json-schema] @@ -40,7 +41,7 @@ :additionalProperties {:type "integer"}}] [[:map [:x :int] - [::m/default [:fn {:json-schema/default {:x 1}} map?]]] + [::m/default [:fn {:json-schema/default {:x 1}, :gen/gen (gen/return {})} map?]]] {:type "object" :properties {:x {:type "integer"}} :required [:x] From ef08a7373213e4b1acec054300e3235f36cce647 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Thu, 16 Mar 2023 23:09:06 +0200 Subject: [PATCH 56/86] format --- src/malli/json_schema.cljc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/malli/json_schema.cljc b/src/malli/json_schema.cljc index 6e88393d7..b637a6aba 100644 --- a/src/malli/json_schema.cljc +++ b/src/malli/json_schema.cljc @@ -89,12 +89,12 @@ {additionalProperties' :additionalProperties properties' :properties required' :required} default children (filter (m/-comp ks first) children) required (->> children (filter (m/-comp not :optional second)) (mapv first)) - cloased (:closed (m/properties schema)) + closed (:closed (m/properties schema)) object {:type "object" :properties (apply array-map (mapcat (fn [[k _ s]] [k s]) children))}] (cond-> (merge default object) (seq required) (assoc :required required) - cloased (assoc :additionalProperties false) + closed (assoc :additionalProperties false) default (cond-> additionalProperties' (assoc :additionalProperties additionalProperties') properties' (update :properties merge properties') From d72099c13dfa8346c601527c4c7ace7c20848245 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Fri, 17 Mar 2023 09:05:23 +0200 Subject: [PATCH 57/86] strip-extra-keys --- src/malli/transform.cljc | 32 +++++++++------ test/malli/transform_test.cljc | 72 ++++++++++++++++++++++++++++++++++ 2 files changed, 91 insertions(+), 13 deletions(-) diff --git a/src/malli/transform.cljc b/src/malli/transform.cljc index b8fbc35b9..592089c8f 100644 --- a/src/malli/transform.cljc +++ b/src/malli/transform.cljc @@ -364,21 +364,27 @@ :encoders (-string-encoders)})) (defn strip-extra-keys-transformer - ([] - (strip-extra-keys-transformer nil)) + ([] (strip-extra-keys-transformer nil)) ([{:keys [accept] :or {accept (m/-comp #(or (nil? %) (true? %)) :closed m/properties)}}] - (let [transform {:compile (fn [schema _] - (when (accept schema) - (when-let [ks (some->> schema m/entries (map first) seq set)] - (fn [x] - ;; accept checks if the schema is compatible with strip-extra-keys, - ;; but the value might not be compatible with reduce-kv, i.e. a string. - (if (map? x) - (reduce-kv (fn [acc k _] (if-not (ks k) (dissoc acc k) acc)) x x) - x)))))}] + (let [strip-map {:compile (fn [schema _] + (let [default-schema (m/default-schema schema) + ks (some->> schema (m/explicit-keys) (set))] + (cond-> nil + (accept schema) + (assoc :enter (fn [x] + (if (and (map? x) (not default-schema)) + (reduce-kv (fn [acc k _] (if-not (ks k) (dissoc acc k) acc)) x x) + x))))))} + strip-map-of {:compile (fn [schema options] + (let [entry-schema (m/into-schema :tuple nil (m/children schema) options) + valid? (m/validator entry-schema options)] + {:leave (fn [x] (reduce (fn [acc entry] + (if (valid? entry) + (apply assoc acc entry) + acc)) (empty x) x))}))}] (transformer - {:decoders {:map transform} - :encoders {:map transform}})))) + {:decoders {:map strip-map, :map-of strip-map-of} + :encoders {:map strip-map, :map-of strip-map-of}})))) (defn key-transformer [{:keys [decode encode types] :or {types #{:map}}}] (let [transform (fn [f stage] (when f {stage (-transform-map-keys f)}))] diff --git a/test/malli/transform_test.cljc b/test/malli/transform_test.cljc index 3fe2a4a2a..b2fbede90 100644 --- a/test/malli/transform_test.cljc +++ b/test/malli/transform_test.cljc @@ -441,6 +441,78 @@ (mt/string-transformer))))))) (deftest strip-extra-keys-transformer-test + + (testing "extra keys from :map are stripped" + (is (= {:x 1, :y 2} + (m/decode + [:map [:x :int] [:y :int]] + {:x 1, :y 2, :z 3} + (mt/strip-extra-keys-transformer))))) + + (testing "extra keys from :map-of are stripped" + (is (= {1 1} + (m/decode + [:map-of :int :int] + {1 1, "2" 2, 3 "3", "4" "4"} + (mt/strip-extra-keys-transformer)))) + + (testing "composing with other transformers" + (is (= {1 1, 2 2, 3 3, 4 4} + (m/decode + [:map-of :int :int] + {1 1, "2" 2, 3 "3", "4" "4"} + (mt/transformer + (mt/strip-extra-keys-transformer) + (mt/string-transformer))))))) + + (testing "::m/default defines how extra keys are stripped" + (let [value {:x 1, :y 2, :z 3, 1 1, "2" 2, 3 "3", "4" "4"} + expected {1 1, :x 1, :y 2}] + + (testing "explicit and default values are both stripped" + (is (= expected + (m/decode + [:map + [:x :int] + [:y :int] + [::m/default [:map-of :int :int]]] + value + (mt/strip-extra-keys-transformer))))) + + (testing "explictly open map works the same way" + (is (= expected + (m/decode + [:map {:closed false} + [:x :int] + [:y :int] + [::m/default [:map-of :int :int]]] + value + (mt/strip-extra-keys-transformer))))) + + (testing "default schemas can be arbitrary nested" + (is (= expected + (m/decode + [:map + [:x :int] + [::m/default [:map + [:y :int] + [::m/default [:map-of :int :int]]]]] + value + (mt/strip-extra-keys-transformer)))) + + (testing "composing with other transformers" + (is (= {:x 1, :y 2, 1 1, 2 2, 3 3, 4 4} + (m/decode + [:map + [:x :int] + [::m/default [:map + [:y :int] + [::m/default [:map-of :int :int]]]]] + value + (mt/transformer + (mt/strip-extra-keys-transformer) + (mt/string-transformer))))))))) + (let [strip-default (mt/strip-extra-keys-transformer) strip-closed (mt/strip-extra-keys-transformer {:accept (comp :closed m/properties)}) strip-all (mt/strip-extra-keys-transformer {:accept (constantly true)})] From 880db0e80d9688a7a5e8119f6b612aa94dc8e9c1 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Fri, 17 Mar 2023 09:05:34 +0200 Subject: [PATCH 58/86] docs --- CHANGELOG.md | 3 +++ README.md | 31 +++++++++++++++++++++++++------ src/malli/core.cljc | 2 ++ 3 files changed, 30 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 67ff0aa08..40c66bfa6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,6 +16,9 @@ Malli is in well matured [alpha](README.md#alpha). ## UNRELEASED +* Allow additional entries in `:map` schemas via `::m/default` key [#871](https://github.com/metosin/malli/pull/871), [docs](README.md#map-with-default-schemas) +* new `m/default-schmea` and `m/explicit-keys` helpers +* `mt/strip-extra-keys-transformer` works with `:map-of` schemas * Simplify content-dependent schema creation with `m/-simple-schema` and `m/-collection-schema` via new 3-arity `:compile` function of type `children properties options -> props`. Old 2-arity top-level callback function is `m/deprecated!` and support for it will be removed in future versions. [#866](https://github.com/metosin/malli/pull/866) ## 0.10.2 (2023-03-05) diff --git a/README.md b/README.md index 3edea7b7c..3697f4008 100644 --- a/README.md +++ b/README.md @@ -212,15 +212,9 @@ Validating values against a schema: (m/validate [:= 1] 1) ; => true -(m/validate [:= 1] 2) -; => false - (m/validate [:enum 1 2] 1) ; => true -(m/validate [:enum 1 2] 0) -; => false - (m/validate [:and :int [:> 6]] 7) ; => true @@ -326,6 +320,31 @@ pairs have the same type. For this use case, we can use the `:map-of` schema. "helsinki" {:lat 60 :long 24}}) ;; => true ``` +## Map with default schemas + +Map schemas can define a special `:malli.core/default` key to handle extra keys: + +```clojure +(m/validate + [:map + [:x :int] + [:y :int] + [::m/default [:map-of :int :int]]] + {:x 1, :y 2, 1 1, 2 2}) +; => true +``` +default branching can be arbitraty nested: + +```clojure +(m/validate + [:map + [:x :int] + [::m/default [:map + [:y :int] + [::m/default [:map-of :int :int]]]]] + {:x 1, :y 2, 1 1, 2 2}) +; => true +``` ## Sequence schemas diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 21ec46a2e..37bc1fe19 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -2275,6 +2275,7 @@ (when (-entry-schema? schema) (-entries schema))))) (defn explicit-keys + "Returns a vector of explicit (not ::m/default) keys from EntrySchema" ([?schema] (explicit-keys ?schema nil)) ([?schema options] (let [schema (schema ?schema options)] @@ -2284,6 +2285,7 @@ [] (-entries schema)))))) (defn default-schema + "Returns the default (::m/default) schema from EntrySchema" ([?schema] (default-schema ?schema nil)) ([?schema options] (let [schema (schema ?schema options)] From af916650ffc954070b7647a4328f11d804113303 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Fri, 17 Mar 2023 09:05:40 +0200 Subject: [PATCH 59/86] cleanup --- src/malli/generator.cljc | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/malli/generator.cljc b/src/malli/generator.cljc index efb0f72e3..88ab509e9 100644 --- a/src/malli/generator.cljc +++ b/src/malli/generator.cljc @@ -154,7 +154,6 @@ (gen-one-of gs) (-never-gen options))) -;; TODO: handle ::m/default (defn -map-gen [schema options] (let [entries (m/entries schema) value-gen (fn [k s] (let [g (generator s options)] @@ -170,7 +169,7 @@ (gen-one-of (cond-> [(gen/return nil)] g (conj g))))))) undefault (fn [kvs] (reduce (fn [acc [k v]] (cond (and (= k ::m/default) (map? v)) (into acc (map identity v)) - (and (nil? k) (nil? v)) acc + (nil? k) acc :else (conj acc [k v]))) [] kvs))] (if (not-any? -unreachable-gen? gens-req) (gen/fmap (fn [[req opt]] (into {} (undefault (concat req opt)))) From 6b46a6bbcafe911a89afb751f164e407fa532e63 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Fri, 17 Mar 2023 09:10:35 +0200 Subject: [PATCH 60/86] CHANGELOG --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 40c66bfa6..aa6b73148 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,7 +17,8 @@ Malli is in well matured [alpha](README.md#alpha). ## UNRELEASED * Allow additional entries in `:map` schemas via `::m/default` key [#871](https://github.com/metosin/malli/pull/871), [docs](README.md#map-with-default-schemas) -* new `m/default-schmea` and `m/explicit-keys` helpers +* `m/default-schema` to pull the `::m/default` schema from entry schemas +* `m/explicit-keys` to get a vector of explicit keys from entry schemas (no `::m/default` * `mt/strip-extra-keys-transformer` works with `:map-of` schemas * Simplify content-dependent schema creation with `m/-simple-schema` and `m/-collection-schema` via new 3-arity `:compile` function of type `children properties options -> props`. Old 2-arity top-level callback function is `m/deprecated!` and support for it will be removed in future versions. [#866](https://github.com/metosin/malli/pull/866) From ac672acc82c28f404c78561b080e8d53d5eb576f Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Fri, 17 Mar 2023 09:11:55 +0200 Subject: [PATCH 61/86] CHANGELOG --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index aa6b73148..f6e7c6da6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,7 +16,8 @@ Malli is in well matured [alpha](README.md#alpha). ## UNRELEASED -* Allow additional entries in `:map` schemas via `::m/default` key [#871](https://github.com/metosin/malli/pull/871), [docs](README.md#map-with-default-schemas) +* Add support for default/fallback branch for `:map` + [#871](https://github.com/metosin/malli/pull/871), [docs](README.md#map-with-default-schemas) * `m/default-schema` to pull the `::m/default` schema from entry schemas * `m/explicit-keys` to get a vector of explicit keys from entry schemas (no `::m/default` * `mt/strip-extra-keys-transformer` works with `:map-of` schemas From 035f873181e59d46001ff1f68c1c14c1239c4e45 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Fri, 17 Mar 2023 09:44:42 +0200 Subject: [PATCH 62/86] remove ::m/default wrapping from parsing --- src/malli/core.cljc | 8 ++------ test/malli/core_test.cljc | 21 ++++++++++----------- 2 files changed, 12 insertions(+), 17 deletions(-) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 37bc1fe19..2636593b6 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -996,14 +996,10 @@ default-parser (cons (fn [m] (let [m' (default-parser - (if (= f -parser) - (reduce (fn [acc k] (dissoc acc k)) m (keys keyset)) - (::default m)))] + (reduce (fn [acc k] (dissoc acc k)) m (keys keyset)))] (if (miu/-invalid? m') (reduced m') - (if (= f -parser) - (assoc (select-keys m (keys keyset)) ::default m') - (dissoc (merge (select-keys m (keys keyset)) m') ::default)))))) + (merge (select-keys m (keys keyset)) m'))))) closed (cons (fn [m] (reduce diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 192693caa..9c7484f15 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -2917,7 +2917,7 @@ [::m/default [:map-of :int :int]]] valid {:x true, :y 1} valid2 {:x true, :y 1, 123 123, 456 456} - invalid {:x true, :y 1, 123 "123", "456" 456}] + invalid {:x true, :y 1, 42 42, 123 "123", "456" 456}] (testing "validation" (is (true? (m/validate schema valid))) @@ -2959,24 +2959,23 @@ (is (schema= [:map-of :int :int] (m/default-schema schema)))) (testing "parsing and unparsing" - (let [schema [:map {:registry {'int [:orn ['int :int]] - 'str [:orn ['str :string]]}} + (let [schema [:map {:registry {'int [:orn [::int :int]] + 'str [:orn [::str :string]]}} [:id 'int] ["name" 'str] [::m/default [:map-of 'str 'str]]] valid {:id 1, "name" "tommi", "kikka" "kukka", "abba" "jabba"}] - (is (= {:id ['int 1], - "name" ['str "tommi"] - ::m/default {['str "kikka"] ['str "kukka"] - ['str "abba"] ['str "jabba"]}} + (is (= {:id [::int 1], + "name" [::str "tommi"] + [::str "kikka"] [::str "kukka"] + [::str "abba"] [::str "jabba"]} (m/parse schema valid))) (is (= valid (->> valid (m/parse schema) (m/unparse schema)))) (is (= ::m/invalid (m/parse schema {"kukka" 42}))))) - #_(is (= {:x true, :y 1} (m/decode schema {:x true, :y 1, :a 1} mt/strip-extra-keys-transformer))) - #_(is (= {:x_key true, :y_key 2} (m/decode schema {:x true, :y 2} - (mt/key-transformer - {:decode #(-> % name (str "_key") keyword)})))) + (testing "stripping keys" + (is (= {:x true, :y 1, 42 42} + (m/decode schema invalid (mt/strip-extra-keys-transformer))))) (testing "::m/default transforming doesn't effect defined keys" (is (= {:id 12 From d7822a45a140f5110c66e95a464749012b015d26 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Fri, 17 Mar 2023 09:52:51 +0200 Subject: [PATCH 63/86] better doc --- test/malli/transform_test.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/malli/transform_test.cljc b/test/malli/transform_test.cljc index b2fbede90..4d9265383 100644 --- a/test/malli/transform_test.cljc +++ b/test/malli/transform_test.cljc @@ -469,7 +469,7 @@ (let [value {:x 1, :y 2, :z 3, 1 1, "2" 2, 3 "3", "4" "4"} expected {1 1, :x 1, :y 2}] - (testing "explicit and default values are both stripped" + (testing "stripping applies for both explicit and default values" (is (= expected (m/decode [:map From 65effcaf4fcb3c74bfeb16df54dfccddf630a1e8 Mon Sep 17 00:00:00 2001 From: Joel Kaasinen Date: Fri, 17 Mar 2023 14:32:29 +0200 Subject: [PATCH 64/86] test: one more test case for ::m/default + strip-extra-keys --- test/malli/transform_test.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/malli/transform_test.cljc b/test/malli/transform_test.cljc index 4d9265383..f23da6588 100644 --- a/test/malli/transform_test.cljc +++ b/test/malli/transform_test.cljc @@ -466,7 +466,7 @@ (mt/string-transformer))))))) (testing "::m/default defines how extra keys are stripped" - (let [value {:x 1, :y 2, :z 3, 1 1, "2" 2, 3 "3", "4" "4"} + (let [value {:x 1, :y 2, :z 3, 1 1, "2" 2, 3 "3", "4" "4", "string" 5} expected {1 1, :x 1, :y 2}] (testing "stripping applies for both explicit and default values" From 58f1ed701605bfd8fbb4ea4dcbc67c60d5b1f861 Mon Sep 17 00:00:00 2001 From: Wes Morgan Date: Mon, 6 Mar 2023 12:05:34 -0700 Subject: [PATCH 65/86] Move swagger gen code from reitit-malli to here This allows us to see the whole spec at once and fix a bug w/ custom registry definitions --- src/malli/swagger.cljc | 100 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 100 insertions(+) diff --git a/src/malli/swagger.cljc b/src/malli/swagger.cljc index 87e9543ea..318b1615e 100644 --- a/src/malli/swagger.cljc +++ b/src/malli/swagger.cljc @@ -1,5 +1,6 @@ (ns malli.swagger (:require [clojure.set :as set] + [clojure.walk :as walk] [malli.core :as m] [malli.json-schema :as json-schema])) @@ -67,3 +68,102 @@ ::json-schema/definitions definitions ::json-schema/transform -transform})] (cond-> (-transform ?schema options) (seq @definitions) (assoc :definitions @definitions))))) + +(defn remove-empty-keys + [m] + (into (empty m) (filter (comp not nil? val) m))) + +(defmulti extract-parameter (fn [in _] in)) + +(defmethod extract-parameter :body [_ schema] + (let [swagger-schema (transform schema {:in :body, :type :parameter})] + [{:in "body" + :name (:title swagger-schema "body") + :description (:description swagger-schema "") + :required (not= :maybe (m/type schema)) + :schema swagger-schema}])) + +(defmethod extract-parameter :default [in schema] + (let [{:keys [properties required definitions]} (transform schema {:in in, :type :parameter})] + (println "\nextract-parameter definitions:" + (with-out-str (clojure.pprint/pprint definitions))) + (mapv + (fn [[k {:keys [type] :as schema}]] + (merge + {:in (name in) + :name k + :description (:description schema "") + :type type + :required (contains? (set required) k)} + schema)) + properties))) + +(defmulti expand (fn [k _ _ _] k)) + +#_(defn lift-response-definitions + [response] + (if-let [definitions (get-in response [:schema :definitions])] + (-> response + (update :schema dissoc :definitions) + (assoc :definitions definitions)))) + +(defmethod expand ::responses [_ v acc _] + {:responses + (into + (or (:responses acc) {}) + (for [[status response] v] + [status (-> response + (update :schema transform {:type :schema}) + (update :description (fnil identity "")) + remove-empty-keys)]))}) + +(defmethod expand ::parameters [_ v acc _] + (let [old (or (:parameters acc) []) + new (mapcat (fn [[in spec]] (extract-parameter in spec)) v) + merged (->> (into old new) + reverse + (reduce + (fn [[ps cache :as acc] p] + (let [c (select-keys p [:in :name])] + (if (cache c) + acc + [(conj ps p) (conj cache c)]))) + [[] #{}]) + first + reverse + vec)] + {:parameters merged})) + +(defn expand-qualified-keywords + [x options] + (let [accept? (-> expand methods keys set)] + (walk/postwalk + (fn [x] + (if (map? x) + (reduce-kv + (fn [acc k v] + (if (accept? k) + (let [expanded (expand k v acc options) + parameters (:parameters expanded) + _ (println "\nPARAMETERS:" + (with-out-str (clojure.pprint/pprint parameters))) + responses (:responses expanded) + _ (println "\nRESPONSES:" + (with-out-str (clojure.pprint/pprint responses))) + definitions (if parameters + (-> parameters first :schema :definitions) + (->> responses vals (map :schema) + (map :definitions) (apply merge))) + _ (println "\nDEFINITIONS:" + (with-out-str (clojure.pprint/pprint definitions)))] + (-> acc (dissoc k) (merge expanded) (update :definitions merge definitions))) + acc)) + x x) + x)) + x))) + +(defn swagger-spec + ([x] + (swagger-spec x nil)) + ([x options] + (expand-qualified-keywords x options))) From c5968a34981639652b10df4b679483c4a64cdc94 Mon Sep 17 00:00:00 2001 From: Wes Morgan Date: Mon, 6 Mar 2023 12:07:14 -0700 Subject: [PATCH 66/86] Properly encode the / in qualified keywords as ~1 ...in json-schema. Also removes the leading `:` which the definitions keys also didn't have. This allows the refs and definitions keys to match and be standards-compliant. --- src/malli/json_schema.cljc | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/malli/json_schema.cljc b/src/malli/json_schema.cljc index b637a6aba..81ecdaa4c 100644 --- a/src/malli/json_schema.cljc +++ b/src/malli/json_schema.cljc @@ -7,7 +7,12 @@ (defprotocol JsonSchema (-accept [this children options] "transforms schema to JSON Schema")) -(defn -ref [x] {:$ref (str "#/definitions/" x)}) +(defn -ref [x] {:$ref (apply str "#/definitions/" + (cond + (qualified-keyword? x) [(namespace x) "~1" + (name x)] + (keyword? x) [(name x)] + :else [x]))}) (defn -schema [schema {::keys [transform definitions] :as options}] (let [result (transform (m/deref schema) options)] From 98dfbeb9de3360f6b31a8455e7abec4309c08215 Mon Sep 17 00:00:00 2001 From: Wes Morgan Date: Mon, 6 Mar 2023 12:08:53 -0700 Subject: [PATCH 67/86] Don't define circular refs in definitions Perhaps this really needs to be fixed at a lower level, but I noticed that at times I was getting definitions whose values where just refs back to the same definition. These seemed to come in addition to the correct result that had the actual definition in it. So this just filters out the circular ones. --- src/malli/json_schema.cljc | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/malli/json_schema.cljc b/src/malli/json_schema.cljc index 81ecdaa4c..00664aace 100644 --- a/src/malli/json_schema.cljc +++ b/src/malli/json_schema.cljc @@ -17,7 +17,11 @@ (defn -schema [schema {::keys [transform definitions] :as options}] (let [result (transform (m/deref schema) options)] (if-let [ref (m/-ref schema)] - (do (swap! definitions assoc ref result) (-ref ref)) + (do + (when-not (and (contains? result :$ref) + (= (:$ref result) ref)) ; don't create circular defs + (swap! definitions assoc ref result)) + (-ref ref)) result))) (defn select [m] (select-keys m [:title :description :default])) From 4732c01e670d9efa15d94ef259762970438232c6 Mon Sep 17 00:00:00 2001 From: Wes Morgan Date: Wed, 8 Mar 2023 09:16:28 -0700 Subject: [PATCH 68/86] Clean up commented-out code & printlns --- src/malli/json_schema.cljc | 1 + src/malli/swagger.cljc | 15 +-------------- 2 files changed, 2 insertions(+), 14 deletions(-) diff --git a/src/malli/json_schema.cljc b/src/malli/json_schema.cljc index 00664aace..0be4d490e 100644 --- a/src/malli/json_schema.cljc +++ b/src/malli/json_schema.cljc @@ -9,6 +9,7 @@ (defn -ref [x] {:$ref (apply str "#/definitions/" (cond + ;; / must be encoded as ~1 in JSON Schema (qualified-keyword? x) [(namespace x) "~1" (name x)] (keyword? x) [(name x)] diff --git a/src/malli/swagger.cljc b/src/malli/swagger.cljc index 318b1615e..92032225b 100644 --- a/src/malli/swagger.cljc +++ b/src/malli/swagger.cljc @@ -100,13 +100,6 @@ (defmulti expand (fn [k _ _ _] k)) -#_(defn lift-response-definitions - [response] - (if-let [definitions (get-in response [:schema :definitions])] - (-> response - (update :schema dissoc :definitions) - (assoc :definitions definitions)))) - (defmethod expand ::responses [_ v acc _] {:responses (into @@ -145,17 +138,11 @@ (if (accept? k) (let [expanded (expand k v acc options) parameters (:parameters expanded) - _ (println "\nPARAMETERS:" - (with-out-str (clojure.pprint/pprint parameters))) responses (:responses expanded) - _ (println "\nRESPONSES:" - (with-out-str (clojure.pprint/pprint responses))) definitions (if parameters (-> parameters first :schema :definitions) (->> responses vals (map :schema) - (map :definitions) (apply merge))) - _ (println "\nDEFINITIONS:" - (with-out-str (clojure.pprint/pprint definitions)))] + (map :definitions) (apply merge)))] (-> acc (dissoc k) (merge expanded) (update :definitions merge definitions))) acc)) x x) From ff2c1b709b8d55683d0353a52963b586e41922cb Mon Sep 17 00:00:00 2001 From: Wes Morgan Date: Wed, 8 Mar 2023 09:29:14 -0700 Subject: [PATCH 69/86] Prefix remove-empty-keys w/ - & move out of public api --- src/malli/swagger.cljc | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/malli/swagger.cljc b/src/malli/swagger.cljc index 92032225b..de03f6832 100644 --- a/src/malli/swagger.cljc +++ b/src/malli/swagger.cljc @@ -55,6 +55,10 @@ (defn -transform [?schema options] (m/walk ?schema -swagger-walker options)) +(defn -remove-empty-keys + [m] + (into (empty m) (filter (comp not nil? val) m))) + ;; ;; public api ;; @@ -69,10 +73,6 @@ ::json-schema/transform -transform})] (cond-> (-transform ?schema options) (seq @definitions) (assoc :definitions @definitions))))) -(defn remove-empty-keys - [m] - (into (empty m) (filter (comp not nil? val) m))) - (defmulti extract-parameter (fn [in _] in)) (defmethod extract-parameter :body [_ schema] @@ -108,7 +108,7 @@ [status (-> response (update :schema transform {:type :schema}) (update :description (fnil identity "")) - remove-empty-keys)]))}) + -remove-empty-keys)]))}) (defmethod expand ::parameters [_ v acc _] (let [old (or (:parameters acc) []) From ba2fc9cf404c3dc5dc8db4784d2b1e4ae3a04ae8 Mon Sep 17 00:00:00 2001 From: Wes Morgan Date: Wed, 8 Mar 2023 09:29:43 -0700 Subject: [PATCH 70/86] Update test expectations for no leading : & ~1 --- test/malli/experimental/time/json_schema_test.cljc | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/malli/experimental/time/json_schema_test.cljc b/test/malli/experimental/time/json_schema_test.cljc index c13a2269b..7933b964f 100644 --- a/test/malli/experimental/time/json_schema_test.cljc +++ b/test/malli/experimental/time/json_schema_test.cljc @@ -8,10 +8,10 @@ (t/is (= {:type "object", :properties - {:date {:$ref "#/definitions/:time/local-date"}, - :time {:$ref "#/definitions/:time/offset-time"}, - :date-time {:$ref "#/definitions/:time/offset-date-time"}, - :duration {:$ref "#/definitions/:time/duration"}}, + {:date {:$ref "#/definitions/time~1local-date"}, + :time {:$ref "#/definitions/time~1offset-time"}, + :date-time {:$ref "#/definitions/time~1offset-date-time"}, + :duration {:$ref "#/definitions/time~1duration"}}, :required [:date :time :date-time :duration], :definitions #:time{:local-date {:type "string", :format "date"}, From 0da94b8c1bf1f2ea47e8ed0abdee63bd23c91957 Mon Sep 17 00:00:00 2001 From: Wes Morgan Date: Wed, 8 Mar 2023 10:02:21 -0700 Subject: [PATCH 71/86] Fix circular definition prevention comparison --- src/malli/json_schema.cljc | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/malli/json_schema.cljc b/src/malli/json_schema.cljc index 0be4d490e..877b20bb4 100644 --- a/src/malli/json_schema.cljc +++ b/src/malli/json_schema.cljc @@ -18,11 +18,10 @@ (defn -schema [schema {::keys [transform definitions] :as options}] (let [result (transform (m/deref schema) options)] (if-let [ref (m/-ref schema)] - (do - (when-not (and (contains? result :$ref) - (= (:$ref result) ref)) ; don't create circular defs + (let [ref* (-ref ref)] + (when-not (= ref* result) ; don't create circular definitions (swap! definitions assoc ref result)) - (-ref ref)) + ref*) result))) (defn select [m] (select-keys m [:title :description :default])) From 9e14bd2ecf98e06214ffd3aef0fabc34ebe273d9 Mon Sep 17 00:00:00 2001 From: Wes Morgan Date: Wed, 15 Mar 2023 09:35:11 -0600 Subject: [PATCH 72/86] Add a test for circular definitions avoidance ...in json-schema-test/references-test. Fix was in 23488b20ebe189b9eae43369b4799a8940978a05. --- test/malli/json_schema_test.cljc | 110 ++++++++++++++++--------------- 1 file changed, 58 insertions(+), 52 deletions(-) diff --git a/test/malli/json_schema_test.cljc b/test/malli/json_schema_test.cljc index a3d8b256c..1d5fe9bfc 100644 --- a/test/malli/json_schema_test.cljc +++ b/test/malli/json_schema_test.cljc @@ -234,58 +234,64 @@ {:registry registry})))))) (deftest references-test - (is (= {:$ref "#/definitions/Order", - :definitions {"Country" {:type "object", - :properties {:name {:type "string" - :enum [:FI :PO]}, - :neighbors {:type "array" - :items {:$ref "#/definitions/Country"}}}, - :required [:name :neighbors]}, - "Burger" {:type "object", - :properties {:name {:type "string"}, - :description {:type "string"}, - :origin {:oneOf [{:$ref "#/definitions/Country"} {:type "null"}]}, - :price {:type "integer" - :minimum 1}}, - :required [:name :origin :price]}, - "OrderLine" {:type "object", - :properties {:burger {:$ref "#/definitions/Burger"}, - :amount {:type "integer"}}, - :required [:burger :amount]}, - "Order" {:type "object", - :properties {:lines {:type "array" - :items {:$ref "#/definitions/OrderLine"}}, - :delivery {:type "object", - :properties {:delivered {:type "boolean"}, - :address {:type "object", - :properties {:street {:type "string"}, - :zip {:type "integer"}, - :country {:$ref "#/definitions/Country"}}, - :required [:street :zip :country]}}, - :required [:delivered :address]}}, - :required [:lines :delivery]}}} - (json-schema/transform - [:schema - {:registry {"Country" [:map - [:name [:enum :FI :PO]] - [:neighbors [:vector [:ref "Country"]]]] - "Burger" [:map - [:name string?] - [:description {:optional true} string?] - [:origin [:maybe "Country"]] - [:price pos-int?]] - "OrderLine" [:map - [:burger "Burger"] - [:amount int?]] - "Order" [:map - [:lines [:vector "OrderLine"]] - [:delivery [:map - [:delivered boolean?] - [:address [:map - [:street string?] - [:zip int?] - [:country "Country"]]]]]]}} - "Order"])))) + (testing "absolute doc root definitions are created for ref schemas" + (is (= {:$ref "#/definitions/Order", + :definitions {"Country" {:type "object", + :properties {:name {:type "string" + :enum [:FI :PO]}, + :neighbors {:type "array" + :items {:$ref "#/definitions/Country"}}}, + :required [:name :neighbors]}, + "Burger" {:type "object", + :properties {:name {:type "string"}, + :description {:type "string"}, + :origin {:oneOf [{:$ref "#/definitions/Country"} {:type "null"}]}, + :price {:type "integer" + :minimum 1}}, + :required [:name :origin :price]}, + "OrderLine" {:type "object", + :properties {:burger {:$ref "#/definitions/Burger"}, + :amount {:type "integer"}}, + :required [:burger :amount]}, + "Order" {:type "object", + :properties {:lines {:type "array" + :items {:$ref "#/definitions/OrderLine"}}, + :delivery {:type "object", + :properties {:delivered {:type "boolean"}, + :address {:type "object", + :properties {:street {:type "string"}, + :zip {:type "integer"}, + :country {:$ref "#/definitions/Country"}}, + :required [:street :zip :country]}}, + :required [:delivered :address]}}, + :required [:lines :delivery]}}} + (json-schema/transform + [:schema + {:registry {"Country" [:map + [:name [:enum :FI :PO]] + [:neighbors [:vector [:ref "Country"]]]] + "Burger" [:map + [:name string?] + [:description {:optional true} string?] + [:origin [:maybe "Country"]] + [:price pos-int?]] + "OrderLine" [:map + [:burger "Burger"] + [:amount int?]] + "Order" [:map + [:lines [:vector "OrderLine"]] + [:delivery [:map + [:delivered boolean?] + [:address [:map + [:street string?] + [:zip int?] + [:country "Country"]]]]]]}} + "Order"])))) + + (testing "circular definitions are not created" + (is (= {:$ref "#/definitions/Foo", :definitions {"Foo" {:type "integer"}}} + (json-schema/transform + (mu/closed-schema [:schema {:registry {"Foo" :int}} "Foo"])))))) (deftest function-schema-test (is (= {} (json-schema/transform [:=> [:cat int? int?] int?])))) From 1ab8cbacc5ec4ada084622f37d6fe576a97fcc53 Mon Sep 17 00:00:00 2001 From: Wes Morgan Date: Wed, 15 Mar 2023 13:44:16 -0600 Subject: [PATCH 73/86] Add tests for swagger/swagger-spec ...including one commented-out failing test that should pass once issue #464 is fixed. --- test/malli/swagger_test.cljc | 139 +++++++++++++++++++++++++++++++++++ 1 file changed, 139 insertions(+) diff --git a/test/malli/swagger_test.cljc b/test/malli/swagger_test.cljc index 4d112f944..628f714af 100644 --- a/test/malli/swagger_test.cljc +++ b/test/malli/swagger_test.cljc @@ -276,3 +276,142 @@ [:zip int?] [:country "Country"]]]]]]}} "Order"])))) + +(deftest swagger-spec-test + (testing "generates swagger for ::parameters w/ basic schema" + (let [registry (merge (m/type-schemas) + {::body [:string {:min 1}]})] + (is (= {:definitions {::body {:minLength 1, :type "string"}}, + :parameters [{:description "", + :in "body", + :name "body", + :required true, + :schema {:$ref "#/definitions/malli.swagger-test~1body", + :definitions {::body {:minLength 1, :type "string"}}}}]} + (swagger/swagger-spec {::swagger/parameters + {:body (m/schema ::body + {:registry registry})}}))))) + + (testing "generates swagger for ::responses w/ basic schema" + (let [registry (merge (m/base-schemas) (m/type-schemas) + {::success [:map-of :keyword :string] + ::error [:string {:min 1}]})] + (is (= {:definitions {::error {:minLength 1, :type "string"}, + ::success {:additionalProperties {:type "string"}, + :type "object"}}, + :responses {200 {:description "", + :schema {:$ref "#/definitions/malli.swagger-test~1success", + :definitions {::success {:additionalProperties {:type "string"}, + :type "object"}}}}, + 400 {:description "", + :schema {:$ref "#/definitions/malli.swagger-test~1error", + :definitions {::error {:minLength 1, :type "string"}}}}}} + (swagger/swagger-spec {::swagger/responses + {200 {:schema (m/schema ::success + {:registry registry})} + 400 {:schema (m/schema ::error + {:registry registry})}}}))))) + + (testing "generates swagger for ::parameters and ::responses w/ basic schema" + (let [registry (merge (m/base-schemas) (m/type-schemas) (m/comparator-schemas) + {::req-body [:map-of :keyword :any] + ::success-resp [:map [:it [:= "worked"]]] + ::error-resp [:string {:min 1}]})] + (is (= {:definitions {::error-resp {:minLength 1, :type "string"}, + ::req-body {:additionalProperties {}, :type "object"}, + ::success-resp {:properties {:it {:const "worked"}}, + :required [:it], + :type "object"}}, + :parameters [{:description "", + :in "body", + :name "body", + :required true, + :schema {:$ref "#/definitions/malli.swagger-test~1req-body", + :definitions {::req-body {:additionalProperties {}, + :type "object"}}}}], + :responses {200 {:description "", + :schema {:$ref "#/definitions/malli.swagger-test~1success-resp", + :definitions {::success-resp {:properties {:it {:const "worked"}}, + :required [:it], + :type "object"}}}}, + 400 {:description "", + :schema {:$ref "#/definitions/malli.swagger-test~1error-resp", + :definitions {::error-resp {:minLength 1, + :type "string"}}}}}} + (swagger/swagger-spec {::swagger/parameters + {:body (m/schema ::req-body + {:registry registry})} + ::swagger/responses + {200 {:schema (m/schema ::success-resp + {:registry registry})} + 400 {:schema (m/schema ::error-resp + {:registry registry})}}}))))) + + ;; This test currently fails due to https://github.com/metosin/malli/issues/464 + ;; TODO: Uncomment it when #464 is fixed + #_(testing "generates swagger for ::parameters and ::responses w/ recursive schema" + (let [registry (merge (m/base-schemas) (m/type-schemas) + (m/comparator-schemas) (m/sequence-schemas) + {::a [:or + :string + [:ref ::b]] + ::b [:or + :keyword + [:ref ::c]] + ::c [:or + :symbol + [:ref ::a]] + ;; test would pass if the schema below were e.g. + ;; [:map [:a ::a] [:b ::b] [:c ::c]] (and the + ;; ::req-body expected adjusted accordingly) + ;; b/c then ::b & ::c would be directly used, not just refs + ::req-body [:map [:a ::a]] + ::success-resp [:map-of :keyword :string] + ::error-resp :string})] + (is (= {:definitions {::a {:type "string", + :x-anyOf [{:type "string"} + {:$ref "#/definitions/malli.swagger-test~1b"}]}, + ::b {:type "string" + :x-anyOf [{:type "string"} + {:$ref "#/definitions/malli.swagger-test~1c"}]} + ::c {:type "string" + :x-anyOf [{:type "string"} + {:$ref "#/definitions/malli.swagger-test~1a"}]} + ::error-resp {:type "string"}, + ::req-body {:properties {:a {:$ref "#/definitions/malli.swagger-test~1a"}}, + :required [:a], + :type "object"}, + ::success-resp {:additionalProperties {:type "string"}, + :type "object"}}, + :parameters [{:description "", + :in "body", + :name "body", + :required true, + :schema {:$ref "#/definitions/malli.swagger-test~1req-body", + :definitions {::a {:type "string", + :x-anyOf [{:type "string"} + {:$ref "#/definitions/malli.swagger-test~1b"}]}, + ::b {:type "string" + :x-anyOf [{:type "string"} + {:$ref "#/definitions/malli.swagger-test~1c"}]} + ::c {:type "string" + :x-anyOf [{:type "string"} + {:$ref "#/definitions/malli.swagger-test~1a"}]} + ::req-body {:properties {:a {:$ref "#/definitions/malli.swagger-test~1a"}}, + :required [:a], + :type "object"}}}}], + :responses {200 {:description "", + :schema {:$ref "#/definitions/malli.swagger-test~1success-resp", + :definitions {:malli.swagger-test/success-resp {:additionalProperties {:type "string"}, + :type "object"}}}}, + 400 {:description "", + :schema {:$ref "#/definitions/malli.swagger-test~1error-resp", + :definitions {:malli.swagger-test/error-resp {:type "string"}}}}}} + (swagger/swagger-spec {::swagger/parameters + {:body (m/schema ::req-body + {:registry registry})} + ::swagger/responses + {200 {:schema (m/schema ::success-resp + {:registry registry})} + 400 {:schema (m/schema ::error-resp + {:registry registry})}}})))))) From a4a489dfb036fc7fca5647670587b1fee9d747ee Mon Sep 17 00:00:00 2001 From: Wes Morgan Date: Thu, 16 Mar 2023 10:21:48 -0600 Subject: [PATCH 74/86] Add a swagger-spec test w/o a registry --- test/malli/swagger_test.cljc | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/test/malli/swagger_test.cljc b/test/malli/swagger_test.cljc index 628f714af..3ab8683a7 100644 --- a/test/malli/swagger_test.cljc +++ b/test/malli/swagger_test.cljc @@ -278,7 +278,22 @@ "Order"])))) (deftest swagger-spec-test - (testing "generates swagger for ::parameters w/ basic schema" + (testing "generates swagger for ::parameters and ::responses w/ basic schema" + (is (= {:definitions nil, + :parameters [{:description "", + :in "body", + :name "body", + :required true, + :schema {:properties {:foo {:type "string"}} + :required [:foo], :type "object"}}], + :responses {200 {:description "", + :schema {:properties {:bar {:type "string"}} + :required [:bar], :type "object"}}}} + (swagger/swagger-spec {::swagger/parameters + {:body [:map [:foo :string]]} + ::swagger/responses + {200 {:schema [:map [:bar :keyword]]}}})))) + (testing "generates swagger for ::parameters w/ basic schema + registry" (let [registry (merge (m/type-schemas) {::body [:string {:min 1}]})] (is (= {:definitions {::body {:minLength 1, :type "string"}}, @@ -292,7 +307,7 @@ {:body (m/schema ::body {:registry registry})}}))))) - (testing "generates swagger for ::responses w/ basic schema" + (testing "generates swagger for ::responses w/ basic schema + registry" (let [registry (merge (m/base-schemas) (m/type-schemas) {::success [:map-of :keyword :string] ::error [:string {:min 1}]})] @@ -312,7 +327,7 @@ 400 {:schema (m/schema ::error {:registry registry})}}}))))) - (testing "generates swagger for ::parameters and ::responses w/ basic schema" + (testing "generates swagger for ::parameters and ::responses w/ basic schema + registry" (let [registry (merge (m/base-schemas) (m/type-schemas) (m/comparator-schemas) {::req-body [:map-of :keyword :any] ::success-resp [:map [:it [:= "worked"]]] @@ -349,7 +364,7 @@ ;; This test currently fails due to https://github.com/metosin/malli/issues/464 ;; TODO: Uncomment it when #464 is fixed - #_(testing "generates swagger for ::parameters and ::responses w/ recursive schema" + #_(testing "generates swagger for ::parameters and ::responses w/ recursive schema + registry" (let [registry (merge (m/base-schemas) (m/type-schemas) (m/comparator-schemas) (m/sequence-schemas) {::a [:or From 06495d61370983ee2cd5b814c9e5f647c1d8569a Mon Sep 17 00:00:00 2001 From: Joel Kaasinen Date: Fri, 17 Mar 2023 16:10:22 +0200 Subject: [PATCH 75/86] doc: add some citations for ~1 encoding --- src/malli/json_schema.cljc | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/malli/json_schema.cljc b/src/malli/json_schema.cljc index 877b20bb4..80b5a91a5 100644 --- a/src/malli/json_schema.cljc +++ b/src/malli/json_schema.cljc @@ -10,6 +10,8 @@ (defn -ref [x] {:$ref (apply str "#/definitions/" (cond ;; / must be encoded as ~1 in JSON Schema + ;; https://json-schema.org/draft/2019-09/relative-json-pointer.html + ;; https://www.rfc-editor.org/rfc/rfc6901 (qualified-keyword? x) [(namespace x) "~1" (name x)] (keyword? x) [(name x)] From db3606f2f543632db8f0bf654028326b8e16aa04 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sat, 18 Mar 2023 19:33:29 +0200 Subject: [PATCH 76/86] format --- test/malli/util_test.cljc | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/test/malli/util_test.cljc b/test/malli/util_test.cljc index c8fa34207..2193aefa4 100644 --- a/test/malli/util_test.cljc +++ b/test/malli/util_test.cljc @@ -1,6 +1,6 @@ (ns malli.util-test (:require [clojure.test :refer [are deftest is testing]] - #?(:bb [cheshire.core :as json] + #?(:bb [cheshire.core :as json] :clj [jsonista.core :as json]) [malli.core :as m] [malli.impl.util :as miu] @@ -8,11 +8,11 @@ [malli.util :as mu])) #?(:clj (defn from-json [s] - #?(:bb (json/parse-string s) + #?(:bb (json/parse-string s) :clj (json/read-value s)))) #?(:clj (defn to-json [x] - #?(:bb (json/generate-string x) + #?(:bb (json/generate-string x) :clj (json/write-value-as-string x)))) (defn form= [& ?schemas] @@ -535,13 +535,13 @@ :c "a string"})))))) (deftest transform-entries-test - (let [registry (mr/composite-registry {:a/x int?} (m/default-schemas)) - options {:registry registry} + (let [registry (mr/composite-registry {:a/x int?} (m/default-schemas)) + options {:registry registry} key->key-transform #(map (fn [[k m _]] [k m k]) %) - schema [:map [:a/x {:m true} int?]] + schema [:map [:a/x {:m true} int?]] schema-with-options (m/schema schema options) - result-schema (m/schema [:map [:a/x {:m true} :a/x]] options)] + result-schema (m/schema [:map [:a/x {:m true} :a/x]] options)] (testing "manual options are preserved in output type from the transform" (is (mu/equals @@ -1013,27 +1013,27 @@ ff (conj f -f) tt (conj t -t)] (testing "every pred behaves like and: one false => result is false" - (is (true? ((miu/-every-pred [-t]) nil))) + (is (true? ((miu/-every-pred [-t]) nil))) (is (false? ((miu/-every-pred [-f]) nil))) - (is (true? ((miu/-every-pred t) nil))) + (is (true? ((miu/-every-pred t) nil))) (is (false? ((miu/-every-pred f) nil))) (is (false? ((miu/-every-pred t+f) nil))) (is (false? ((miu/-every-pred f+t) nil))) (is (false? ((miu/-every-pred tf) nil))) (is (false? ((miu/-every-pred ft) nil))) (is (false? ((miu/-every-pred ff) nil))) - (is (true? ((miu/-every-pred tt) nil)))) + (is (true? ((miu/-every-pred tt) nil)))) (testing "some pred behaves like or: one true => result is true" - (is (true? ((miu/-some-pred [-t]) nil))) + (is (true? ((miu/-some-pred [-t]) nil))) (is (false? ((miu/-some-pred [-f]) nil))) - (is (true? ((miu/-some-pred t) nil))) + (is (true? ((miu/-some-pred t) nil))) (is (false? ((miu/-some-pred f) nil))) - (is (true? ((miu/-some-pred t+f) nil))) - (is (true? ((miu/-some-pred f+t) nil))) - (is (true? ((miu/-some-pred tf) nil))) - (is (true? ((miu/-some-pred ft) nil))) + (is (true? ((miu/-some-pred t+f) nil))) + (is (true? ((miu/-some-pred f+t) nil))) + (is (true? ((miu/-some-pred tf) nil))) + (is (true? ((miu/-some-pred ft) nil))) (is (false? ((miu/-some-pred ff) nil))) - (is (true? ((miu/-some-pred tt) nil))))))) + (is (true? ((miu/-some-pred tt) nil))))))) (deftest explain-data-test (let [schema (m/schema [:map [:a [:vector [:maybe :string]]]]) From 40c915a90ca66479ab680fd3ae0e263d3372e007 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sat, 18 Mar 2023 19:34:59 +0200 Subject: [PATCH 77/86] fix #874 --- src/malli/core.cljc | 3 +-- test/malli/util_test.cljc | 10 ++++++++++ 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 2636593b6..bb0682433 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -385,8 +385,7 @@ ;; update (-simple-entry-parser keyset (assoc children i c) (assoc forms i f)) ;; assoc - (let [size (inc (count keyset))] - (-simple-entry-parser (assoc keyset k size) (conj children c) (conj forms f)))))))) + (-simple-entry-parser (assoc keyset k {:order (count keyset)}) (conj children c) (conj forms f))))))) (defn -set-entries ([schema ?key value] diff --git a/test/malli/util_test.cljc b/test/malli/util_test.cljc index 2193aefa4..725e62f95 100644 --- a/test/malli/util_test.cljc +++ b/test/malli/util_test.cljc @@ -1074,3 +1074,13 @@ "schema" ["map" ["a" ["vector" ["maybe" "string"]]]] "value" {"a" [true]}} (from-json (to-json (mu/explain-data schema input-2))))))))) + +(deftest test-874 + (is (form= [:map {:closed true} + [:foo [:map {:closed true} + [:bar :int] + [:baz :int]]]] + (-> [:map] + (mu/assoc-in [:foo :bar] :int) + (mu/assoc-in [:foo :baz] :int) + (mu/closed-schema))))) From 42c724495511569fadbaf771732dda0c19ce2ade Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sat, 18 Mar 2023 19:36:41 +0200 Subject: [PATCH 78/86] CHANGELOG --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index f6e7c6da6..bfd6a90b1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -22,6 +22,7 @@ Malli is in well matured [alpha](README.md#alpha). * `m/explicit-keys` to get a vector of explicit keys from entry schemas (no `::m/default` * `mt/strip-extra-keys-transformer` works with `:map-of` schemas * Simplify content-dependent schema creation with `m/-simple-schema` and `m/-collection-schema` via new 3-arity `:compile` function of type `children properties options -> props`. Old 2-arity top-level callback function is `m/deprecated!` and support for it will be removed in future versions. [#866](https://github.com/metosin/malli/pull/866) +* FIX Repeated calls to `malli.util/assoc-`in referencing non-existing maps fail [#874](https://github.com/metosin/malli/issues/874) ## 0.10.2 (2023-03-05) From 2524fd39fa076d4121374539b2384098f893577c Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sat, 18 Mar 2023 19:51:19 +0200 Subject: [PATCH 79/86] 0.10.3 --- CHANGELOG.md | 32 ++++++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index bfd6a90b1..67427eb04 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,15 +14,35 @@ We use [Break Versioning][breakver]. The version numbers follow a `. true +``` + +* `mt/strip-extra-keys-transformer` works with `:map-of`. + +```clojure +(m/decode + [:map-of :int :int] + {1 1, 2 "2", "3" 3, "4" "4"} + (mt/strip-extra-keys-transformer)) +; => {1 1} +``` -* Add support for default/fallback branch for `:map` - [#871](https://github.com/metosin/malli/pull/871), [docs](README.md#map-with-default-schemas) * `m/default-schema` to pull the `::m/default` schema from entry schemas -* `m/explicit-keys` to get a vector of explicit keys from entry schemas (no `::m/default` -* `mt/strip-extra-keys-transformer` works with `:map-of` schemas +* `m/explicit-keys` to get a vector of explicit keys from entry schemas (no `::m/default`) * Simplify content-dependent schema creation with `m/-simple-schema` and `m/-collection-schema` via new 3-arity `:compile` function of type `children properties options -> props`. Old 2-arity top-level callback function is `m/deprecated!` and support for it will be removed in future versions. [#866](https://github.com/metosin/malli/pull/866) -* FIX Repeated calls to `malli.util/assoc-`in referencing non-existing maps fail [#874](https://github.com/metosin/malli/issues/874) +* FIX Repeated calls to `malli.util/assoc-in` referencing non-existing maps fail [#874](https://github.com/metosin/malli/issues/874) ## 0.10.2 (2023-03-05) From 9fcc8c0885c69423bf4a5906139c2558006079e0 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sat, 18 Mar 2023 19:55:56 +0200 Subject: [PATCH 80/86] Update deps --- CHANGELOG.md | 5 +++++ deps.edn | 16 ++++++++-------- pom.xml | 6 +++--- 3 files changed, 16 insertions(+), 11 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 67427eb04..186fc9a6b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -43,6 +43,11 @@ Malli is in well matured [alpha](README.md#alpha). * `m/explicit-keys` to get a vector of explicit keys from entry schemas (no `::m/default`) * Simplify content-dependent schema creation with `m/-simple-schema` and `m/-collection-schema` via new 3-arity `:compile` function of type `children properties options -> props`. Old 2-arity top-level callback function is `m/deprecated!` and support for it will be removed in future versions. [#866](https://github.com/metosin/malli/pull/866) * FIX Repeated calls to `malli.util/assoc-in` referencing non-existing maps fail [#874](https://github.com/metosin/malli/issues/874) +* Updated dependencies: + +```clojure +borkdude/edamame 1.1.17 -> 1.3.20 +``` ## 0.10.2 (2023-03-05) diff --git a/deps.edn b/deps.edn index b7e97b1a0..d60230e08 100644 --- a/deps.edn +++ b/deps.edn @@ -1,7 +1,7 @@ {:paths ["src" "resources"] :deps {org.clojure/clojure {:mvn/version "1.11.1"} borkdude/dynaload {:mvn/version "0.3.5"} - borkdude/edamame {:mvn/version "1.1.17"} + borkdude/edamame {:mvn/version "1.3.20"} org.clojure/test.check {:mvn/version "1.1.1"} ;; pretty errors, optional deps fipp/fipp {:mvn/version "0.6.26"} @@ -10,11 +10,11 @@ :extra-deps {com.gfredericks/test.chuck {:mvn/version "0.2.14"} lambdaisland/kaocha {:mvn/version "1.80.1274"} lambdaisland/kaocha-cljs {:mvn/version "1.4.130"} - org.babashka/sci {:mvn/version "0.7.38"} + org.babashka/sci {:mvn/version "0.7.39"} lambdaisland/kaocha-junit-xml {:mvn/version "1.17.101"} metosin/spec-tools {:mvn/version "0.10.5"} spec-provider/spec-provider {:mvn/version "0.4.14"} - metosin/schema-tools {:mvn/version "0.12.3"} + metosin/schema-tools {:mvn/version "0.13.0"} metosin/jsonista {:mvn/version "0.3.7"} prismatic/schema {:mvn/version "1.4.1"} minimallist/minimallist {:mvn/version "0.0.10"} @@ -24,14 +24,14 @@ lambdaisland/deep-diff {:mvn/version "0.0-47"} com.bhauman/spell-spec {:mvn/version "0.1.2"} org.clojure/spec-alpha2 {:git/url "https://github.com/clojure/spec-alpha2.git" - :sha "3d32b5e571b98e2930a7b2ed1dd9551bb269375a"}}} + :sha "46b183d19984cafb655647f212bfa286b4d0dc63"}}} :cljs-test-runner {:extra-deps {olical/cljs-test-runner {:mvn/version "3.8.0"} ; used only to pull in its externs file needed to compile js-joda types under advanced compilation com.widdindustries/cljs.java-time {:mvn/version "0.1.20"}} :extra-paths ["test" "cljs-test-runner-out/gen"] :main-opts ["-m" "cljs-test-runner.main" "-d" "test"]} - :sci {:extra-deps {org.babashka/sci {:mvn/version "0.7.38"}}} - :build {:deps {io.github.clojure/tools.build {:git/tag "v0.9.3" :git/sha "e537cd1"}} + :sci {:extra-deps {org.babashka/sci {:mvn/version "0.7.39"}}} + :build {:deps {io.github.clojure/tools.build {:git/tag "v0.9.4" :git/sha "76b78fe"}} :ns-default build} :jmh {:paths ["target/uber.jar" "classes"] :deps {jmh-clojure/jmh-clojure {:mvn/version "0.4.1"} @@ -44,7 +44,7 @@ org.clojure/tools.namespace {:mvn/version "RELEASE"}}} :shadow {:extra-paths ["app"] - :extra-deps {thheller/shadow-cljs {:mvn/version "2.21.0"} + :extra-deps {thheller/shadow-cljs {:mvn/version "2.22.2"} binaryage/devtools {:mvn/version "1.0.6"}}} :slow {:extra-deps {io.dominic/slow-namespace-clj {:git/url "https://git.sr.ht/~severeoverfl0w/slow-namespace-clj" @@ -64,7 +64,7 @@ "malli.jar"]} :graalvm {:extra-paths ["graal-test/src"] :extra-deps {org.clojure/clojure {:mvn/version "1.11.1"} - org.babashka/sci {:mvn/version "0.7.38"}}} + org.babashka/sci {:mvn/version "0.7.39"}}} :perf {:extra-paths ["perf"] :extra-deps {criterium/criterium {:mvn/version "0.4.6"} org.clojure/clojure {:mvn/version "1.11.1"} diff --git a/pom.xml b/pom.xml index c8930e44b..a04dec34f 100644 --- a/pom.xml +++ b/pom.xml @@ -3,7 +3,7 @@ 4.0.0 metosin malli - 0.10.2 + 0.10.3 malli @@ -15,7 +15,7 @@ https://github.com/metosin/malli scm:git:git://github.com/metosin/malli.git scm:git:ssh://git@github.com/metosin/malli.git - 0.10.2 + 0.10.3 @@ -36,7 +36,7 @@ borkdude edamame - 1.1.17 + 1.3.20 org.clojure From 576b3ae824d856e467efc140267deec2dc6cb275 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sun, 19 Mar 2023 15:37:05 +0200 Subject: [PATCH 81/86] remove println, fail on reitit --- src/malli/swagger.cljc | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/malli/swagger.cljc b/src/malli/swagger.cljc index de03f6832..405d979cd 100644 --- a/src/malli/swagger.cljc +++ b/src/malli/swagger.cljc @@ -84,9 +84,7 @@ :schema swagger-schema}])) (defmethod extract-parameter :default [in schema] - (let [{:keys [properties required definitions]} (transform schema {:in in, :type :parameter})] - (println "\nextract-parameter definitions:" - (with-out-str (clojure.pprint/pprint definitions))) + (let [{:keys [properties required]} (transform schema {:in in, :type :parameter})] (mapv (fn [[k {:keys [type] :as schema}]] (merge From ff23346b56d72a22e1310bee29e9f7fc180dd27a Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sun, 19 Mar 2023 15:37:49 +0200 Subject: [PATCH 82/86] format --- src/malli/dev/pretty.cljc | 2 +- src/malli/experimental/time.cljc | 2 +- src/malli/experimental/time/generator.cljc | 66 ++++++++-------- src/malli/experimental/time/transform.cljc | 8 +- src/malli/impl/regex.cljc | 28 +++---- src/malli/instrument.clj | 48 ++++++------ src/malli/instrument.cljs | 42 +++++------ src/malli/instrument/cljs.clj | 78 +++++++++---------- src/malli/sci.cljc | 6 +- src/malli/swagger.cljc | 88 +++++++++++----------- test/malli/swagger_test.cljc | 32 ++++---- 11 files changed, 200 insertions(+), 200 deletions(-) diff --git a/src/malli/dev/pretty.cljc b/src/malli/dev/pretty.cljc index 8387c438d..3fb0e6855 100644 --- a/src/malli/dev/pretty.cljc +++ b/src/malli/dev/pretty.cljc @@ -77,7 +77,7 @@ (-> (ex-info (str type) {:type type :data data}) (v/-exception-doc printer) (v/-print-doc printer) - #?(:cljs (-> with-out-str println)))))) + #?(:cljs (-> with-out-str println)))))) (defn thrower ([] (thrower (-printer))) diff --git a/src/malli/experimental/time.cljc b/src/malli/experimental/time.cljc index cc4fcfdfc..da98634e6 100644 --- a/src/malli/experimental/time.cljc +++ b/src/malli/experimental/time.cljc @@ -53,7 +53,7 @@ #?(:cljs (defn createTemporalQuery [f] (let [parent (TemporalQuery. "") - query (js/Object.create parent)] + query (js/Object.create parent)] (set! (.-queryFrom query) (fn [t] (f t))) query))) diff --git a/src/malli/experimental/time/generator.cljc b/src/malli/experimental/time/generator.cljc index 15cacafb1..d4e2ae206 100644 --- a/src/malli/experimental/time/generator.cljc +++ b/src/malli/experimental/time/generator.cljc @@ -3,7 +3,7 @@ [clojure.spec.gen.alpha :as ga] [malli.core :as m] [malli.generator :as mg] - #?(:clj [malli.experimental.time :as time] + #?(:clj [malli.experimental.time :as time] :cljs [malli.experimental.time :as time :refer [Duration LocalDate LocalDateTime LocalTime Instant OffsetTime ZonedDateTime OffsetDateTime ZoneId ZoneOffset]])) #?(:clj (:import (java.time Duration LocalDate LocalDateTime LocalTime Instant OffsetTime ZonedDateTime OffsetDateTime ZoneId ZoneOffset)))) @@ -15,35 +15,35 @@ (defmethod mg/-schema-generator :time/zone-id [_schema _options] zone-id-gen) -#?(:clj (def ^:const ^:private seconds-in-day 86400) +#?(:clj (def ^:const ^:private seconds-in-day 86400) :cljs (def ^:private seconds-in-day 86400)) (defn -to-long ^long [o] (cond (instance? Instant o) (.toEpochMilli ^Instant o) - (instance? LocalDate o) (.toEpochDay ^LocalDate o) - (instance? LocalTime o) (.toSecondOfDay ^LocalTime o) - (instance? ZoneOffset o) #?(:clj (.getTotalSeconds ^ZoneOffset o) - :cljs (.totalSeconds ^ZoneOffset o)) - (instance? LocalDateTime o) - (unchecked-add - (unchecked-multiply (.toEpochDay (.toLocalDate ^LocalDateTime o)) seconds-in-day) - (-to-long (.toLocalTime ^LocalDateTime o))) - (instance? OffsetDateTime o) (.toEpochMilli (.toInstant ^OffsetDateTime o)) - (instance? ZonedDateTime o) (.toEpochMilli (.toInstant ^ZonedDateTime o)) - (instance? Duration o) (.toNanos ^Duration o) - (int? o) (long o))) + (instance? LocalDate o) (.toEpochDay ^LocalDate o) + (instance? LocalTime o) (.toSecondOfDay ^LocalTime o) + (instance? ZoneOffset o) #?(:clj (.getTotalSeconds ^ZoneOffset o) + :cljs (.totalSeconds ^ZoneOffset o)) + (instance? LocalDateTime o) + (unchecked-add + (unchecked-multiply (.toEpochDay (.toLocalDate ^LocalDateTime o)) seconds-in-day) + (-to-long (.toLocalTime ^LocalDateTime o))) + (instance? OffsetDateTime o) (.toEpochMilli (.toInstant ^OffsetDateTime o)) + (instance? ZonedDateTime o) (.toEpochMilli (.toInstant ^ZonedDateTime o)) + (instance? Duration o) (.toNanos ^Duration o) + (int? o) (long o))) (defn to-long [o] (when o (-to-long o))) (defn -min-max [schema options] (let [{:keys [min max] gen-min :gen/min gen-max :gen/max} (merge - (m/type-properties schema options) - (m/properties schema options)) + (m/type-properties schema options) + (m/properties schema options)) {:keys [accessor] :or {accessor identity}} options as-long #(when % (to-long (accessor %))) - min (as-long min) max (as-long max) gen-min (as-long gen-min) gen-max (as-long gen-max)] + min (as-long min) max (as-long max) gen-min (as-long gen-min) gen-max (as-long gen-max)] (when (and min gen-min (< gen-min min)) (m/-fail! ::mg/invalid-property {:key :gen/min, :value gen-min, :min min})) (when (and max gen-max (> gen-max max)) @@ -64,7 +64,7 @@ (-instant-gen schema options)) (comment - (gen/sample (mg/-schema-generator (time/-instant-schema) nil))) + (gen/sample (mg/-schema-generator (time/-instant-schema) nil))) (defmethod mg/-schema-generator :time/local-date [schema options] (ga/fmap #(. LocalDate ofEpochDay %) (gen/large-integer* (-min-max schema options)))) @@ -76,46 +76,46 @@ (-local-time-gen schema options)) (comment - (gen/sample (mg/-schema-generator (time/-local-time-schema) nil))) + (gen/sample (mg/-schema-generator (time/-local-time-schema) nil))) (defn -offset-time-gen [schema options] - (let [local-opts (assoc options :accessor #(.toLocalTime ^OffsetTime %)) + (let [local-opts (assoc options :accessor #(.toLocalTime ^OffsetTime %)) zone-opts #?(:clj (assoc options :accessor #(- (.getTotalSeconds (.getOffset ^OffsetTime %)))) :cljs (assoc options :accessor #(- (.totalSeconds (.offset ^js %))))) - offset-gen (-zone-offset-gen schema zone-opts)] + offset-gen (-zone-offset-gen schema zone-opts)] (ga/bind - (-local-time-gen schema local-opts) - (fn [local-time] - (ga/fmap #(. OffsetTime of local-time %) offset-gen))))) + (-local-time-gen schema local-opts) + (fn [local-time] + (ga/fmap #(. OffsetTime of local-time %) offset-gen))))) (defmethod mg/-schema-generator :time/offset-time [schema options] (-offset-time-gen schema options)) (comment - (gen/sample (mg/-schema-generator (time/-offset-time-schema) nil))) + (gen/sample (mg/-schema-generator (time/-offset-time-schema) nil))) (defmethod mg/-schema-generator :time/local-date-time [schema options] (gen/fmap - (fn [n] - (. LocalDateTime of + (fn [n] + (. LocalDateTime of (. LocalDate ofEpochDay (quot n seconds-in-day)) (. LocalTime ofSecondOfDay (mod n seconds-in-day)))) - (gen/large-integer* (-min-max schema options)))) + (gen/large-integer* (-min-max schema options)))) (comment - (gen/sample (mg/-schema-generator (time/-local-date-time-schema) nil) 1000)) + (gen/sample (mg/-schema-generator (time/-local-date-time-schema) nil) 1000)) (defn -zoned-date-time-gen [schema options] (gen/bind - (-instant-gen schema options) - (fn [instant] - (gen/fmap #(. ZonedDateTime ofInstant instant %) zone-id-gen)))) + (-instant-gen schema options) + (fn [instant] + (gen/fmap #(. ZonedDateTime ofInstant instant %) zone-id-gen)))) (defmethod mg/-schema-generator :time/zoned-date-time [schema options] (-zoned-date-time-gen schema options)) (comment - (gen/sample (mg/-schema-generator (time/-zoned-date-time-schema) nil) 100)) + (gen/sample (mg/-schema-generator (time/-zoned-date-time-schema) nil) 100)) (defn -offset-date-time-gen [schema options] (gen/fmap #(. OffsetDateTime from %) (-zoned-date-time-gen schema options))) diff --git a/src/malli/experimental/time/transform.cljc b/src/malli/experimental/time/transform.cljc index 93fa62424..9f21ad907 100644 --- a/src/malli/experimental/time/transform.cljc +++ b/src/malli/experimental/time/transform.cljc @@ -1,9 +1,9 @@ (ns malli.experimental.time.transform (:require [malli.transform :as mt :refer [-safe]] [malli.core :as m] - #?(:cljs [malli.experimental.time :as time - :refer [Duration LocalDate LocalDateTime LocalTime Instant OffsetTime ZonedDateTime OffsetDateTime ZoneId ZoneOffset - TemporalAccessor TemporalQuery DateTimeFormatter createTemporalQuery]])) + #?(:cljs [malli.experimental.time :as time + :refer [Duration LocalDate LocalDateTime LocalTime Instant OffsetTime ZonedDateTime OffsetDateTime ZoneId ZoneOffset + TemporalAccessor TemporalQuery DateTimeFormatter createTemporalQuery]])) #?(:clj (:import (java.time Duration LocalDate LocalDateTime LocalTime Instant ZonedDateTime OffsetDateTime ZoneId OffsetTime ZoneOffset) (java.time.temporal TemporalAccessor TemporalQuery) @@ -30,7 +30,7 @@ (defn ->formatter [x] (cond (instance? DateTimeFormatter x) x - #?(:clj (instance? String x) + #?(:clj (instance? String x) :cljs (string? x)) (. DateTimeFormatter ofPattern x) :else (throw (ex-info "Invalid formatter" {:formatter x :type (type x)})))) diff --git a/src/malli/impl/regex.cljc b/src/malli/impl/regex.cljc index d80a8f627..7730d029c 100644 --- a/src/malli/impl/regex.cljc +++ b/src/malli/impl/regex.cljc @@ -35,7 +35,7 @@ (:refer-clojure :exclude [+ * repeat cat]) (:require [malli.impl.util :as miu]) - #?(:bb (:import [java.util ArrayDeque]) + #?(:bb (:import [java.util ArrayDeque]) :clj (:import [java.util ArrayDeque] [clojure.lang Util Murmur3] [java.lang.reflect Array]))) @@ -453,14 +453,14 @@ ;; Custom hash set so that Cljs Malli users can have decent perf without having to to set up Closure ES6 Set polyfill. ;; Uses quadratic probing with power-of-two sizes and triangular numbers, what a nice trick! (deftype Cache - #?(:clj [^:unsynchronized-mutable ^"[Ljava.lang.Object;" values, ^:unsynchronized-mutable ^long size] - :cljs [^:mutable values, ^:mutable size]) + #?(:clj [^:unsynchronized-mutable ^"[Ljava.lang.Object;" values, ^:unsynchronized-mutable ^long size] + :cljs [^:mutable values, ^:mutable size]) ICache (ensure-cached! [_ f pos regs] (when (> (unchecked-inc size) (bit-shift-right (alength values) 1)) ; potential new load factor > 0.5 ;; Rehash: (let [capacity* (bit-shift-left (alength values) 1) - ^objects values* #?(:bb (object-array capacity*) + ^objects values* #?(:bb (object-array capacity*) :clj (Array/newInstance Object capacity*) :cljs (object-array capacity*)) max-index (unchecked-dec capacity*)] @@ -485,8 +485,8 @@ max-index (unchecked-dec capacity) #?@(:clj [pos (.longValue ^Long pos)]) ;; Unfortunately `hash-combine` hashes its second argument on clj and neither argument on cljs: - h #?(:bb (-> (hash f) (hash-combine pos) (hash-combine regs)) - :clj (-> (.hashCode ^Object f) (Util/hashCombine (Murmur3/hashLong pos)) (Util/hashCombine (Util/hash regs))) + h #?(:bb (-> (hash f) (hash-combine pos) (hash-combine regs)) + :clj (-> (.hashCode ^Object f) (Util/hashCombine (Murmur3/hashLong pos)) (Util/hashCombine (Util/hash regs))) :cljs (-> (hash f) (hash-combine (hash pos)) (hash-combine (hash regs))))] (loop [i (bit-and h max-index), collisions 0] (if-some [^CacheEntry entry (aget values i)] @@ -507,8 +507,8 @@ #?(:clj (set! *unchecked-math* false)) (deftype ^:private CheckDriver - #?(:clj [^:unsynchronized-mutable ^boolean success, ^ArrayDeque stack, cache] - :cljs [^:mutable success, stack, cache]) + #?(:clj [^:unsynchronized-mutable ^boolean success, ^ArrayDeque stack, cache] + :cljs [^:mutable success, stack, cache]) Driver (succeed! [_] (set! success (boolean true))) @@ -522,9 +522,9 @@ (noncaching-park-validator! self validator regs pos coll k)))) (deftype ^:private ParseDriver - #?(:clj [^:unsynchronized-mutable ^boolean success, ^ArrayDeque stack, cache - ^:unsynchronized-mutable result] - :cljs [^:mutable success, stack, cache, ^:mutable result]) + #?(:clj [^:unsynchronized-mutable ^boolean success, ^ArrayDeque stack, cache + ^:unsynchronized-mutable result] + :cljs [^:mutable success, stack, cache, ^:mutable result]) Driver (succeed! [_] (set! success (boolean true))) @@ -565,9 +565,9 @@ ;;;; # Explainer (deftype ^:private ExplanationDriver - #?(:clj [^:unsynchronized-mutable ^boolean success, ^ArrayDeque stack, cache - in, ^:unsynchronized-mutable errors-max-pos, ^:unsynchronized-mutable errors] - :cljs [^:mutable success, stack, cache, in, ^:mutable errors-max-pos, ^:mutable errors]) + #?(:clj [^:unsynchronized-mutable ^boolean success, ^ArrayDeque stack, cache + in, ^:unsynchronized-mutable errors-max-pos, ^:unsynchronized-mutable errors] + :cljs [^:mutable success, stack, cache, in, ^:mutable errors-max-pos, ^:mutable errors]) Driver (succeed! [_] (set! success (boolean true))) diff --git a/src/malli/instrument.clj b/src/malli/instrument.clj index 55aee2bf5..9a37f4a02 100644 --- a/src/malli/instrument.clj +++ b/src/malli/instrument.clj @@ -51,20 +51,20 @@ ;; CLJS macro for collecting function schemas ;; -(let [cljs-find-ns (fn [env] (when (:ns env) (ns-resolve 'cljs.analyzer.api 'find-ns))) +(let [cljs-find-ns (fn [env] (when (:ns env) (ns-resolve 'cljs.analyzer.api 'find-ns))) cljs-ns-interns (fn [env] (when (:ns env) (ns-resolve 'cljs.analyzer.api 'ns-interns)))] (defn -cljs-collect!* [env simple-name {:keys [meta] :as var-map}] ;; when collecting google closure or other js code symbols will not have namespaces (when (namespace (:name var-map)) - (let [ns (symbol (namespace (:name var-map))) - find-ns' (cljs-find-ns env) + (let [ns (symbol (namespace (:name var-map))) + find-ns' (cljs-find-ns env) ns-interns' (cljs-ns-interns env) - schema (:malli/schema meta)] + schema (:malli/schema meta)] (when schema (let [-qualify-sym (fn [form] (if (symbol? form) (if (simple-symbol? form) - (let [ns-data (find-ns' ns) + (let [ns-data (find-ns' ns) intern-keys (set (keys (ns-interns' ns)))] (cond ;; a referred symbol @@ -79,15 +79,15 @@ :else ;; a cljs.core var, do not qualify it form)) - (let [ns-part (symbol (namespace form)) + (let [ns-part (symbol (namespace form)) name-part (name form) - full-ns (get-in (find-ns' ns) [:requires ns-part])] + full-ns (get-in (find-ns' ns) [:requires ns-part])] (symbol (str full-ns) name-part))) form)) - schema* (walk/postwalk -qualify-sym schema) - metadata (assoc - (walk/postwalk -qualify-sym (m/-unlift-keys meta "malli")) - :metadata-schema? true)] + schema* (walk/postwalk -qualify-sym schema) + metadata (assoc + (walk/postwalk -qualify-sym (m/-unlift-keys meta "malli")) + :metadata-schema? true)] `(do (m/-register-function-schema! '~ns '~simple-name ~schema* ~metadata :cljs identity) '~(:name var-map)))))))) @@ -97,19 +97,19 @@ ([opts] (let [ns-publics' (when (:ns &env) (ns-resolve 'cljs.analyzer.api 'ns-publics))] (reduce (fn [acc [var-name var-map]] (let [v (-cljs-collect!* &env var-name var-map)] (cond-> acc v (conj v)))) - #{} - (mapcat (fn [n] - (let [ns-sym (cond (symbol? n) n - ;; handles (quote ns-name) - quoted symbols passed to cljs macros show up this way. - (list? n) (second n) - :else (symbol (str n)))] - (ns-publics' ns-sym))) - ;; support quoted vectors of ns symbols in cljs - (let [nses (:ns opts) - nses (if (and (= 'quote (first nses)) (coll? (second nses))) - (second nses) - nses)] - (-sequential nses))))))) + #{} + (mapcat (fn [n] + (let [ns-sym (cond (symbol? n) n + ;; handles (quote ns-name) - quoted symbols passed to cljs macros show up this way. + (list? n) (second n) + :else (symbol (str n)))] + (ns-publics' ns-sym))) + ;; support quoted vectors of ns symbols in cljs + (let [nses (:ns opts) + nses (if (and (= 'quote (first nses)) (coll? (second nses))) + (second nses) + nses)] + (-sequential nses))))))) ;; ;; public api diff --git a/src/malli/instrument.cljs b/src/malli/instrument.cljs index 19ec92629..d8385191c 100644 --- a/src/malli/instrument.cljs +++ b/src/malli/instrument.cljs @@ -29,14 +29,14 @@ (defn -arity->schema [fn-schema] (into {} (map (fn [schema] [(:arity (m/-function-info (m/schema schema))) schema]) - (rest fn-schema)))) + (rest fn-schema)))) (defn -variadic? [f] (g/get f "cljs$core$IFn$_invoke$arity$variadic")) (defn -max-fixed-arity [f] (g/get f "cljs$lang$maxFixedArity")) (defn -pure-variadic? [f] (let [max-fixed-arity (-max-fixed-arity f)] (and max-fixed-arity (-variadic? f) - (every? #(not (fn? (g/get f (str "cljs$core$IFn$_invoke$arity$" %)))) (range 20))))) + (every? #(not (fn? (g/get f (str "cljs$core$IFn$_invoke$arity$" %)))) (range 20))))) (defn -replace-variadic-fn [original-fn n s opts] (let [accessor "cljs$core$IFn$_invoke$arity$variadic" @@ -45,15 +45,15 @@ (g/set original-fn "malli$instrument$instrumented?" true) ;; the shape of the argument in the following apply calls are needed to match the call style of the cljs compiler ;; so the user's function gets the arguments as expected - (let [max-fixed-arity (-max-fixed-arity original-fn) + (let [max-fixed-arity (-max-fixed-arity original-fn) instrumented-variadic-fn (m/-instrument opts (fn [& args] (let [[fixed-args rest-args] (split-at max-fixed-arity (vec args)) final-args (into (vec fixed-args) [(not-empty rest-args)])] (apply arity-fn final-args)))) - instrumented-wrapper (fn [& args] - (let [[fixed-args rest-args] (split-at max-fixed-arity (vec args)) - final-args (vec (apply list* (into (vec fixed-args) (not-empty rest-args))))] - (apply instrumented-variadic-fn final-args)))] + instrumented-wrapper (fn [& args] + (let [[fixed-args rest-args] (split-at max-fixed-arity (vec args)) + final-args (vec (apply list* (into (vec fixed-args) (not-empty rest-args))))] + (apply instrumented-variadic-fn final-args)))] (g/set instrumented-wrapper "malli$instrument$original" arity-fn) (g/set (-get-prop n s) "malli$instrument$instrumented?" true) (g/set (-get-prop n s) accessor instrumented-wrapper) @@ -66,8 +66,8 @@ (doseq [[arity f-schema] (-arity->schema schema)] (if (= arity :varargs) (-replace-variadic-fn original-fn n s opts) - (let [accessor (str "cljs$core$IFn$_invoke$arity$" arity) - arity-fn (g/get original-fn accessor)] + (let [accessor (str "cljs$core$IFn$_invoke$arity$" arity) + arity-fn (g/get original-fn accessor)] (when arity-fn (let [instrumented-fn (m/-instrument (assoc opts :schema f-schema) arity-fn)] (g/set instrumented-fn "malli$instrument$original" arity-fn) @@ -87,9 +87,9 @@ (catch :default e (if (instance? ExceptionInfo e) (throw - (ex-info - (str "Schema error when instrumenting function: " (symbol (name n) (name s)) " - " (ex-message e)) - (ex-data e))) + (ex-info + (str "Schema error when instrumenting function: " (symbol (name n) (name s)) " - " (ex-message e)) + (ex-data e))) (throw (js/Error. (str "Schema error when instrumenting function: " (symbol (name n) (name s)) ". " e))))))) (defn -strument! @@ -101,12 +101,12 @@ (when-let [v (-find-var n s)] (case mode :instrument (let [original-fn (or (-original v) v) - dgen (as-> (select-keys options [:scope :report :gen]) $ - (cond-> $ report (update :report (fn [r] (fn [t data] (r t (assoc data :fn-name (symbol (name n) (name s)))))))) - (merge $ d) - (cond (and gen (true? (:gen d))) (assoc $ :gen gen) - (true? (:gen d)) (dissoc $ :gen) - :else $))] + dgen (as-> (select-keys options [:scope :report :gen]) $ + (cond-> $ report (update :report (fn [r] (fn [t data] (r t (assoc data :fn-name (symbol (name n) (name s)))))))) + (merge $ d) + (cond (and gen (true? (:gen d))) (assoc $ :gen gen) + (true? (:gen d)) (dissoc $ :gen) + :else $))] (if (and skip-instrumented? (-instrumented? v)) (println "skipping" (symbol n s) "already instrumented") (when original-fn @@ -117,8 +117,8 @@ (let [original-fn (or (-original v) v)] (cond (-pure-variadic? original-fn) - (let [accessor "cljs$core$IFn$_invoke$arity$variadic" - variadic-fn (g/get v accessor) + (let [accessor "cljs$core$IFn$_invoke$arity$variadic" + variadic-fn (g/get v accessor) orig-variadic-fn (g/get variadic-fn "malli$instrument$original")] (g/set original-fn accessor orig-variadic-fn)) @@ -146,7 +146,7 @@ (let [res* (atom {})] (-strument! (assoc options :mode (fn [v {:keys [schema ns name]}] (some->> (mg/check schema (-original v)) - (swap! res* assoc (symbol ns name)))))) + (swap! res* assoc (symbol ns name)))))) (not-empty @res*)))) (defn instrument! diff --git a/src/malli/instrument/cljs.clj b/src/malli/instrument/cljs.clj index 38b3ee350..88c6c43c6 100644 --- a/src/malli/instrument/cljs.clj +++ b/src/malli/instrument/cljs.clj @@ -35,15 +35,15 @@ :else ;; a cljs.core var, do not qualify it form)) - (let [ns-part (symbol (namespace form)) + (let [ns-part (symbol (namespace form)) name-part (name form) - full-ns (get-in (ana-api/find-ns ns) [:requires ns-part])] + full-ns (get-in (ana-api/find-ns ns) [:requires ns-part])] (symbol (str full-ns) name-part))) form)) schema* (walk/postwalk -qualify-sym schema) - metadata (assoc - (walk/postwalk -qualify-sym (m/-unlift-keys meta "malli")) - :metadata-schema? true)] + metadata (assoc + (walk/postwalk -qualify-sym (m/-unlift-keys meta "malli")) + :metadata-schema? true)] (m/-register-function-schema! ns simple-name schema* metadata :cljs identity) `(do (m/-register-function-schema! '~ns '~simple-name ~schema* ~metadata :cljs identity) @@ -54,14 +54,14 @@ (defn -collect!* [{:keys [ns]}] (reduce (fn [acc [var-name var-map]] (let [v (-collect! var-name var-map)] (cond-> acc v (conj v)))) - #{} - (mapcat (fn [n] - (let [ns-sym (cond (symbol? n) n - ;; handles (quote ns-name) - quoted symbols passed to cljs macros show up this way. - (list? n) (second n) - :else (symbol (str n)))] - (ana-api/ns-publics ns-sym))) - (-sequential ns)))) + #{} + (mapcat (fn [n] + (let [ns-sym (cond (symbol? n) n + ;; handles (quote ns-name) - quoted symbols passed to cljs macros show up this way. + (list? n) (second n) + :else (symbol (str n)))] + (ana-api/ns-publics ns-sym))) + (-sequential ns)))) ;; intended to be called from a cljs macro (defn -collect-all-ns [] @@ -80,33 +80,33 @@ [schema] (walk/postwalk (fn [form] (if (or (coll? form) (contains? -default-schema-keys form)) form :any)) - schema)) + schema)) (defn -emit-variadic-instrumented-fn [fn-sym schema-map max-fixed-args] `(set! (.-cljs$core$IFn$_invoke$arity$variadic ~fn-sym) - (let [orig-fn# (.-cljs$core$IFn$_invoke$arity$variadic ~fn-sym) - instrumented# (meta-fn - (m/-instrument ~schema-map - (fn [& args#] - (let [[fixed-args# rest-args#] (split-at ~max-fixed-args (vec args#))] - ;; the shape of the argument in this apply call is needed to match the call style of the cljs compiler - ;; so the user's function get the arguments as expected - (apply orig-fn# (into (vec fixed-args#) [(not-empty rest-args#)]))))) - {:instrumented-symbol '~fn-sym})] - (fn ~(symbol (str (name fn-sym) "-variadic")) [& args#] - (apply instrumented# (apply list* args#)))))) + (let [orig-fn# (.-cljs$core$IFn$_invoke$arity$variadic ~fn-sym) + instrumented# (meta-fn + (m/-instrument ~schema-map + (fn [& args#] + (let [[fixed-args# rest-args#] (split-at ~max-fixed-args (vec args#))] + ;; the shape of the argument in this apply call is needed to match the call style of the cljs compiler + ;; so the user's function get the arguments as expected + (apply orig-fn# (into (vec fixed-args#) [(not-empty rest-args#)]))))) + {:instrumented-symbol '~fn-sym})] + (fn ~(symbol (str (name fn-sym) "-variadic")) [& args#] + (apply instrumented# (apply list* args#)))))) (defn -emit-multi-arity-instrumentation-code [fn-sym schema-map schema max-fixed-args] (when-not (= (first schema) :function) (throw (IllegalArgumentException. (str "Multi-arity function " fn-sym " must have :function schema. You provided: " - (pr-str schema))))) + (pr-str schema))))) ;; Here we pair up each function schema with a mocked version that can safely be parsed in malli Clojure during compilation ;; this is so we can use malli.core helper functions to get the arities for each function schema. (let [schema-tuples (map (fn [s] [(-mock-cljs-schema s) s]) (rest schema)) arity->schema (into {} (map (fn [[mock-schema schema]] (let [arity (:arity (m/-function-info (m/schema mock-schema)))] [arity schema])) - schema-tuples))] + schema-tuples))] ;; ClojureScript produces one JS function per arity, we instrument each one if a schema for that arity is present. `(do ~@(map (fn [[arity fn-schema]] @@ -114,15 +114,15 @@ (-emit-variadic-instrumented-fn fn-sym schema-map max-fixed-args) (let [arity-fn-sym `(~(symbol (str ".-cljs$core$IFn$_invoke$arity$" arity)) ~fn-sym)] `(set! ~arity-fn-sym (meta-fn (m/-instrument ~(assoc schema-map :schema fn-schema) ~arity-fn-sym) - {:instrumented-symbol '~fn-sym}))))) - arity->schema)))) + {:instrumented-symbol '~fn-sym}))))) + arity->schema)))) (defn -emit-replace-var-code [fn-sym fn-var-meta schema-map schema] - (let [variadic? (-> fn-var-meta :top-fn :variadic?) + (let [variadic? (-> fn-var-meta :top-fn :variadic?) max-fixed-args (-> fn-var-meta :top-fn :max-fixed-arity) ; parse arglists, it comes in with this shape: (quote ([a b])) - [_ arglists] (:arglists fn-var-meta) - single-arity? (= (count arglists) 1)] + [_ arglists] (:arglists fn-var-meta) + single-arity? (= (count arglists) 1)] `(do (swap! instrumented-vars #(assoc % '~fn-sym ~fn-sym)) ~(cond @@ -145,14 +145,14 @@ (select-keys [:gen :scope :report]) ;; The schema passed in may contain cljs vars that have to be resolved at runtime in cljs. (assoc :schema `(m/function-schema ~schema)) - (cond-> report - (assoc :report `(cljs.core/fn [type# data#] (~report type# (assoc data# :fn-name '~fn-sym)))))) + (cond-> report + (assoc :report `(cljs.core/fn [type# data#] (~report type# (assoc data# :fn-name '~fn-sym)))))) schema-map-with-gen - (as-> (merge (select-keys instrument-opts [:scope :report :gen]) schema-map) $ - ;; use the passed in gen fn to generate a value - (if (and gen (true? (:gen schema-map))) - (assoc $ :gen gen) - (dissoc $ :gen))) + (as-> (merge (select-keys instrument-opts [:scope :report :gen]) schema-map) $ + ;; use the passed in gen fn to generate a value + (if (and gen (true? (:gen schema-map))) + (assoc $ :gen gen) + (dissoc $ :gen))) replace-var-code (when-let [fn-var (ana-api/resolve env fn-sym)] (-emit-replace-var-code fn-sym (:meta fn-var) schema-map-with-gen schema))] diff --git a/src/malli/sci.cljc b/src/malli/sci.cljc index c4fb24aed..11156994a 100644 --- a/src/malli/sci.cljc +++ b/src/malli/sci.cljc @@ -2,9 +2,9 @@ (:require [borkdude.dynaload :as dynaload])) (defn evaluator [options fail!] - #?(:bb (fn [] - (fn [form] - (load-string (str "(ns user (:require [malli.core :as m]))\n" form)))) + #?(:bb (fn [] + (fn [form] + (load-string (str "(ns user (:require [malli.core :as m]))\n" form)))) :default (let [eval-string* (dynaload/dynaload 'sci.core/eval-string* {:default nil}) init (dynaload/dynaload 'sci.core/init {:default nil}) fork (dynaload/dynaload 'sci.core/fork {:default nil})] diff --git a/src/malli/swagger.cljc b/src/malli/swagger.cljc index 405d979cd..7a3342e6f 100644 --- a/src/malli/swagger.cljc +++ b/src/malli/swagger.cljc @@ -77,49 +77,49 @@ (defmethod extract-parameter :body [_ schema] (let [swagger-schema (transform schema {:in :body, :type :parameter})] - [{:in "body" - :name (:title swagger-schema "body") + [{:in "body" + :name (:title swagger-schema "body") :description (:description swagger-schema "") - :required (not= :maybe (m/type schema)) - :schema swagger-schema}])) + :required (not= :maybe (m/type schema)) + :schema swagger-schema}])) (defmethod extract-parameter :default [in schema] (let [{:keys [properties required]} (transform schema {:in in, :type :parameter})] (mapv - (fn [[k {:keys [type] :as schema}]] - (merge - {:in (name in) - :name k - :description (:description schema "") - :type type - :required (contains? (set required) k)} - schema)) - properties))) + (fn [[k {:keys [type] :as schema}]] + (merge + {:in (name in) + :name k + :description (:description schema "") + :type type + :required (contains? (set required) k)} + schema)) + properties))) (defmulti expand (fn [k _ _ _] k)) (defmethod expand ::responses [_ v acc _] {:responses (into - (or (:responses acc) {}) - (for [[status response] v] - [status (-> response - (update :schema transform {:type :schema}) - (update :description (fnil identity "")) - -remove-empty-keys)]))}) + (or (:responses acc) {}) + (for [[status response] v] + [status (-> response + (update :schema transform {:type :schema}) + (update :description (fnil identity "")) + -remove-empty-keys)]))}) (defmethod expand ::parameters [_ v acc _] - (let [old (or (:parameters acc) []) - new (mapcat (fn [[in spec]] (extract-parameter in spec)) v) + (let [old (or (:parameters acc) []) + new (mapcat (fn [[in spec]] (extract-parameter in spec)) v) merged (->> (into old new) reverse (reduce - (fn [[ps cache :as acc] p] - (let [c (select-keys p [:in :name])] - (if (cache c) - acc - [(conj ps p) (conj cache c)]))) - [[] #{}]) + (fn [[ps cache :as acc] p] + (let [c (select-keys p [:in :name])] + (if (cache c) + acc + [(conj ps p) (conj cache c)]))) + [[] #{}]) first reverse vec)] @@ -129,23 +129,23 @@ [x options] (let [accept? (-> expand methods keys set)] (walk/postwalk - (fn [x] - (if (map? x) - (reduce-kv - (fn [acc k v] - (if (accept? k) - (let [expanded (expand k v acc options) - parameters (:parameters expanded) - responses (:responses expanded) - definitions (if parameters - (-> parameters first :schema :definitions) - (->> responses vals (map :schema) - (map :definitions) (apply merge)))] - (-> acc (dissoc k) (merge expanded) (update :definitions merge definitions))) - acc)) - x x) - x)) - x))) + (fn [x] + (if (map? x) + (reduce-kv + (fn [acc k v] + (if (accept? k) + (let [expanded (expand k v acc options) + parameters (:parameters expanded) + responses (:responses expanded) + definitions (if parameters + (-> parameters first :schema :definitions) + (->> responses vals (map :schema) + (map :definitions) (apply merge)))] + (-> acc (dissoc k) (merge expanded) (update :definitions merge definitions))) + acc)) + x x) + x)) + x))) (defn swagger-spec ([x] diff --git a/test/malli/swagger_test.cljc b/test/malli/swagger_test.cljc index 3ab8683a7..1b5319fc2 100644 --- a/test/malli/swagger_test.cljc +++ b/test/malli/swagger_test.cljc @@ -81,8 +81,8 @@ [:uuid {:type "string", :format "uuid"}] [integer? {:type "integer" :format "int32"}] - #?@(:clj [[ratio? {:type "number"}] - [rational? {:type "number"}]] + #?@(:clj [[ratio? {:type "number"}] + [rational? {:type "number"}]] :cljs []) ;; protocols [(reify @@ -310,7 +310,7 @@ (testing "generates swagger for ::responses w/ basic schema + registry" (let [registry (merge (m/base-schemas) (m/type-schemas) {::success [:map-of :keyword :string] - ::error [:string {:min 1}]})] + ::error [:string {:min 1}]})] (is (= {:definitions {::error {:minLength 1, :type "string"}, ::success {:additionalProperties {:type "string"}, :type "object"}}, @@ -329,9 +329,9 @@ (testing "generates swagger for ::parameters and ::responses w/ basic schema + registry" (let [registry (merge (m/base-schemas) (m/type-schemas) (m/comparator-schemas) - {::req-body [:map-of :keyword :any] + {::req-body [:map-of :keyword :any] ::success-resp [:map [:it [:= "worked"]]] - ::error-resp [:string {:min 1}]})] + ::error-resp [:string {:min 1}]})] (is (= {:definitions {::error-resp {:minLength 1, :type "string"}, ::req-body {:additionalProperties {}, :type "object"}, ::success-resp {:properties {:it {:const "worked"}}, @@ -367,22 +367,22 @@ #_(testing "generates swagger for ::parameters and ::responses w/ recursive schema + registry" (let [registry (merge (m/base-schemas) (m/type-schemas) (m/comparator-schemas) (m/sequence-schemas) - {::a [:or - :string - [:ref ::b]] - ::b [:or - :keyword - [:ref ::c]] - ::c [:or - :symbol - [:ref ::a]] + {::a [:or + :string + [:ref ::b]] + ::b [:or + :keyword + [:ref ::c]] + ::c [:or + :symbol + [:ref ::a]] ;; test would pass if the schema below were e.g. ;; [:map [:a ::a] [:b ::b] [:c ::c]] (and the ;; ::req-body expected adjusted accordingly) ;; b/c then ::b & ::c would be directly used, not just refs - ::req-body [:map [:a ::a]] + ::req-body [:map [:a ::a]] ::success-resp [:map-of :keyword :string] - ::error-resp :string})] + ::error-resp :string})] (is (= {:definitions {::a {:type "string", :x-anyOf [{:type "string"} {:$ref "#/definitions/malli.swagger-test~1b"}]}, From feb52a91f661b050df4089b0d7000931c9a9757d Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sun, 19 Mar 2023 15:49:52 +0200 Subject: [PATCH 83/86] CHANGELOG --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 186fc9a6b..ac1d326d1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,10 @@ We use [Break Versioning][breakver]. The version numbers follow a `. Date: Sun, 19 Mar 2023 15:51:31 +0200 Subject: [PATCH 84/86] 0.10.4 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index a04dec34f..233d1e211 100644 --- a/pom.xml +++ b/pom.xml @@ -3,7 +3,7 @@ 4.0.0 metosin malli - 0.10.3 + 0.10.4 malli @@ -15,7 +15,7 @@ https://github.com/metosin/malli scm:git:git://github.com/metosin/malli.git scm:git:ssh://git@github.com/metosin/malli.git - 0.10.3 + 0.10.4 From 7d24786a9659db01294d6bfc600cc872cf410c16 Mon Sep 17 00:00:00 2001 From: Simon Accascina Date: Wed, 29 Mar 2023 13:40:53 +0200 Subject: [PATCH 85/86] Fix typo Unless I'm missing something, present tense should be used here as it's currently true that you have to bring in your state atom in order to have a global registry --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 3697f4008..d50b28912 100644 --- a/README.md +++ b/README.md @@ -2494,7 +2494,7 @@ Just a `Map`. ### Mutable registry -[clojure.spec](https://clojure.org/guides/spec) introduces a mutable global registry for specs. The mutable registry in malli forced you to bring in your own state atom and functions how to work with it: +[clojure.spec](https://clojure.org/guides/spec) introduces a mutable global registry for specs. The mutable registry in malli forces you to bring in your own state atom and functions how to work with it: Using a custom registry atom: From d3754ce5835fbe8984c8a2997c679b36cfbe0775 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sun, 2 Apr 2023 19:31:47 +0300 Subject: [PATCH 86/86] Update tips.md --- docs/tips.md | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/docs/tips.md b/docs/tips.md index 25efc9781..ec28167c9 100644 --- a/docs/tips.md +++ b/docs/tips.md @@ -1,5 +1,51 @@ # Tips +## Accessing both schema and value in transformation + +```clojure +(require '[malli.core :as m]) +(require '[malli.transform :as mt]) + +(def Address + [:map + [:id :string] + [:tags [:set :keyword]] + [:address [:map + [:street :string] + [:city :string]]]]) + +(def lillan + {:id "Lillan" + :tags #{:artesan :coffee :hotel} + :address {:street "Ahlmanintie 29" + :city "Tampere"}}) + +(m/decode + Address + lillan + (mt/transformer + {:default-decoder + {:compile (fn [schema _] + (fn [value] + (prn [value (m/form schema)]) + value))}})) +;[{:id "Lillan", :tags #{:coffee :artesan :hotel}, :address {:street "Ahlmanintie 29", :city "Tampere"}} [:map [:id :string] [:tags [:set :keyword]] [:address [:map [:street :string] [:city :string]]]]] +;["Lillan" [:malli.core/val :string]] +;["Lillan" :string] +;[#{:coffee :artesan :hotel} [:malli.core/val [:set :keyword]]] +;[#{:coffee :artesan :hotel} [:set :keyword]] +;[:coffee :keyword] +;[:artesan :keyword] +;[:hotel :keyword] +;[{:street "Ahlmanintie 29", :city "Tampere"} [:malli.core/val [:map [:street :string] [:city :string]]]] +;[{:street "Ahlmanintie 29", :city "Tampere"} [:map [:street :string] [:city :string]]] +;["Ahlmanintie 29" [:malli.core/val :string]] +;["Ahlmanintie 29" :string] +;["Tampere" [:malli.core/val :string]] +;["Tampere" :string] +; => {:id "Lillan", :tags #{:coffee :artesan :hotel}, :address {:street "Ahlmanintie 29", :city "Tampere"}} +``` + ## Removing Schemas based on a property Schemas can be walked over recursively using `m/walk`: