From 79694876fbaf83a82777c547e66661468d556f7e Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sat, 4 Oct 2025 18:47:42 +0400 Subject: [PATCH 01/37] Account for vector (sub)schemas in `with-paths` fn --- core/src/martian/schema_tools.cljc | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 2d2bee5b..8701fc7f 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -14,7 +14,10 @@ :schema (:val-schema schema)} (map? schema) {:path path - :schema schema})) + :schema schema} + (vector? schema) + {:path (conj path :martian/idx) + :schema (first schema)})) (spec/subschemas (s/spec schema)))) (defn key-seqs From c45fbc192d823028f4828d7044abd264ee7e66b6 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sat, 4 Oct 2025 18:48:23 +0400 Subject: [PATCH 02/37] Avoid duplicate paths in the `key-seqs` fn result --- core/src/martian/schema_tools.cljc | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 8701fc7f..a70f60ad 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -1,5 +1,6 @@ (ns martian.schema-tools - (:require [schema.core :as s #?@(:cljs [:refer [MapEntry EqSchema]])] + (:require [flatland.ordered.set :refer [ordered-set]] + [schema.core :as s #?@(:cljs [:refer [MapEntry EqSchema]])] [schema.spec.core :as spec]) #?(:clj (:import [schema.core MapEntry EqSchema]))) @@ -24,12 +25,16 @@ "Returns a collection of paths which would address all possible entries (using `get-in`) in data described by the schema" [schema] (when (map? schema) - (loop [paths [[]] + (loop [paths (ordered-set []) paths-and-schemas (with-paths [] schema)] (if-let [{:keys [path schema]} (first paths-and-schemas)] (recur (conj paths path) (concat (rest paths-and-schemas) (with-paths path schema))) - paths)))) + (vec paths))))) + +;; + +;; TODO: Cover with more tests and lean on the `schema-tools.walk` if possible. (defn walk-with-path "Identical to `clojure.walk/walk` except keeps track of the path through the data structure (as per `get-in`) From edab5db49d13df559847cfb01b3d9069f2995ec2 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sat, 4 Oct 2025 18:53:30 +0400 Subject: [PATCH 03/37] Untangle the `->idiomatic` key fn impl + use helper --- core/src/martian/parameter_aliases.cljc | 12 ++++++++---- core/src/martian/schema_tools.cljc | 6 ++++-- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/core/src/martian/parameter_aliases.cljc b/core/src/martian/parameter_aliases.cljc index 31525b49..5854b205 100644 --- a/core/src/martian/parameter_aliases.cljc +++ b/core/src/martian/parameter_aliases.cljc @@ -2,13 +2,17 @@ (:require [schema.core :as s] [camel-snake-kebab.core :refer [->kebab-case]] [clojure.set :refer [rename-keys]] - [martian.schema-tools :refer [key-seqs prewalk-with-path]])) + [martian.schema-tools :refer [unspecify-key key-seqs prewalk-with-path]])) -;; todo lean on schema-tools.core for some of this +;; TODO: Lean on `schema-tools.core` for some of these transformations. + +(defn can-be-kebabised? [k] + (not (and (keyword? k) (namespace k)))) (defn ->idiomatic [k] - (when (and k (s/specific-key? k) (not (and (keyword? k) (namespace k)))) - (->kebab-case (s/explicit-schema-key k)))) + (when-some [uk (when k (unspecify-key k))] + (when (can-be-kebabised? uk) + (->kebab-case uk)))) (defn- idiomatic-path [path] (vec (keep ->idiomatic path))) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index a70f60ad..43a0b445 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -4,8 +4,10 @@ [schema.spec.core :as spec]) #?(:clj (:import [schema.core MapEntry EqSchema]))) -;; todo -;; write some tests and lean on schema-tools.core where possible +(defn unspecify-key [k] + (if (s/specific-key? k) + (s/explicit-schema-key k) + k)) (defn with-paths [path schema] (keep (fn [schema] From 09dfdeb1720514a3a13f8839b34a663cd243526b Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sat, 4 Oct 2025 20:03:46 +0400 Subject: [PATCH 04/37] Enable parameter aliases for `st/default` schemas --- core/src/martian/schema_tools.cljc | 38 ++++-- core/test/martian/parameter_aliases_test.cljc | 117 ++++++++++++------ 2 files changed, 108 insertions(+), 47 deletions(-) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 43a0b445..55658876 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -9,19 +9,33 @@ (s/explicit-schema-key k) k)) +(defn default? [schema] + (= "schema_tools.impl.Default" (Class/.getName (class schema)))) + (defn with-paths [path schema] - (keep (fn [schema] - (cond (and (instance? MapEntry schema) - (instance? EqSchema (:key-schema schema))) - {:path (conj path (:v (:key-schema schema))) - :schema (:val-schema schema)} - (map? schema) - {:path path - :schema schema} - (vector? schema) - {:path (conj path :martian/idx) - :schema (first schema)})) - (spec/subschemas (s/spec schema)))) + (when (satisfies? schema.core/Schema schema) + (->> (spec/subschemas (s/spec schema)) + (mapcat (fn [schema] + (cond (and (instance? MapEntry schema) + (instance? EqSchema (:key-schema schema))) + (let [key-schema-v (:v (:key-schema schema)) + val-schema (:val-schema schema)] + (if (default? val-schema) + [{:path (conj path key-schema-v) + :schema val-schema} + {:path (conj path key-schema-v :schema) + :schema (:schema val-schema)} + {:path (conj path key-schema-v :value) + :schema (:value val-schema)}] + [{:path (conj path key-schema-v) + :schema val-schema}])) + (map? schema) + [{:path path + :schema schema}] + (vector? schema) + [{:path (conj path :martian/idx) + :schema (first schema)}]))) + (remove nil?)))) (defn key-seqs "Returns a collection of paths which would address all possible entries (using `get-in`) in data described by the schema" diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index ab698543..7aa09b5c 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -2,43 +2,56 @@ (:require [martian.parameter-aliases :refer [parameter-aliases unalias-data alias-schema]] [schema-tools.core :as st] [schema.core :as s] - #?(:clj [clojure.test :refer [deftest testing is]] + #?(:clj [clojure.test :refer [deftest testing is]] :cljs [cljs.test :refer-macros [deftest testing is]]))) (deftest parameter-aliases-test (testing "produces idiomatic aliases for all keys in a schema" - (is (= {[] {:foo-bar :fooBar - :bar :BAR - :baz :Baz}} - (parameter-aliases {:fooBar s/Str - (s/optional-key :BAR) s/Str - :Baz s/Str})))) + (testing "map schemas with optional keys" + (is (= {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz}} + (parameter-aliases {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz s/Str})))) - (testing "works on nested maps and sequences" - (is (= {[] {:foo-bar :fooBar - :bar :BAR - :baz :Baz} - [:baz] {:quu :QUU - :quux :Quux} - [:baz :quux] {:fizz :Fizz}} - (parameter-aliases {:fooBar s/Str - (s/optional-key :BAR) s/Str - :Baz {:QUU s/Str - :Quux [{:Fizz s/Str}]}})))) + (testing "nested map and vector schemas" + (is (= {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz} + [:baz] {:quu :QUU + :quux :Quux} + [:baz :quux] {:fizz :Fizz}} + (parameter-aliases {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz {:QUU s/Str + :Quux [{:Fizz s/Str}]}})))) - (testing "works on nested maps and sequences" - (is (= {[] {:foo-bar :fooBar - :bar :BAR - :baz :Baz} - [:baz] {:quu :QUU - :quux :Quux} - [:baz :quux] {:fizz :Fizz}} - (parameter-aliases {:fooBar s/Str - (s/optional-key :BAR) s/Str - :Baz (st/default {:QUU s/Str - :Quux [{:Fizz s/Str}]} - {:QUU "hi" - :Quux []})}))))) + (testing "deeply nested vector schemas" + (is (= {[] {:foo :FOO} + [:foo] {:bar :Bar} + [:foo :bar] {:bar-doo :barDoo + :bar-dee :barDee}} + (parameter-aliases {(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str + (s/optional-key :barDee) s/Str}]]}})))) + + (testing "default schemas" + (is (= {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz} + [:baz] {:quu :QUU + :quux :Quux} + [:baz :quux] {:fizz :Fizz} + [:baz :schema] {:quu :QUU, :quux :Quux} + [:baz :schema :quux] {:fizz :Fizz} + [:baz :value] {:quu :QUU, :quux :Quux}} + (parameter-aliases {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})})))))) (deftest unalias-data-test (testing "renames idiomatic keys back to original" @@ -58,9 +71,43 @@ (unalias-data (parameter-aliases schema) {:foo {:foo-bar "b" :bar [{:baz "c"}]}})))))) (deftest alias-schema-test - (testing "renames the keys in the schema to give an idiomatic input schema" - (let [schema {:FOO {:fooBar s/Str - (s/optional-key :Bar) [{:BAZ s/Str}]}}] + (testing "renames schema keys into idiomatic keys" + (testing "map schemas with optional keys" + (is (= {:foo-bar s/Str + (s/optional-key :bar) s/Str + :baz s/Str} + (let [schema {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz s/Str}] + (alias-schema (parameter-aliases schema) schema))))) + + (testing "nested map and vector schemas" (is (= {:foo {:foo-bar s/Str (s/optional-key :bar) [{:baz s/Str}]}} - (alias-schema (parameter-aliases schema) schema)))))) + (let [schema {:FOO {:fooBar s/Str + (s/optional-key :Bar) [{:BAZ s/Str}]}}] + (alias-schema (parameter-aliases schema) schema))))) + + (testing "deeply nested vector schemas" + (is (= {(s/optional-key :foo) + {:bar [[{:bar-doo s/Str + (s/optional-key :bar-dee) s/Str}]]}} + (let [schema {(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str + (s/optional-key :barDee) s/Str}]]}}] + (alias-schema (parameter-aliases schema) schema))))) + + (testing "default schemas" + (is (= {:foo-bar s/Str + (s/optional-key :bar) s/Str + :baz (st/default {:quu s/Str + :quux [{:fizz s/Str}]} + {:quu "hi" + :quux []})} + (let [schema {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})}] + (alias-schema (parameter-aliases schema) schema))))))) From eacac72998a5d1eee26ec19bae2bcc799acedc79 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sun, 5 Oct 2025 00:50:10 +0400 Subject: [PATCH 05/37] Add more tests for the parameter aliases feature --- core/test/martian/parameter_aliases_test.cljc | 66 ++++++++++++++++--- 1 file changed, 57 insertions(+), 9 deletions(-) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index 7aa09b5c..5becf4f5 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -51,24 +51,65 @@ :Baz (st/default {:QUU s/Str :Quux [{:Fizz s/Str}]} {:QUU "hi" - :Quux []})})))))) + :Quux []})})))) + + (testing "qualified keys are not aliased" + (is (= {} (parameter-aliases {:foo/Bar s/Str + :Baz/DOO s/Str})))))) (deftest unalias-data-test (testing "renames idiomatic keys back to original" - (let [schema {:FOO s/Str - :fooBar s/Str - (s/optional-key :Bar) s/Str}] + (testing "map schemas with optional keys" (is (= {:FOO "a" :fooBar "b" :Bar "c"} - (unalias-data (parameter-aliases schema) {:foo "a" :foo-bar "b" :bar "c"}))))) + (let [schema {:FOO s/Str + :fooBar s/Str + (s/optional-key :Bar) s/Str}] + (unalias-data (parameter-aliases schema) {:foo "a" + :foo-bar "b" + :bar "c"}))))) - (testing "works on nested maps and sequences" - (let [schema {:FOO {:fooBar s/Str - (s/optional-key :Bar) [{:BAZ s/Str}]}}] + (testing "nested map and vector schemas" (is (= {:FOO {:fooBar "b" :Bar [{:BAZ "c"}]}} - (unalias-data (parameter-aliases schema) {:foo {:foo-bar "b" :bar [{:baz "c"}]}})))))) + (let [schema {:FOO {:fooBar s/Str + (s/optional-key :Bar) [{:BAZ s/Str}]}}] + (unalias-data (parameter-aliases schema) {:foo {:foo-bar "b" + :bar [{:baz "c"}]}}))))) + + (testing "deeply nested vector schemas" + (is (= {:FOO {:Bar [[{:barDoo "a" + :barDee "b"}]]}} + (let [schema {(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str + (s/optional-key :barDee) s/Str}]]}}] + (unalias-data (parameter-aliases schema) {:foo {:bar [[{:bar-doo "a" + :bar-dee "b"}]]}}))))) + + (testing "default schemas" + (is (= {:fooBar "a" + :BAR "b" + :Baz {:QUU "c" + :Quux [{:Fizz "d"}]}} + (let [schema {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})}] + (unalias-data (parameter-aliases schema) {:foo-bar "a" + :bar "b" + :baz {:quu "c" + :quux [{:fizz "d"}]}}))))) + + (testing "qualified keys are not aliased" + (is (= {:foo/Bar "a" + :Baz/DOO "b"} + (let [schema {:foo/Bar s/Str + :Baz/DOO s/Str}] + (unalias-data (parameter-aliases schema) {:foo/Bar "a" + :Baz/DOO "b"}))))))) (deftest alias-schema-test (testing "renames schema keys into idiomatic keys" @@ -110,4 +151,11 @@ :Quux [{:Fizz s/Str}]} {:QUU "hi" :Quux []})}] + (alias-schema (parameter-aliases schema) schema))))) + + (testing "qualified keys are not aliased" + (is (= {:foo/Bar s/Str + :Baz/DOO s/Str} + (let [schema {:foo/Bar s/Str + :Baz/DOO s/Str}] (alias-schema (parameter-aliases schema) schema))))))) From 04a7686e65559b0d94b711801d5c277f91b6b237 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sun, 5 Oct 2025 00:52:29 +0400 Subject: [PATCH 06/37] Make `walk-with-path` fn resemble `schema-tools.walk/walk` --- core/src/martian/schema_tools.cljc | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 55658876..697dae5f 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -58,17 +58,27 @@ ([inner outer form] (walk-with-path inner outer [] form)) ([inner outer path form] (cond - (list? form) (outer path (apply list (map (partial inner path) form))) (map-entry? form) - (outer path #?(:clj (clojure.lang.MapEntry. (inner path (key form)) (inner (conj path (key form)) (val form))) - :cljs (cljs.core/MapEntry. (inner path (key form)) (inner (conj path (key form)) (val form)) nil))) - (seq? form) (outer path (doall (map (partial inner path) form))) - (record? form) (outer path (reduce (fn [r x] (conj r (inner path x))) form form)) - (coll? form) (outer path (into (empty form) (map (partial inner path) form))) + (outer path [(inner path (key form)) + (inner (conj path (key form)) (val form))]) + (record? form) + (outer path (reduce (fn [r x] (conj r (inner path x))) form form)) + (list? form) + (outer path (apply list (map #(inner path %) form))) + (seq? form) + (outer path (doall (map #(inner path %) form))) + (coll? form) + (outer path (into (empty form) (map #(inner path %) form))) :else (outer path form)))) (defn postwalk-with-path [f path form] - (walk-with-path (partial postwalk-with-path f) f path form)) + (walk-with-path (fn [path form] (postwalk-with-path f path form)) + f + path + form)) (defn prewalk-with-path [f path form] - (walk-with-path (partial prewalk-with-path f) (fn [_path form] form) path (f path form))) + (walk-with-path (fn [path form] (prewalk-with-path f path form)) + (fn [_path form] form) + path + (f path form))) From 883dbb069dc6d763d35923ad1c5545b58c2a4c17 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sun, 5 Oct 2025 00:53:01 +0400 Subject: [PATCH 07/37] Minor improvements of `with-paths` fn impl --- core/src/martian/schema_tools.cljc | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 697dae5f..6f54e599 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -9,8 +9,7 @@ (s/explicit-schema-key k) k)) -(defn default? [schema] - (= "schema_tools.impl.Default" (Class/.getName (class schema)))) +(def default-schema? #'sti/default?) (defn with-paths [path schema] (when (satisfies? schema.core/Schema schema) @@ -20,7 +19,7 @@ (instance? EqSchema (:key-schema schema))) (let [key-schema-v (:v (:key-schema schema)) val-schema (:val-schema schema)] - (if (default? val-schema) + (if (default-schema? val-schema) [{:path (conj path key-schema-v) :schema val-schema} {:path (conj path key-schema-v :schema) @@ -33,7 +32,7 @@ [{:path path :schema schema}] (vector? schema) - [{:path (conj path :martian/idx) + [{:path (conj path ::idx) ; must be qualified! :schema (first schema)}]))) (remove nil?)))) From afd66f451af2293f75c5594046e81a183b36a6bc Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sun, 5 Oct 2025 00:53:57 +0400 Subject: [PATCH 08/37] Update all docstrings and related ToDo items --- core/src/martian/parameter_aliases.cljc | 20 ++++++++++++-------- core/src/martian/schema_tools.cljc | 13 ++++++++----- 2 files changed, 20 insertions(+), 13 deletions(-) diff --git a/core/src/martian/parameter_aliases.cljc b/core/src/martian/parameter_aliases.cljc index 5854b205..2974151c 100644 --- a/core/src/martian/parameter_aliases.cljc +++ b/core/src/martian/parameter_aliases.cljc @@ -1,10 +1,8 @@ (ns martian.parameter-aliases - (:require [schema.core :as s] - [camel-snake-kebab.core :refer [->kebab-case]] + (:require [camel-snake-kebab.core :refer [->kebab-case]] [clojure.set :refer [rename-keys]] - [martian.schema-tools :refer [unspecify-key key-seqs prewalk-with-path]])) - -;; TODO: Lean on `schema-tools.core` for some of these transformations. + [martian.schema-tools :refer [unspecify-key key-seqs prewalk-with-path]] + [schema.core :as s])) (defn can-be-kebabised? [k] (not (and (keyword? k) (namespace k)))) @@ -18,7 +16,10 @@ (vec (keep ->idiomatic path))) (defn parameter-aliases - "Produces a data structure for use with `unalias-data`" + "Produces a data structure with idiomatic keys (aliases) mappings per path + in a (possibly, deeply nested) `schema` for all its unqualified keys. + + The result is then used with `alias-schema` and `unalias-data` functions." [schema] (reduce (fn [acc path] (if-let [idiomatic-key (some-> path last ->idiomatic)] @@ -30,7 +31,8 @@ (key-seqs schema))) (defn unalias-data - "Takes parameter aliases and (deeply nested) data, returning data with deeply-nested keys renamed as described by parameter-aliases" + "Given a (possibly, deeply nested) data `x`, returns the data with all keys + renamed as described by the `parameter-aliases`." [parameter-aliases x] (if parameter-aliases (prewalk-with-path (fn [path x] @@ -42,7 +44,9 @@ x)) (defn alias-schema - "Walks a schema, transforming all keys into their aliases (idiomatic keys)" + "Given a (possibly, deeply nested) `schema`, renames all keys (in it and its + subschemas) into corresponding idiomatic keys (aliases) as described by the + `parameter-aliases`." [parameter-aliases schema] (if parameter-aliases (prewalk-with-path (fn [path x] diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 6f54e599..0a87ae89 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -1,9 +1,12 @@ (ns martian.schema-tools (:require [flatland.ordered.set :refer [ordered-set]] [schema.core :as s #?@(:cljs [:refer [MapEntry EqSchema]])] + [schema-tools.impl :as sti] [schema.spec.core :as spec]) #?(:clj (:import [schema.core MapEntry EqSchema]))) +;; TODO: Cover `key-seqs` and `walk-with-path` functions with some tests. + (defn unspecify-key [k] (if (s/specific-key? k) (s/explicit-schema-key k) @@ -37,7 +40,8 @@ (remove nil?)))) (defn key-seqs - "Returns a collection of paths which would address all possible entries (using `get-in`) in data described by the schema" + "Returns a vec of paths (key seqs) which would address all possible entries + in a data described by the `schema`." [schema] (when (map? schema) (loop [paths (ordered-set []) @@ -49,11 +53,10 @@ ;; -;; TODO: Cover with more tests and lean on the `schema-tools.walk` if possible. - (defn walk-with-path - "Identical to `clojure.walk/walk` except keeps track of the path through the data structure (as per `get-in`) - as it goes, calling `inner` and `outer` with two args: the path and form" + "Similar to the `schema-tools.walk/walk` except it keeps track of the `path` + through the data structure as it goes, calling `inner` and `outer` with two + args: the `path` and the `form`. It also does not preserve any metadata." ([inner outer form] (walk-with-path inner outer [] form)) ([inner outer path form] (cond From 4c5b2607bdcba8103b8d90d8f57215966db2f7f0 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sun, 5 Oct 2025 01:00:22 +0400 Subject: [PATCH 09/37] Fix compilation error for ClojureScript due to the missing CLJS `flatland.ordered.set` impl --- core/src/martian/schema_tools.cljc | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 0a87ae89..0a720309 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -1,6 +1,5 @@ (ns martian.schema-tools - (:require [flatland.ordered.set :refer [ordered-set]] - [schema.core :as s #?@(:cljs [:refer [MapEntry EqSchema]])] + (:require [schema.core :as s #?@(:cljs [:refer [MapEntry EqSchema]])] [schema-tools.impl :as sti] [schema.spec.core :as spec]) #?(:clj (:import [schema.core MapEntry EqSchema]))) @@ -40,16 +39,16 @@ (remove nil?)))) (defn key-seqs - "Returns a vec of paths (key seqs) which would address all possible entries - in a data described by the `schema`." + "Returns a coll of paths (key seqs) which would address all possible entries + in a data described by the given `schema` as well as the `schema` itself." [schema] (when (map? schema) - (loop [paths (ordered-set []) + (loop [paths [[]] paths-and-schemas (with-paths [] schema)] (if-let [{:keys [path schema]} (first paths-and-schemas)] (recur (conj paths path) (concat (rest paths-and-schemas) (with-paths path schema))) - (vec paths))))) + (distinct paths))))) ;; From 6d8d215f2c8c93249f3b8ea7f008574a81fec85f Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sun, 5 Oct 2025 10:00:29 +0400 Subject: [PATCH 10/37] Cover the `martian.schema-tool/key-seqs` fn with tests --- core/src/martian/schema_tools.cljc | 4 +- core/test/martian/schema_tools_test.cljc | 64 ++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 2 deletions(-) create mode 100644 core/test/martian/schema_tools_test.cljc diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 0a720309..2aa45a43 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -4,8 +4,6 @@ [schema.spec.core :as spec]) #?(:clj (:import [schema.core MapEntry EqSchema]))) -;; TODO: Cover `key-seqs` and `walk-with-path` functions with some tests. - (defn unspecify-key [k] (if (s/specific-key? k) (s/explicit-schema-key k) @@ -52,6 +50,8 @@ ;; +;; TODO: Cover the `walk-with-path` function with some tests. + (defn walk-with-path "Similar to the `schema-tools.walk/walk` except it keeps track of the `path` through the data structure as it goes, calling `inner` and `outer` with two diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc new file mode 100644 index 00000000..be298792 --- /dev/null +++ b/core/test/martian/schema_tools_test.cljc @@ -0,0 +1,64 @@ +(ns martian.schema-tools-test + (:require [martian.schema-tools :refer [key-seqs]] + [schema.core :as s] + [schema-tools.core :as st] + #?(:clj [clojure.test :refer [deftest testing is]] + :cljs [cljs.test :refer-macros [deftest testing is]]))) + +(deftest key-seqs-test + (testing "map schemas with optional keys" + (is (= [[] + [:fooBar] + [:BAR] + [:Baz]] + (key-seqs {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz s/Str})))) + + (testing "nested map and vector schemas" + (is (= [[] + [:fooBar] + [:BAR] + [:Baz] + [:Baz :QUU] + [:Baz :Quux] + [:Baz :Quux :Fizz]] + (key-seqs {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz {:QUU s/Str + :Quux [{:Fizz s/Str}]}})))) + + (testing "deeply nested vector schemas" + (is (= [[] + [:FOO] + [:FOO :Bar] + [:FOO :Bar :martian.schema-tools/idx] + [:FOO :Bar :martian.schema-tools/idx :barDoo] + [:FOO :Bar :martian.schema-tools/idx :barDee]] + (key-seqs {(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str + (s/optional-key :barDee) s/Str}]]}})) + "Must contain paths with qualified indexes inside the nested vector")) + + (testing "default schemas" + (is (= [[] + [:fooBar] + [:BAR] + [:Baz] + [:Baz :schema] + [:Baz :value] + [:Baz :schema :QUU] + [:Baz :schema :Quux] + [:Baz :value :QUU] + [:Baz :value :Quux] + [:Baz :QUU] + [:Baz :Quux] + [:Baz :schema :Quux :Fizz] + [:Baz :Quux :Fizz]] + (key-seqs {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})})) + "Must contain paths for both the schema and a data described by it"))) From 2ecf1fbbff82347319f94e163d88549b0322d5cf Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sun, 5 Oct 2025 10:12:13 +0400 Subject: [PATCH 11/37] Cover the `martian.schema-tool/prewalk-with-path` fn with tests --- core/src/martian/schema_tools.cljc | 2 - core/test/martian/schema_tools_test.cljc | 154 ++++++++++++++++++++++- 2 files changed, 153 insertions(+), 3 deletions(-) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 2aa45a43..0ef4933d 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -50,8 +50,6 @@ ;; -;; TODO: Cover the `walk-with-path` function with some tests. - (defn walk-with-path "Similar to the `schema-tools.walk/walk` except it keeps track of the `path` through the data structure as it goes, calling `inner` and `outer` with two diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index be298792..f299e91c 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -1,5 +1,5 @@ (ns martian.schema-tools-test - (:require [martian.schema-tools :refer [key-seqs]] + (:require [martian.schema-tools :refer [key-seqs prewalk-with-path]] [schema.core :as s] [schema-tools.core :as st] #?(:clj [clojure.test :refer [deftest testing is]] @@ -62,3 +62,155 @@ {:QUU "hi" :Quux []})})) "Must contain paths for both the schema and a data described by it"))) + +(deftest key-seqs-test + (testing "map schemas with optional keys" + (let [paths+forms (atom [])] + (prewalk-with-path (fn [path form] + (swap! paths+forms conj [path form]) + form) + [] + {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz s/Str}) + (is (= [[[] {:fooBar s/Str, (s/optional-key :BAR) s/Str, :Baz s/Str}] + [[] [:fooBar s/Str]] + [[] :fooBar] + [[:fooBar] s/Str] + [[] [(s/optional-key :BAR) s/Str]] + [[] (s/optional-key :BAR)] + [[] [:k :BAR]] + [[] :k] + [[:k] :BAR] + [[(s/optional-key :BAR)] s/Str] + [[] [:Baz s/Str]] + [[] :Baz] + [[:Baz] s/Str]] + @paths+forms)))) + + (testing "nested map and vector schemas" + (let [paths+forms (atom [])] + (prewalk-with-path (fn [path form] + (swap! paths+forms conj [path form]) + form) + [] + {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz {:QUU s/Str + :Quux [{:Fizz s/Str}]}}) + (is (= [[[] {:fooBar s/Str, + (s/optional-key :BAR) s/Str, + :Baz {:QUU s/Str, :Quux [{:Fizz s/Str}]}}] + [[] [:fooBar s/Str]] + [[] :fooBar] + [[:fooBar] s/Str] + [[] [(s/optional-key :BAR) s/Str]] + [[] (s/optional-key :BAR)] + [[] [:k :BAR]] + [[] :k] + [[:k] :BAR] + [[(s/optional-key :BAR)] s/Str] + [[] [:Baz {:QUU s/Str, :Quux [{:Fizz s/Str}]}]] + [[] :Baz] + [[:Baz] {:QUU s/Str, :Quux [{:Fizz s/Str}]}] + [[:Baz] [:QUU s/Str]] + [[:Baz] :QUU] + [[:Baz :QUU] s/Str] + [[:Baz] [:Quux [{:Fizz s/Str}]]] + [[:Baz] :Quux] + [[:Baz :Quux] [{:Fizz s/Str}]] + [[:Baz :Quux] {:Fizz s/Str}] + [[:Baz :Quux] [:Fizz s/Str]] + [[:Baz :Quux] :Fizz] + [[:Baz :Quux :Fizz] s/Str]] + @paths+forms)))) + + (testing "deeply nested vector schemas" + (let [paths+forms (atom [])] + (prewalk-with-path (fn [path form] + (swap! paths+forms conj [path form]) + form) + [] + {(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str + (s/optional-key :barDee) s/Str}]]}}) + (is (= [[[] {(s/optional-key :FOO) {:Bar [[{:barDoo s/Str, + (s/optional-key :barDee) s/Str}]]}}] + [[] [(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str, (s/optional-key :barDee) s/Str}]]}]] + [[] (s/optional-key :FOO)] + [[] [:k :FOO]] + [[] :k] + [[:k] :FOO] + [[(s/optional-key :FOO)] + {:Bar [[{:barDoo s/Str, (s/optional-key :barDee) s/Str}]]}] + [[(s/optional-key :FOO)] + [:Bar [[{:barDoo s/Str, (s/optional-key :barDee) s/Str}]]]] + [[(s/optional-key :FOO)] :Bar] + [[(s/optional-key :FOO) :Bar] + [[{:barDoo s/Str, (s/optional-key :barDee) s/Str}]]] + [[(s/optional-key :FOO) :Bar] + [{:barDoo s/Str, (s/optional-key :barDee) s/Str}]] + [[(s/optional-key :FOO) :Bar] + {:barDoo s/Str, (s/optional-key :barDee) s/Str}] + [[(s/optional-key :FOO) :Bar] [:barDoo s/Str]] + [[(s/optional-key :FOO) :Bar] :barDoo] + [[(s/optional-key :FOO) :Bar :barDoo] s/Str] + [[(s/optional-key :FOO) :Bar] [(s/optional-key :barDee) s/Str]] + [[(s/optional-key :FOO) :Bar] (s/optional-key :barDee)] + [[(s/optional-key :FOO) :Bar] [:k :barDee]] + [[(s/optional-key :FOO) :Bar] :k] + [[(s/optional-key :FOO) :Bar :k] :barDee] + [[(s/optional-key :FOO) :Bar (s/optional-key :barDee)] s/Str]] + @paths+forms)))) + + (testing "default schemas" + (let [paths+forms (atom [])] + (prewalk-with-path (fn [path form] + (swap! paths+forms conj [path form]) + form) + [] + {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})}) + (is (= [[[] {:fooBar s/Str, + (s/optional-key :BAR) s/Str, + :Baz (st/default {:QUU s/Str, :Quux [{:Fizz s/Str}]} {:QUU "hi", :Quux []})}] + [[] [:fooBar s/Str]] + [[] :fooBar] + [[:fooBar] s/Str] + [[] [(s/optional-key :BAR) s/Str]] + [[] (s/optional-key :BAR)] + [[] [:k :BAR]] + [[] :k] + [[:k] :BAR] + [[(s/optional-key :BAR)] s/Str] + [[] [:Baz (st/default {:QUU s/Str, :Quux [{:Fizz s/Str}]} {:QUU "hi", :Quux []})]] + [[] :Baz] + [[:Baz] (st/default {:QUU s/Str, :Quux [{:Fizz s/Str}]} {:QUU "hi", :Quux []})] + [[:Baz] [:schema {:QUU s/Str, :Quux [{:Fizz s/Str}]}]] + [[:Baz] :schema] + [[:Baz :schema] {:QUU s/Str, :Quux [{:Fizz s/Str}]}] + [[:Baz :schema] [:QUU s/Str]] + [[:Baz :schema] :QUU] + [[:Baz :schema :QUU] s/Str] + [[:Baz :schema] [:Quux [{:Fizz s/Str}]]] + [[:Baz :schema] :Quux] + [[:Baz :schema :Quux] [{:Fizz s/Str}]] + [[:Baz :schema :Quux] {:Fizz s/Str}] + [[:Baz :schema :Quux] [:Fizz s/Str]] + [[:Baz :schema :Quux] :Fizz] + [[:Baz :schema :Quux :Fizz] s/Str] + [[:Baz] [:value {:QUU "hi", :Quux []}]] + [[:Baz] :value] + [[:Baz :value] {:QUU "hi", :Quux []}] + [[:Baz :value] [:QUU "hi"]] + [[:Baz :value] :QUU] + [[:Baz :value :QUU] "hi"] + [[:Baz :value] [:Quux []]] + [[:Baz :value] :Quux] + [[:Baz :value :Quux] []]] + @paths+forms))))) From 332d3b1902d19bf180e400d38def926bd10f2170 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Mon, 6 Oct 2025 04:11:27 +0400 Subject: [PATCH 12/37] Fix a typo in the `prewalk-with-path-test` name --- core/test/martian/schema_tools_test.cljc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index f299e91c..9f4a91f8 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -63,7 +63,7 @@ :Quux []})})) "Must contain paths for both the schema and a data described by it"))) -(deftest key-seqs-test +(deftest prewalk-with-path-test (testing "map schemas with optional keys" (let [paths+forms (atom [])] (prewalk-with-path (fn [path form] From 05797631027e1f9038d3fb4e360645019e68621e Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Mon, 6 Oct 2025 04:19:48 +0400 Subject: [PATCH 13/37] Test for all sorts of key types in map schemas --- core/test/martian/parameter_aliases_test.cljc | 30 +++++++++---------- core/test/martian/schema_tools_test.cljc | 8 ++--- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index 5becf4f5..a4fcfb91 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -7,13 +7,13 @@ (deftest parameter-aliases-test (testing "produces idiomatic aliases for all keys in a schema" - (testing "map schemas with optional keys" + (testing "map schemas (with all sorts of keys)" (is (= {[] {:foo-bar :fooBar :bar :BAR :baz :Baz}} (parameter-aliases {:fooBar s/Str (s/optional-key :BAR) s/Str - :Baz s/Str})))) + (s/required-key :Baz) s/Str})))) (testing "nested map and vector schemas" (is (= {[] {:foo-bar :fooBar @@ -59,16 +59,16 @@ (deftest unalias-data-test (testing "renames idiomatic keys back to original" - (testing "map schemas with optional keys" - (is (= {:FOO "a" - :fooBar "b" - :Bar "c"} - (let [schema {:FOO s/Str - :fooBar s/Str - (s/optional-key :Bar) s/Str}] - (unalias-data (parameter-aliases schema) {:foo "a" - :foo-bar "b" - :bar "c"}))))) + (testing "map schemas (with all sorts of keys)" + (is (= {:fooBar "a" + :BAR "b" + :Baz "c"} + (let [schema {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str}] + (unalias-data (parameter-aliases schema) {:foo-bar "a" + :bar "b" + :baz "c"}))))) (testing "nested map and vector schemas" (is (= {:FOO {:fooBar "b" @@ -113,13 +113,13 @@ (deftest alias-schema-test (testing "renames schema keys into idiomatic keys" - (testing "map schemas with optional keys" + (testing "map schemas (with all sorts of keys)" (is (= {:foo-bar s/Str (s/optional-key :bar) s/Str - :baz s/Str} + (s/required-key :baz) s/Str} (let [schema {:fooBar s/Str (s/optional-key :BAR) s/Str - :Baz s/Str}] + (s/required-key :Baz) s/Str}] (alias-schema (parameter-aliases schema) schema))))) (testing "nested map and vector schemas" diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index 9f4a91f8..70e7e53b 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -6,14 +6,14 @@ :cljs [cljs.test :refer-macros [deftest testing is]]))) (deftest key-seqs-test - (testing "map schemas with optional keys" + (testing "map schemas (with all sorts of keys)" (is (= [[] [:fooBar] [:BAR] [:Baz]] (key-seqs {:fooBar s/Str (s/optional-key :BAR) s/Str - :Baz s/Str})))) + (s/required-key :Baz) s/Str})))) (testing "nested map and vector schemas" (is (= [[] @@ -64,7 +64,7 @@ "Must contain paths for both the schema and a data described by it"))) (deftest prewalk-with-path-test - (testing "map schemas with optional keys" + (testing "map schemas (with all sorts of keys)" (let [paths+forms (atom [])] (prewalk-with-path (fn [path form] (swap! paths+forms conj [path form]) @@ -72,7 +72,7 @@ [] {:fooBar s/Str (s/optional-key :BAR) s/Str - :Baz s/Str}) + (s/required-key :Baz) s/Str}) (is (= [[[] {:fooBar s/Str, (s/optional-key :BAR) s/Str, :Baz s/Str}] [[] [:fooBar s/Str]] [[] :fooBar] From ddf76bc521503a24695aa394bb57183618dd0c87 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Mon, 6 Oct 2025 12:20:51 +0400 Subject: [PATCH 14/37] Add/update test cases for `st/default` schemas --- core/test/martian/parameter_aliases_test.cljc | 32 +++++++++++++++++-- core/test/martian/schema_tools_test.cljc | 20 ++++++++++-- 2 files changed, 48 insertions(+), 4 deletions(-) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index a4fcfb91..77c90043 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -51,7 +51,18 @@ :Baz (st/default {:QUU s/Str :Quux [{:Fizz s/Str}]} {:QUU "hi" - :Quux []})})))) + :Quux []})})) + "Must contain aliases for both the schema and a data described by it") + (is (= {[] {:quu :QUU, :quux :Quux} + [:quux] {:fizz :Fizz} + [:schema] {:quu :QUU, :quux :Quux} + [:schema :quux] {:fizz :Fizz} + [:value] {:quu :QUU, :quux :Quux}} + (parameter-aliases (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []}))) + "Must contain aliases for both the schema and a data described by it")) (testing "qualified keys are not aliased" (is (= {} (parameter-aliases {:foo/Bar s/Str @@ -101,7 +112,15 @@ (unalias-data (parameter-aliases schema) {:foo-bar "a" :bar "b" :baz {:quu "c" - :quux [{:fizz "d"}]}}))))) + :quux [{:fizz "d"}]}})))) + (is (= {:QUU "c" + :Quux [{:Fizz "d"}]} + (let [schema (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})] + (unalias-data (parameter-aliases schema) {:quu "c" + :quux [{:fizz "d"}]}))))) (testing "qualified keys are not aliased" (is (= {:foo/Bar "a" @@ -151,6 +170,15 @@ :Quux [{:Fizz s/Str}]} {:QUU "hi" :Quux []})}] + (alias-schema (parameter-aliases schema) schema)))) + (is (= (st/default {:quu s/Str + :quux [{:fizz s/Str}]} + {:quu "hi" + :quux []}) + (let [schema (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})] (alias-schema (parameter-aliases schema) schema))))) (testing "qualified keys are not aliased" diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index 70e7e53b..ee52c837 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -46,14 +46,14 @@ [:BAR] [:Baz] [:Baz :schema] - [:Baz :value] [:Baz :schema :QUU] [:Baz :schema :Quux] + [:Baz :schema :Quux :Fizz] + [:Baz :value] [:Baz :value :QUU] [:Baz :value :Quux] [:Baz :QUU] [:Baz :Quux] - [:Baz :schema :Quux :Fizz] [:Baz :Quux :Fizz]] (key-seqs {:fooBar s/Str (s/optional-key :BAR) s/Str @@ -61,6 +61,22 @@ :Quux [{:Fizz s/Str}]} {:QUU "hi" :Quux []})})) + "Must contain paths for both the schema and a data described by it") + (is (= [[] + [:schema] + [:schema :QUU] + [:schema :Quux] + [:schema :Quux :Fizz] + [:value] + [:value :QUU] + [:value :Quux] + [:QUU] + [:Quux] + [:Quux :Fizz]] + (key-seqs (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []}))) "Must contain paths for both the schema and a data described by it"))) (deftest prewalk-with-path-test From 726064cb7478cf4202f901c91cb41e21df384200 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Mon, 6 Oct 2025 12:24:36 +0400 Subject: [PATCH 15/37] Add test cases for `named` schemas --- core/test/martian/parameter_aliases_test.cljc | 16 ++++++++++++++++ core/test/martian/schema_tools_test.cljc | 14 +++++++++++--- 2 files changed, 27 insertions(+), 3 deletions(-) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index 77c90043..d42b6eeb 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -64,6 +64,12 @@ :Quux []}))) "Must contain aliases for both the schema and a data described by it")) + (testing "named schemas" + (is (= {[] {:foo-bar :fooBar} + [:schema] {:foo-bar :fooBar}} + (parameter-aliases (s/named {:fooBar s/Str} "FooBar"))) + "Must contain aliases for both the schema and a data described by it")) + (testing "qualified keys are not aliased" (is (= {} (parameter-aliases {:foo/Bar s/Str :Baz/DOO s/Str})))))) @@ -122,6 +128,11 @@ (unalias-data (parameter-aliases schema) {:quu "c" :quux [{:fizz "d"}]}))))) + (testing "named schemas" + (is (= {:fooBar "a"} + (let [schema (s/named {:fooBar s/Str} "FooBar")] + (unalias-data (parameter-aliases schema) {:foo-bar "a"}))))) + (testing "qualified keys are not aliased" (is (= {:foo/Bar "a" :Baz/DOO "b"} @@ -181,6 +192,11 @@ :Quux []})] (alias-schema (parameter-aliases schema) schema))))) + (testing "named schemas" + (is (= (s/named {:foo-bar s/Str} "FooBar") + (let [schema (s/named {:fooBar s/Str} "FooBar")] + (alias-schema (parameter-aliases schema) schema))))) + (testing "qualified keys are not aliased" (is (= {:foo/Bar s/Str :Baz/DOO s/Str} diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index ee52c837..556871c7 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -32,9 +32,8 @@ (is (= [[] [:FOO] [:FOO :Bar] - [:FOO :Bar :martian.schema-tools/idx] - [:FOO :Bar :martian.schema-tools/idx :barDoo] - [:FOO :Bar :martian.schema-tools/idx :barDee]] + [:FOO :Bar :barDoo] + [:FOO :Bar :barDee]] (key-seqs {(s/optional-key :FOO) {:Bar [[{:barDoo s/Str (s/optional-key :barDee) s/Str}]]}})) @@ -77,6 +76,15 @@ :Quux [{:Fizz s/Str}]} {:QUU "hi" :Quux []}))) + "Must contain paths for both the schema and a data described by it")) + + (testing "named schemas" + (is (= [[] + [:schema] + [:schema :fooBar] + [:name] + [:fooBar]] + (key-seqs (s/named {:fooBar s/Str} "FooBar"))) "Must contain paths for both the schema and a data described by it"))) (deftest prewalk-with-path-test From 34a97b349502d2473a67a9f71b7d9de17c66bd60 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Mon, 6 Oct 2025 12:44:51 +0400 Subject: [PATCH 16/37] Add test cases for `maybe` schemas --- core/test/martian/parameter_aliases_test.cljc | 27 +++++++++++++++++++ core/test/martian/schema_tools_test.cljc | 14 ++++++++++ 2 files changed, 41 insertions(+) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index d42b6eeb..cde08b27 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -70,6 +70,17 @@ (parameter-aliases (s/named {:fooBar s/Str} "FooBar"))) "Must contain aliases for both the schema and a data described by it")) + (testing "maybe schemas" + (is (= {[] {:foo-bar :fooBar} + [:foo-bar] {:baz :Baz} + [:foo-bar :schema] {:baz :Baz}} + (parameter-aliases {:fooBar (s/maybe {:Baz s/Str})})) + "Must contain aliases for both the schema and a data described by it") + (is (= {[] {:foo-bar :fooBar} + [:schema] {:foo-bar :fooBar}} + (parameter-aliases (s/maybe {:fooBar s/Str}))) + "Must contain aliases for both the schema and a data described by it")) + (testing "qualified keys are not aliased" (is (= {} (parameter-aliases {:foo/Bar s/Str :Baz/DOO s/Str})))))) @@ -133,6 +144,14 @@ (let [schema (s/named {:fooBar s/Str} "FooBar")] (unalias-data (parameter-aliases schema) {:foo-bar "a"}))))) + (testing "maybe schemas" + (is (= {:fooBar {:Baz "a"}} + (let [schema {:fooBar (s/maybe {:Baz s/Str})}] + (unalias-data (parameter-aliases schema) {:foo-bar {:baz "a"}})))) + (is (= {:fooBar "a"} + (let [schema (s/maybe {:fooBar s/Str})] + (unalias-data (parameter-aliases schema) {:foo-bar "a"}))))) + (testing "qualified keys are not aliased" (is (= {:foo/Bar "a" :Baz/DOO "b"} @@ -197,6 +216,14 @@ (let [schema (s/named {:fooBar s/Str} "FooBar")] (alias-schema (parameter-aliases schema) schema))))) + (testing "maybe schemas" + (is (= {:foo-bar (s/maybe {:baz s/Str})} + (let [schema {:fooBar (s/maybe {:Baz s/Str})}] + (alias-schema (parameter-aliases schema) schema)))) + (is (= (s/maybe {:foo-bar s/Str}) + (let [schema (s/maybe {:fooBar s/Str})] + (alias-schema (parameter-aliases schema) schema))))) + (testing "qualified keys are not aliased" (is (= {:foo/Bar s/Str :Baz/DOO s/Str} diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index 556871c7..2614b6d4 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -85,6 +85,20 @@ [:name] [:fooBar]] (key-seqs (s/named {:fooBar s/Str} "FooBar"))) + "Must contain paths for both the schema and a data described by it")) + + (testing "maybe schemas" + (is (= [[] + [:schema] + [:schema :fooBar] + [:fooBar]] + (key-seqs (s/maybe {:fooBar s/Str}))) + "Must contain paths for both the schema and a data described by it") + (is (= [[] + [:fooBar] + [:fooBar :Baz] + [:fooBar :Baz :schema]] + (key-seqs {:fooBar {:Baz (s/maybe s/Str)}})) "Must contain paths for both the schema and a data described by it"))) (deftest prewalk-with-path-test From b82369539e2dbc8c7fe9c14b8e7831ff391d1e10 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Mon, 6 Oct 2025 18:42:10 +0400 Subject: [PATCH 17/37] Add test cases for `constrained` schemas --- core/test/martian/parameter_aliases_test.cljc | 31 ++++++++++++++++++- core/test/martian/schema_tools_test.cljc | 22 +++++++++++-- 2 files changed, 50 insertions(+), 3 deletions(-) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index cde08b27..97af1935 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -1,10 +1,14 @@ (ns martian.parameter-aliases-test - (:require [martian.parameter-aliases :refer [parameter-aliases unalias-data alias-schema]] + (:require [clojure.string :as str] + [martian.parameter-aliases :refer [parameter-aliases unalias-data alias-schema]] [schema-tools.core :as st] [schema.core :as s] #?(:clj [clojure.test :refer [deftest testing is]] :cljs [cljs.test :refer-macros [deftest testing is]]))) +(defn not-blank? [s] + (not (str/blank? s))) + (deftest parameter-aliases-test (testing "produces idiomatic aliases for all keys in a schema" (testing "map schemas (with all sorts of keys)" @@ -81,6 +85,15 @@ (parameter-aliases (s/maybe {:fooBar s/Str}))) "Must contain aliases for both the schema and a data described by it")) + (testing "constrained schemas" + (is (= {[] {:foo-bar :fooBar}} + (parameter-aliases {:fooBar (s/constrained s/Str not-blank?)}))) + (is (= {[] {:foo-bar :fooBar} + [:foo-bar :schema] {:baz :Baz} + [:foo-bar] {:baz :Baz}} + (parameter-aliases {:fooBar (s/constrained {:Baz s/Str} some?)})) + "Must contain aliases for both the schema and a data described by it")) + (testing "qualified keys are not aliased" (is (= {} (parameter-aliases {:foo/Bar s/Str :Baz/DOO s/Str})))))) @@ -152,6 +165,14 @@ (let [schema (s/maybe {:fooBar s/Str})] (unalias-data (parameter-aliases schema) {:foo-bar "a"}))))) + (testing "constrained schemas" + (is (= {:fooBar "a"} + (let [schema {:fooBar (s/constrained s/Str not-blank?)}] + (unalias-data (parameter-aliases schema) {:foo-bar "a"})))) + (is (= {:fooBar {:Baz "b"}} + (let [schema {:fooBar (s/constrained {:Baz s/Str} some?)}] + (unalias-data (parameter-aliases schema) {:foo-bar {:baz "b"}}))))) + (testing "qualified keys are not aliased" (is (= {:foo/Bar "a" :Baz/DOO "b"} @@ -224,6 +245,14 @@ (let [schema (s/maybe {:fooBar s/Str})] (alias-schema (parameter-aliases schema) schema))))) + (testing "constrained schemas" + (is (= {:foo-bar (s/constrained s/Str not-blank?)} + (let [schema {:fooBar (s/constrained s/Str not-blank?)}] + (alias-schema (parameter-aliases schema) schema)))) + (is (= {:foo-bar (s/constrained {:baz s/Str} some?)} + (let [schema {:fooBar (s/constrained {:Baz s/Str} some?)}] + (alias-schema (parameter-aliases schema) schema))))) + (testing "qualified keys are not aliased" (is (= {:foo/Bar s/Str :Baz/DOO s/Str} diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index 2614b6d4..df097fae 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -1,5 +1,6 @@ (ns martian.schema-tools-test - (:require [martian.schema-tools :refer [key-seqs prewalk-with-path]] + (:require [clojure.string :as str] + [martian.schema-tools :refer [key-seqs prewalk-with-path]] [schema.core :as s] [schema-tools.core :as st] #?(:clj [clojure.test :refer [deftest testing is]] @@ -99,7 +100,24 @@ [:fooBar :Baz] [:fooBar :Baz :schema]] (key-seqs {:fooBar {:Baz (s/maybe s/Str)}})) - "Must contain paths for both the schema and a data described by it"))) + "Must contain paths for both the schema and a data described by it")) + + (testing "constrained schemas" + (is (= [[] + [:fooBar] + [:fooBar :schema] + [:fooBar :postcondition] + [:fooBar :post-name]] + (key-seqs {:fooBar (s/constrained s/Str (complement str/blank?))})) + "Must contain paths for both the schema and a data described by it") + (is (= [[] + [:fooBar] + [:fooBar :schema] + [:fooBar :schema :Baz] + [:fooBar :postcondition] + [:fooBar :post-name] + [:fooBar :Baz]] + (key-seqs {:fooBar (s/constrained {:Baz s/Str} some?)}))))) (deftest prewalk-with-path-test (testing "map schemas (with all sorts of keys)" From ef5917e93d5dbebc4dad97963f51f3485fa8a9a6 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Tue, 7 Oct 2025 11:54:21 +0400 Subject: [PATCH 18/37] Add test cases for `both`/`either` schemas --- core/test/martian/parameter_aliases_test.cljc | 168 ++++++++++++++++++ core/test/martian/schema_tools_test.cljc | 86 ++++++++- 2 files changed, 253 insertions(+), 1 deletion(-) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index 97af1935..a54c27f0 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -94,6 +94,52 @@ (parameter-aliases {:fooBar (s/constrained {:Baz s/Str} some?)})) "Must contain aliases for both the schema and a data described by it")) + (testing "both schemas" + (is (= {[] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:quux] {:fizz :Fizz} + [:schemas] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:schemas :quux] {:fizz :Fizz}} + (parameter-aliases (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]}))) + "Must contain aliases for both the schema and a data described by it") + (is (= {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:foo :quux] {:fizz :Fizz} + [:foo :schemas] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:foo :schemas :quux] {:fizz :Fizz}} + (parameter-aliases {:FOO (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})})) + "Must contain aliases for both the schema and a data described by it")) + + (testing "either schemas" + (is (= {[] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:quux] {:fizz :Fizz} + [:schemas] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:schemas :quux] {:fizz :Fizz}} + (parameter-aliases (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]}))) + "Must contain aliases for both the schema and a data described by it") + (is (= {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:foo :quux] {:fizz :Fizz} + [:foo :schemas] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:foo :schemas :quux] {:fizz :Fizz}} + (parameter-aliases {:FOO (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})})) + "Must contain aliases for both the schema and a data described by it")) + (testing "qualified keys are not aliased" (is (= {} (parameter-aliases {:foo/Bar s/Str :Baz/DOO s/Str})))))) @@ -173,6 +219,80 @@ (let [schema {:fooBar (s/constrained {:Baz s/Str} some?)}] (unalias-data (parameter-aliases schema) {:foo-bar {:baz "b"}}))))) + (testing "both schemas" + (is (= {:fooBar "a" + :BAR "b" + :Baz "c" + :QUU "c" + :Quux [{:Fizz "d"}]} + (let [schema (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (unalias-data (parameter-aliases schema) {:foo-bar "a" + :bar "b" + :baz "c" + :quu "c" + :quux [{:fizz "d"}]})))) + (is (= {:FOO {:fooBar "a" + :BAR "b" + :Baz "c" + :QUU "c" + :Quux [{:Fizz "d"}]}} + (let [schema {:FOO (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a" + :bar "b" + :baz "c" + :quu "c" + :quux [{:fizz "d"}]}}))))) + + (testing "either schemas" + (is (= {:fooBar "a" + :BAR "b" + :Baz "c"} + (let [schema (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (unalias-data (parameter-aliases schema) {:foo-bar "a" + :bar "b" + :baz "c"})))) + (is (= {:QUU "c" + :Quux [{:Fizz "d"}]} + (let [schema (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (unalias-data (parameter-aliases schema) {:quu "c" + :quux [{:fizz "d"}]})))) + (is (= {:FOO {:fooBar "a" + :BAR "b" + :Baz "c"}} + (let [schema {:FOO (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a" + :bar "b" + :baz "c"}})))) + (is (= {:FOO {:QUU "c" + :Quux [{:Fizz "d"}]}} + (let [schema {:FOO (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (unalias-data (parameter-aliases schema) {:foo {:quu "c" + :quux [{:fizz "d"}]}}))))) + (testing "qualified keys are not aliased" (is (= {:foo/Bar "a" :Baz/DOO "b"} @@ -253,6 +373,54 @@ (let [schema {:fooBar (s/constrained {:Baz s/Str} some?)}] (alias-schema (parameter-aliases schema) schema))))) + (testing "both schemas" + (is (= (s/both {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + {:quu s/Str + :quux [{:fizz s/Str}]}) + (let [schema (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (alias-schema (parameter-aliases schema) schema)))) + (is (= {:foo (s/both {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + {:quu s/Str + :quux [{:fizz s/Str}]})} + (let [schema {:FOO (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (alias-schema (parameter-aliases schema) schema))))) + + (testing "either schemas" + (is (= (s/either {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + {:quu s/Str + :quux [{:fizz s/Str}]}) + (let [schema (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (alias-schema (parameter-aliases schema) schema)))) + (is (= {:foo (s/either {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + {:quu s/Str + :quux [{:fizz s/Str}]})} + (let [schema {:FOO (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (alias-schema (parameter-aliases schema) schema))))) + (testing "qualified keys are not aliased" (is (= {:foo/Bar s/Str :Baz/DOO s/Str} diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index df097fae..1a8dd1b3 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -117,7 +117,91 @@ [:fooBar :postcondition] [:fooBar :post-name] [:fooBar :Baz]] - (key-seqs {:fooBar (s/constrained {:Baz s/Str} some?)}))))) + (key-seqs {:fooBar (s/constrained {:Baz s/Str} some?)})))) + + (testing "both schemas" + (is (= [[] + [:schemas :fooBar] + [:schemas :BAR] + [:schemas :Baz] + [:schemas :QUU] + [:schemas :Quux] + [:schemas :Quux :Fizz] + [:fooBar] + [:BAR] + [:Baz] + [:QUU] + [:Quux] + [:Quux :Fizz]] + (key-seqs (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]}))) + "Must contain paths for both the schema and a data described by it") + (is (= [[] + [:FOO] + [:FOO :schemas :fooBar] + [:FOO :schemas :BAR] + [:FOO :schemas :Baz] + [:FOO :schemas :QUU] + [:FOO :schemas :Quux] + [:FOO :schemas :Quux :Fizz] + [:FOO :fooBar] + [:FOO :BAR] + [:FOO :Baz] + [:FOO :QUU] + [:FOO :Quux] + [:FOO :Quux :Fizz]] + (key-seqs {:FOO (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})})) + "Must contain paths for both the schema and a data described by it")) + + (testing "either schemas" + (is (= [[] + [:schemas :fooBar] + [:schemas :BAR] + [:schemas :Baz] + [:schemas :QUU] + [:schemas :Quux] + [:schemas :Quux :Fizz] + [:fooBar] + [:BAR] + [:Baz] + [:QUU] + [:Quux] + [:Quux :Fizz]] + (key-seqs (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]}))) + "Must contain paths for both the schema and a data described by it") + (is (= [[] + [:FOO] + [:FOO :schemas :fooBar] + [:FOO :schemas :BAR] + [:FOO :schemas :Baz] + [:FOO :schemas :QUU] + [:FOO :schemas :Quux] + [:FOO :schemas :Quux :Fizz] + [:FOO :fooBar] + [:FOO :BAR] + [:FOO :Baz] + [:FOO :QUU] + [:FOO :Quux] + [:FOO :Quux :Fizz]] + (key-seqs {:FOO (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})})) + "Must contain paths for both the schema and a data described by it")) + + ) (deftest prewalk-with-path-test (testing "map schemas (with all sorts of keys)" From 7c0e4a28cda5c19ca58ef833ebf85d7d3e6de6ef Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Tue, 7 Oct 2025 19:20:40 +0400 Subject: [PATCH 19/37] Add test cases for `cond-pre` schemas --- core/test/martian/parameter_aliases_test.cljc | 33 +++++++++++++++++++ core/test/martian/schema_tools_test.cljc | 13 +++++++- 2 files changed, 45 insertions(+), 1 deletion(-) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index a54c27f0..9e1a8320 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -140,6 +140,17 @@ :Quux [{:Fizz s/Str}]})})) "Must contain aliases for both the schema and a data described by it")) + (testing "cond-pre schemas" + (is (= {[] {:foo-bar :fooBar} + [:schemas] {:foo-bar :fooBar}} + (parameter-aliases (s/cond-pre {:fooBar s/Str} s/Str))) + "Must contain paths for both the schema and a data described by it") + (is (= {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar} + [:foo :schemas] {:foo-bar :fooBar}} + (parameter-aliases {:FOO (s/cond-pre {:fooBar s/Str} s/Str)})) + "Must contain paths for both the schema and a data described by it")) + (testing "qualified keys are not aliased" (is (= {} (parameter-aliases {:foo/Bar s/Str :Baz/DOO s/Str})))))) @@ -293,6 +304,20 @@ (unalias-data (parameter-aliases schema) {:foo {:quu "c" :quux [{:fizz "d"}]}}))))) + (testing "cond-pre schemas" + (is (= {:fooBar "a"} + (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] + (unalias-data (parameter-aliases schema) {:foo-bar "a"})))) + (is (= "b" + (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] + (unalias-data (parameter-aliases schema) "b")))) + (is (= {:FOO {:fooBar "a"}} + (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] + (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a"}})))) + (is (= {:FOO "b"} + (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] + (unalias-data (parameter-aliases schema) {:foo "b"}))))) + (testing "qualified keys are not aliased" (is (= {:foo/Bar "a" :Baz/DOO "b"} @@ -421,6 +446,14 @@ :Quux [{:Fizz s/Str}]})}] (alias-schema (parameter-aliases schema) schema))))) + (testing "cond-pre schemas" + (is (= (s/cond-pre {:foo-bar s/Str} s/Str) + (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] + (alias-schema (parameter-aliases schema) schema)))) + (is (= {:foo (s/cond-pre {:foo-bar s/Str} s/Str)} + (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] + (alias-schema (parameter-aliases schema) schema))))) + (testing "qualified keys are not aliased" (is (= {:foo/Bar s/Str :Baz/DOO s/Str} diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index 1a8dd1b3..10a9d623 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -201,7 +201,18 @@ :Quux [{:Fizz s/Str}]})})) "Must contain paths for both the schema and a data described by it")) - ) + (testing "cond-pre schemas" + (is (= [[] + [:schemas :fooBar] + [:fooBar]] + (key-seqs (s/cond-pre {:fooBar s/Str} s/Str))) + "Must contain paths for both the schema and a data described by it") + (is (= [[] + [:FOO] + [:FOO :schemas :fooBar] + [:FOO :fooBar]] + (key-seqs {:FOO (s/cond-pre {:fooBar s/Str} s/Str)})) + "Must contain paths for both the schema and a data described by it"))) (deftest prewalk-with-path-test (testing "map schemas (with all sorts of keys)" From b24d513d9295b6c717fde75b42389a634b8340d4 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Wed, 8 Oct 2025 13:51:12 +0400 Subject: [PATCH 20/37] Add test cases for `conditional` schemas --- core/test/martian/parameter_aliases_test.cljc | 126 ++++++++++++++++++ core/test/martian/schema_tools_test.cljc | 52 ++++++++ 2 files changed, 178 insertions(+) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index 9e1a8320..02604fe1 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -9,6 +9,13 @@ (defn not-blank? [s] (not (str/blank? s))) +(defn foo-map? [x] + (and (map? x) + (let [str-keys (map (comp str/lower-case name) (keys x))] + (boolean (some #(str/starts-with? % "foo") str-keys))))) + +(def not-foo-map? (complement foo-map?)) + (deftest parameter-aliases-test (testing "produces idiomatic aliases for all keys in a schema" (testing "map schemas (with all sorts of keys)" @@ -151,6 +158,35 @@ (parameter-aliases {:FOO (s/cond-pre {:fooBar s/Str} s/Str)})) "Must contain paths for both the schema and a data described by it")) + (testing "conditional schemas" + (is (= {[] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:quux] {:fizz :Fizz} + [:preds-and-schemas] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:preds-and-schemas :quux] {:fizz :Fizz}} + (parameter-aliases (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + :else + {:QUU s/Str + :Quux [{:Fizz s/Str}]}))) + "Must contain paths for both the schema and a data described by it") + (is (= {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:foo :quux] {:fizz :Fizz} + [:foo :preds-and-schemas] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:foo :preds-and-schemas :quux] {:fizz :Fizz}} + (parameter-aliases {:FOO (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + :else + {:QUU s/Str + :Quux [{:Fizz s/Str}]})})) + "Must contain paths for both the schema and a data described by it")) + (testing "qualified keys are not aliased" (is (= {} (parameter-aliases {:foo/Bar s/Str :Baz/DOO s/Str})))))) @@ -318,6 +354,60 @@ (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] (unalias-data (parameter-aliases schema) {:foo "b"}))))) + (testing "conditional schemas" + (is (= {:fooBar "a" + :BAR "b" + :Baz "c"} + (let [schema (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + not-foo-map? + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (unalias-data (parameter-aliases schema) {:foo-bar "a" + :bar "b" + :baz "c"})))) + (is (= {:QUU "c" + :Quux [{:Fizz "d"}]} + (let [schema (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + not-foo-map? + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (unalias-data (parameter-aliases schema) {:quu "c" + :quux [{:fizz "d"}]})))) + (is (= {:FOO {:fooBar "a" + :BAR "b" + :Baz "c"}} + (let [schema {:FOO (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + not-foo-map? + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a" + :bar "b" + :baz "c"}})))) + (is (= {:FOO {:QUU "c" + :Quux [{:Fizz "d"}]}} + (let [schema {:FOO (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + not-foo-map? + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (unalias-data (parameter-aliases schema) {:foo {:quu "c" + :quux [{:fizz "d"}]}}))))) + (testing "qualified keys are not aliased" (is (= {:foo/Bar "a" :Baz/DOO "b"} @@ -454,6 +544,42 @@ (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] (alias-schema (parameter-aliases schema) schema))))) + (testing "conditional schemas" + (is (= (s/conditional + foo-map? + {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + not-foo-map? + {:quu s/Str + :quux [{:fizz s/Str}]}) + (let [schema (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + not-foo-map? + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (alias-schema (parameter-aliases schema) schema)))) + (is (= {:foo (s/conditional + foo-map? + {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + not-foo-map? + {:quu s/Str + :quux [{:fizz s/Str}]})} + (let [schema {:FOO (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + not-foo-map? + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (alias-schema (parameter-aliases schema) schema))))) + (testing "qualified keys are not aliased" (is (= {:foo/Bar s/Str :Baz/DOO s/Str} diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index 10a9d623..7c617df6 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -6,6 +6,11 @@ #?(:clj [clojure.test :refer [deftest testing is]] :cljs [cljs.test :refer-macros [deftest testing is]]))) +(defn foo-map? [x] + (and (map? x) + (let [str-keys (map (comp str/lower-case name) (keys x))] + (boolean (some #(str/starts-with? % "foo") str-keys))))) + (deftest key-seqs-test (testing "map schemas (with all sorts of keys)" (is (= [[] @@ -212,6 +217,53 @@ [:FOO :schemas :fooBar] [:FOO :fooBar]] (key-seqs {:FOO (s/cond-pre {:fooBar s/Str} s/Str)})) + "Must contain paths for both the schema and a data described by it")) + + (testing "conditional schemas" + (is (= [[] + [:preds-and-schemas :fooBar] + [:preds-and-schemas :BAR] + [:preds-and-schemas :Baz] + [:preds-and-schemas :QUU] + [:preds-and-schemas :Quux] + [:preds-and-schemas :Quux :Fizz] + [:fooBar] + [:BAR] + [:Baz] + [:QUU] + [:Quux] + [:Quux :Fizz]] + (key-seqs (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + :else + {:QUU s/Str + :Quux [{:Fizz s/Str}]}))) + "Must contain paths for both the schema and a data described by it") + (is (= [[] + [:FOO] + [:FOO :preds-and-schemas :fooBar] + [:FOO :preds-and-schemas :BAR] + [:FOO :preds-and-schemas :Baz] + [:FOO :preds-and-schemas :QUU] + [:FOO :preds-and-schemas :Quux] + [:FOO :preds-and-schemas :Quux :Fizz] + [:FOO :fooBar] + [:FOO :BAR] + [:FOO :Baz] + [:FOO :QUU] + [:FOO :Quux] + [:FOO :Quux :Fizz]] + (key-seqs {:FOO (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + :else + {:QUU s/Str + :Quux [{:Fizz s/Str}]})})) "Must contain paths for both the schema and a data described by it"))) (deftest prewalk-with-path-test From ffe90325ad32e47d5307fb33f5d3a321c34ca37a Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Wed, 8 Oct 2025 13:59:14 +0400 Subject: [PATCH 21/37] Improve on the existing test coverage --- core/test/martian/parameter_aliases_test.cljc | 281 ++++++++++-------- core/test/martian/schema_tools_test.cljc | 14 +- 2 files changed, 161 insertions(+), 134 deletions(-) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index 02604fe1..cbfb71db 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -54,9 +54,12 @@ [:baz] {:quu :QUU :quux :Quux} [:baz :quux] {:fizz :Fizz} - [:baz :schema] {:quu :QUU, :quux :Quux} + [:baz :schema] {:quu :QUU + :quux :Quux} [:baz :schema :quux] {:fizz :Fizz} - [:baz :value] {:quu :QUU, :quux :Quux}} + [:baz :value] {:quu :QUU + :quux :Quux} + [:baz :value :quux] {:fizz :Fizz}} (parameter-aliases {:fooBar s/Str (s/optional-key :BAR) s/Str :Baz (st/default {:QUU s/Str @@ -64,11 +67,15 @@ {:QUU "hi" :Quux []})})) "Must contain aliases for both the schema and a data described by it") - (is (= {[] {:quu :QUU, :quux :Quux} + (is (= {[] {:quu :QUU + :quux :Quux} [:quux] {:fizz :Fizz} - [:schema] {:quu :QUU, :quux :Quux} + [:schema] {:quu :QUU + :quux :Quux} [:schema :quux] {:fizz :Fizz} - [:value] {:quu :QUU, :quux :Quux}} + [:value] {:quu :QUU + :quux :Quux} + [:value :quux] {:fizz :Fizz}} (parameter-aliases (st/default {:QUU s/Str :Quux [{:Fizz s/Str}]} {:QUU "hi" @@ -102,9 +109,17 @@ "Must contain aliases for both the schema and a data described by it")) (testing "both schemas" - (is (= {[] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + (is (= {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} [:quux] {:fizz :Fizz} - [:schemas] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} [:schemas :quux] {:fizz :Fizz}} (parameter-aliases (s/both {:fooBar s/Str (s/optional-key :BAR) s/Str @@ -113,9 +128,17 @@ :Quux [{:Fizz s/Str}]}))) "Must contain aliases for both the schema and a data described by it") (is (= {[] {:foo :FOO} - [:foo] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:foo] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} [:foo :quux] {:fizz :Fizz} - [:foo :schemas] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:foo :schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} [:foo :schemas :quux] {:fizz :Fizz}} (parameter-aliases {:FOO (s/both {:fooBar s/Str (s/optional-key :BAR) s/Str @@ -125,9 +148,17 @@ "Must contain aliases for both the schema and a data described by it")) (testing "either schemas" - (is (= {[] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + (is (= {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} [:quux] {:fizz :Fizz} - [:schemas] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} [:schemas :quux] {:fizz :Fizz}} (parameter-aliases (s/either {:fooBar s/Str (s/optional-key :BAR) s/Str @@ -136,9 +167,17 @@ :Quux [{:Fizz s/Str}]}))) "Must contain aliases for both the schema and a data described by it") (is (= {[] {:foo :FOO} - [:foo] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:foo] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} [:foo :quux] {:fizz :Fizz} - [:foo :schemas] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:foo :schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} [:foo :schemas :quux] {:fizz :Fizz}} (parameter-aliases {:FOO (s/either {:fooBar s/Str (s/optional-key :BAR) s/Str @@ -159,9 +198,17 @@ "Must contain paths for both the schema and a data described by it")) (testing "conditional schemas" - (is (= {[] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + (is (= {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} [:quux] {:fizz :Fizz} - [:preds-and-schemas] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:preds-and-schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} [:preds-and-schemas :quux] {:fizz :Fizz}} (parameter-aliases (s/conditional foo-map? @@ -173,9 +220,17 @@ :Quux [{:Fizz s/Str}]}))) "Must contain paths for both the schema and a data described by it") (is (= {[] {:foo :FOO} - [:foo] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:foo] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} [:foo :quux] {:fizz :Fizz} - [:foo :preds-and-schemas] {:foo-bar :fooBar, :bar :BAR, :baz :Baz, :quu :QUU, :quux :Quux} + [:foo :preds-and-schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} [:foo :preds-and-schemas :quux] {:fizz :Fizz}} (parameter-aliases {:FOO (s/conditional foo-map? @@ -224,8 +279,8 @@ (testing "default schemas" (is (= {:fooBar "a" :BAR "b" - :Baz {:QUU "c" - :Quux [{:Fizz "d"}]}} + :Baz {:QUU "x" + :Quux [{:Fizz "y"}]}} (let [schema {:fooBar s/Str (s/optional-key :BAR) s/Str :Baz (st/default {:QUU s/Str @@ -234,16 +289,16 @@ :Quux []})}] (unalias-data (parameter-aliases schema) {:foo-bar "a" :bar "b" - :baz {:quu "c" - :quux [{:fizz "d"}]}})))) - (is (= {:QUU "c" - :Quux [{:Fizz "d"}]} + :baz {:quu "x" + :quux [{:fizz "y"}]}})))) + (is (= {:QUU "x" + :Quux [{:Fizz "y"}]} (let [schema (st/default {:QUU s/Str :Quux [{:Fizz s/Str}]} {:QUU "hi" :Quux []})] - (unalias-data (parameter-aliases schema) {:quu "c" - :quux [{:fizz "d"}]}))))) + (unalias-data (parameter-aliases schema) {:quu "x" + :quux [{:fizz "y"}]}))))) (testing "named schemas" (is (= {:fooBar "a"} @@ -270,8 +325,8 @@ (is (= {:fooBar "a" :BAR "b" :Baz "c" - :QUU "c" - :Quux [{:Fizz "d"}]} + :QUU "x" + :Quux [{:Fizz "y"}]} (let [schema (s/both {:fooBar s/Str (s/optional-key :BAR) s/Str (s/required-key :Baz) s/Str} @@ -280,13 +335,13 @@ (unalias-data (parameter-aliases schema) {:foo-bar "a" :bar "b" :baz "c" - :quu "c" - :quux [{:fizz "d"}]})))) + :quu "x" + :quux [{:fizz "y"}]})))) (is (= {:FOO {:fooBar "a" :BAR "b" :Baz "c" - :QUU "c" - :Quux [{:Fizz "d"}]}} + :QUU "x" + :Quux [{:Fizz "y"}]}} (let [schema {:FOO (s/both {:fooBar s/Str (s/optional-key :BAR) s/Str (s/required-key :Baz) s/Str} @@ -295,118 +350,90 @@ (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a" :bar "b" :baz "c" - :quu "c" - :quux [{:fizz "d"}]}}))))) + :quu "x" + :quux [{:fizz "y"}]}}))))) (testing "either schemas" - (is (= {:fooBar "a" - :BAR "b" - :Baz "c"} - (let [schema (s/either {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - {:QUU s/Str - :Quux [{:Fizz s/Str}]})] + (let [schema (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (is (= {:fooBar "a" + :BAR "b" + :Baz "c"} (unalias-data (parameter-aliases schema) {:foo-bar "a" :bar "b" - :baz "c"})))) - (is (= {:QUU "c" - :Quux [{:Fizz "d"}]} - (let [schema (s/either {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - {:QUU s/Str - :Quux [{:Fizz s/Str}]})] - (unalias-data (parameter-aliases schema) {:quu "c" - :quux [{:fizz "d"}]})))) - (is (= {:FOO {:fooBar "a" - :BAR "b" - :Baz "c"}} - (let [schema {:FOO (s/either {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - {:QUU s/Str - :Quux [{:Fizz s/Str}]})}] + :baz "c"}))) + (is (= {:QUU "x" + :Quux [{:Fizz "y"}]} + (unalias-data (parameter-aliases schema) {:quu "x" + :quux [{:fizz "y"}]})))) + (let [schema {:FOO (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (is (= {:FOO {:fooBar "a" + :BAR "b" + :Baz "c"}} (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a" :bar "b" - :baz "c"}})))) - (is (= {:FOO {:QUU "c" - :Quux [{:Fizz "d"}]}} - (let [schema {:FOO (s/either {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - {:QUU s/Str - :Quux [{:Fizz s/Str}]})}] - (unalias-data (parameter-aliases schema) {:foo {:quu "c" - :quux [{:fizz "d"}]}}))))) + :baz "c"}}))) + (is (= {:FOO {:QUU "x" + :Quux [{:Fizz "y"}]}} + (unalias-data (parameter-aliases schema) {:foo {:quu "x" + :quux [{:fizz "y"}]}}))))) (testing "cond-pre schemas" - (is (= {:fooBar "a"} - (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] - (unalias-data (parameter-aliases schema) {:foo-bar "a"})))) - (is (= "b" - (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] + (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] + (is (= {:fooBar "a"} + (unalias-data (parameter-aliases schema) {:foo-bar "a"}))) + (is (= "b" (unalias-data (parameter-aliases schema) "b")))) - (is (= {:FOO {:fooBar "a"}} - (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] - (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a"}})))) - (is (= {:FOO "b"} - (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] + (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] + (is (= {:FOO {:fooBar "a"}} + (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a"}}))) + (is (= {:FOO "b"} (unalias-data (parameter-aliases schema) {:foo "b"}))))) (testing "conditional schemas" - (is (= {:fooBar "a" - :BAR "b" - :Baz "c"} - (let [schema (s/conditional - foo-map? - {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - not-foo-map? - {:QUU s/Str - :Quux [{:Fizz s/Str}]})] + (let [schema (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + not-foo-map? + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (is (= {:fooBar "a" + :BAR "b" + :Baz "c"} (unalias-data (parameter-aliases schema) {:foo-bar "a" :bar "b" - :baz "c"})))) - (is (= {:QUU "c" - :Quux [{:Fizz "d"}]} - (let [schema (s/conditional - foo-map? - {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - not-foo-map? - {:QUU s/Str - :Quux [{:Fizz s/Str}]})] - (unalias-data (parameter-aliases schema) {:quu "c" - :quux [{:fizz "d"}]})))) - (is (= {:FOO {:fooBar "a" - :BAR "b" - :Baz "c"}} - (let [schema {:FOO (s/conditional - foo-map? - {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - not-foo-map? - {:QUU s/Str - :Quux [{:Fizz s/Str}]})}] + :baz "c"}))) + (is (= {:QUU "x" + :Quux [{:Fizz "y"}]} + (unalias-data (parameter-aliases schema) {:quu "x" + :quux [{:fizz "y"}]})))) + (let [schema {:FOO (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + not-foo-map? + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (is (= {:FOO {:fooBar "a" + :BAR "b" + :Baz "c"}} (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a" :bar "b" - :baz "c"}})))) - (is (= {:FOO {:QUU "c" - :Quux [{:Fizz "d"}]}} - (let [schema {:FOO (s/conditional - foo-map? - {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - not-foo-map? - {:QUU s/Str - :Quux [{:Fizz s/Str}]})}] - (unalias-data (parameter-aliases schema) {:foo {:quu "c" - :quux [{:fizz "d"}]}}))))) + :baz "c"}}))) + (is (= {:FOO {:QUU "x" + :Quux [{:Fizz "y"}]}} + (unalias-data (parameter-aliases schema) {:foo {:quu "x" + :quux [{:fizz "y"}]}}))))) (testing "qualified keys are not aliased" (is (= {:foo/Bar "a" diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index 7c617df6..02164dbc 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -6,6 +6,9 @@ #?(:clj [clojure.test :refer [deftest testing is]] :cljs [cljs.test :refer-macros [deftest testing is]]))) +(defn not-blank? [s] + (not (str/blank? s))) + (defn foo-map? [x] (and (map? x) (let [str-keys (map (comp str/lower-case name) (keys x))] @@ -57,6 +60,7 @@ [:Baz :value] [:Baz :value :QUU] [:Baz :value :Quux] + [:Baz :value :Quux :Fizz] [:Baz :QUU] [:Baz :Quux] [:Baz :Quux :Fizz]] @@ -75,6 +79,7 @@ [:value] [:value :QUU] [:value :Quux] + [:value :Quux :Fizz] [:QUU] [:Quux] [:Quux :Fizz]] @@ -88,7 +93,6 @@ (is (= [[] [:schema] [:schema :fooBar] - [:name] [:fooBar]] (key-seqs (s/named {:fooBar s/Str} "FooBar"))) "Must contain paths for both the schema and a data described by it")) @@ -110,17 +114,13 @@ (testing "constrained schemas" (is (= [[] [:fooBar] - [:fooBar :schema] - [:fooBar :postcondition] - [:fooBar :post-name]] - (key-seqs {:fooBar (s/constrained s/Str (complement str/blank?))})) + [:fooBar :schema]] + (key-seqs {:fooBar (s/constrained s/Str not-blank?)})) "Must contain paths for both the schema and a data described by it") (is (= [[] [:fooBar] [:fooBar :schema] [:fooBar :schema :Baz] - [:fooBar :postcondition] - [:fooBar :post-name] [:fooBar :Baz]] (key-seqs {:fooBar (s/constrained {:Baz s/Str} some?)})))) From 4e1bbb5469bcbe4b1b6e50f534a828588e2309ea Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Wed, 8 Oct 2025 14:00:23 +0400 Subject: [PATCH 22/37] Rename the `unspecify-key` fn to `explicit-key` --- core/src/martian/parameter_aliases.cljc | 4 ++-- core/src/martian/schema_tools.cljc | 6 ++---- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/core/src/martian/parameter_aliases.cljc b/core/src/martian/parameter_aliases.cljc index 2974151c..bcb97f1c 100644 --- a/core/src/martian/parameter_aliases.cljc +++ b/core/src/martian/parameter_aliases.cljc @@ -1,14 +1,14 @@ (ns martian.parameter-aliases (:require [camel-snake-kebab.core :refer [->kebab-case]] [clojure.set :refer [rename-keys]] - [martian.schema-tools :refer [unspecify-key key-seqs prewalk-with-path]] + [martian.schema-tools :refer [explicit-key key-seqs prewalk-with-path]] [schema.core :as s])) (defn can-be-kebabised? [k] (not (and (keyword? k) (namespace k)))) (defn ->idiomatic [k] - (when-some [uk (when k (unspecify-key k))] + (when-some [uk (when k (explicit-key k))] (when (can-be-kebabised? uk) (->kebab-case uk)))) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 0ef4933d..93ba0344 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -4,10 +4,8 @@ [schema.spec.core :as spec]) #?(:clj (:import [schema.core MapEntry EqSchema]))) -(defn unspecify-key [k] - (if (s/specific-key? k) - (s/explicit-schema-key k) - k)) +(defn explicit-key [k] + (if (s/specific-key? k) (s/explicit-schema-key k) k)) (def default-schema? #'sti/default?) From 99b6a57d5b1f82e106c3058c95fbfe16eb0ccc68 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Wed, 8 Oct 2025 18:51:29 +0400 Subject: [PATCH 23/37] Re-impl the `key-seqs` function with a new protocol --- core/src/martian/schema_tools.cljc | 162 ++++++++++++++++++++++------- 1 file changed, 123 insertions(+), 39 deletions(-) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 93ba0344..d4c0c6ec 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -1,50 +1,134 @@ (ns martian.schema-tools - (:require [schema.core :as s #?@(:cljs [:refer [MapEntry EqSchema]])] - [schema-tools.impl :as sti] - [schema.spec.core :as spec]) - #?(:clj (:import [schema.core MapEntry EqSchema]))) + (:require [schema.core :as s] + [schema-tools.impl])) (defn explicit-key [k] (if (s/specific-key? k) (s/explicit-schema-key k) k)) -(def default-schema? #'sti/default?) - -(defn with-paths [path schema] - (when (satisfies? schema.core/Schema schema) - (->> (spec/subschemas (s/spec schema)) - (mapcat (fn [schema] - (cond (and (instance? MapEntry schema) - (instance? EqSchema (:key-schema schema))) - (let [key-schema-v (:v (:key-schema schema)) - val-schema (:val-schema schema)] - (if (default-schema? val-schema) - [{:path (conj path key-schema-v) - :schema val-schema} - {:path (conj path key-schema-v :schema) - :schema (:schema val-schema)} - {:path (conj path key-schema-v :value) - :schema (:value val-schema)}] - [{:path (conj path key-schema-v) - :schema val-schema}])) - (map? schema) - [{:path path - :schema schema}] - (vector? schema) - [{:path (conj path ::idx) ; must be qualified! - :schema (first schema)}]))) - (remove nil?)))) +(defn- concat* [& xs] + (apply concat (remove nil? xs))) + +(defprotocol KeyPaths + (-paths [schema path include-self?] + "Returns a sequence of path vectors found within the given prefix `path`. + If `include-self?` is true, includes `path` itself as the first element.")) + +(extend-protocol KeyPaths + #?(:clj clojure.lang.APersistentMap + :cljs cljs.core.PersistentArrayMap) + (-paths [schema path include-self?] + (concat* + (when include-self? (list path)) + (mapcat (fn [[k v]] + (let [k' (explicit-key k) + path' (conj path k')] + (cons path' (-paths v path' false)))) + schema))) + + ;; NB: Vector schemas are transparent (indices are ignored). + #?(:clj clojure.lang.APersistentVector + :cljs cljs.core.PersistentVector) + (-paths [schema path include-self?] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % path false) schema))) + + schema.core.NamedSchema + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) + + schema.core.Maybe + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) + + schema.core.Constrained + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) + + schema.core.One + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) + + schema.core.Record + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) + + schema.core.Both + (-paths [schema path include-self?] + (let [inner-schemas (:schemas schema)] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % (conj path :schemas) false) inner-schemas) + (mapcat #(-paths % path false) inner-schemas)))) + + schema.core.Either + (-paths [schema path include-self?] + (let [inner-schemas (:schemas schema)] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % (conj path :schemas) false) inner-schemas) + (mapcat #(-paths % path false) inner-schemas)))) + + schema.core.CondPre + (-paths [schema path include-self?] + (let [inner-schemas (:schemas schema)] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % (conj path :schemas) false) inner-schemas) + (mapcat #(-paths % path false) inner-schemas)))) + + schema.core.ConditionalSchema + (-paths [schema path include-self?] + (let [inner-schemas (map second (:preds-and-schemas schema))] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % (conj path :preds-and-schemas) false) inner-schemas) + (mapcat #(-paths % path false) inner-schemas)))) + + schema_tools.impl.Default + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema (conj path :value) true) + (-paths inner-schema path false)))) + + #?(:clj Object :cljs default) + (-paths [_ path include-self?] + (when include-self? (list path))) + + nil + (-paths [_ _ _] nil)) (defn key-seqs - "Returns a coll of paths (key seqs) which would address all possible entries - in a data described by the given `schema` as well as the `schema` itself." + "Returns a vec of unique key paths (key seqs) for `schema` and all subschemas + that will cover all possible entries in a data described by `schema` as well + as the `schema` itself." [schema] - (when (map? schema) - (loop [paths [[]] - paths-and-schemas (with-paths [] schema)] - (if-let [{:keys [path schema]} (first paths-and-schemas)] - (recur (conj paths path) (concat (rest paths-and-schemas) - (with-paths path schema))) - (distinct paths))))) + (->> (-paths schema [] true) + (distinct) + (vec))) ;; From ba4bd43cbf91a0083a6037b721c6a3caca01c912 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Wed, 8 Oct 2025 22:45:56 +0400 Subject: [PATCH 24/37] Cover non-keyword and generic (schema) keys --- core/src/martian/parameter_aliases.cljc | 11 ++- core/src/martian/schema_tools.cljc | 12 ++- core/test/martian/parameter_aliases_test.cljc | 97 ++++++++++++++----- core/test/martian/schema_tools_test.cljc | 24 ++++- 4 files changed, 113 insertions(+), 31 deletions(-) diff --git a/core/src/martian/parameter_aliases.cljc b/core/src/martian/parameter_aliases.cljc index bcb97f1c..a107bbfd 100644 --- a/core/src/martian/parameter_aliases.cljc +++ b/core/src/martian/parameter_aliases.cljc @@ -4,13 +4,14 @@ [martian.schema-tools :refer [explicit-key key-seqs prewalk-with-path]] [schema.core :as s])) -(defn can-be-kebabised? [k] - (not (and (keyword? k) (namespace k)))) +(defn can-be-renamed? [k] + ;; NB: See `camel-snake-kebab.internals.alter-name` ns. + (or (and (keyword? k) (not (namespace k))) (string? k))) (defn ->idiomatic [k] - (when-some [uk (when k (explicit-key k))] - (when (can-be-kebabised? uk) - (->kebab-case uk)))) + (when-some [k' (when k (explicit-key k))] + (when (can-be-renamed? k') + (->kebab-case k')))) (defn- idiomatic-path [path] (vec (keep ->idiomatic path))) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index d4c0c6ec..8aed3ee2 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -5,6 +5,11 @@ (defn explicit-key [k] (if (s/specific-key? k) (s/explicit-schema-key k) k)) +(defn concrete-key? [k] + (or (keyword? k) + (s/specific-key? k) + (string? k))) + (defn- concat* [& xs] (apply concat (remove nil? xs))) @@ -20,9 +25,10 @@ (concat* (when include-self? (list path)) (mapcat (fn [[k v]] - (let [k' (explicit-key k) - path' (conj path k')] - (cons path' (-paths v path' false)))) + (when (concrete-key? k) + (let [k' (explicit-key k) + path' (conj path k')] + (cons path' (-paths v path' false))))) schema))) ;; NB: Vector schemas are transparent (indices are ignored). diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index cbfb71db..58e0b6e3 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -240,11 +240,25 @@ :else {:QUU s/Str :Quux [{:Fizz s/Str}]})})) - "Must contain paths for both the schema and a data described by it")) - - (testing "qualified keys are not aliased" - (is (= {} (parameter-aliases {:foo/Bar s/Str - :Baz/DOO s/Str})))))) + "Must contain paths for both the schema and a data described by it"))) + + (testing "non-keyword keys" + (is (= {[] {"foo-bar" "fooBar"}} + (parameter-aliases {"fooBar" s/Str + 'bazQuux s/Str})) + "Symbols are excluded for performance purposes, could work as well")) + + (testing "qualified keys are not aliased" + (is (= {} (parameter-aliases {:foo/Bar s/Str + :Baz/DOO s/Str})))) + + (testing "generic keys are not aliased" + (is (= {} + (parameter-aliases {s/Str {:fooBar s/Str}}))) + (is (= {} + (parameter-aliases {s/Keyword {:fooBar s/Str}}))) + (is (= {} + (parameter-aliases (st/any-keys)))))) (deftest unalias-data-test (testing "renames idiomatic keys back to original" @@ -433,15 +447,35 @@ (is (= {:FOO {:QUU "x" :Quux [{:Fizz "y"}]}} (unalias-data (parameter-aliases schema) {:foo {:quu "x" - :quux [{:fizz "y"}]}}))))) - - (testing "qualified keys are not aliased" - (is (= {:foo/Bar "a" - :Baz/DOO "b"} - (let [schema {:foo/Bar s/Str - :Baz/DOO s/Str}] - (unalias-data (parameter-aliases schema) {:foo/Bar "a" - :Baz/DOO "b"}))))))) + :quux [{:fizz "y"}]}})))))) + + (testing "non-keyword keys" + (is (= {"fooBar" "a" + 'baz-quux "b"} + (let [schema {"fooBar" s/Str + 'bazQuux s/Str}] + (unalias-data (parameter-aliases schema) {"foo-bar" "a" + 'baz-quux "b"}))) + "Symbols are excluded for performance purposes, could work as well")) + + (testing "qualified keys are not renamed" + (is (= {:foo/Bar "a" + :Baz/DOO "b"} + (let [schema {:foo/Bar s/Str + :Baz/DOO s/Str}] + (unalias-data (parameter-aliases schema) {:foo/Bar "a" + :Baz/DOO "b"}))))) + + (testing "generic keys are not renamed" + (is (= {"a" {:foo-bar "b"}} + (let [schema {s/Str {:fooBar s/Str}}] + (unalias-data (parameter-aliases schema) {"a" {:foo-bar "b"}})))) + (is (= {:a {:foo-bar "b"}} + (let [schema {s/Keyword {:fooBar s/Str}}] + (unalias-data (parameter-aliases schema) {:a {:foo-bar "b"}})))) + (is (= {:foo-bar "a"} + (let [schema (st/any-keys)] + (unalias-data (parameter-aliases schema) {:foo-bar "a"})))))) (deftest alias-schema-test (testing "renames schema keys into idiomatic keys" @@ -605,11 +639,30 @@ not-foo-map? {:QUU s/Str :Quux [{:Fizz s/Str}]})}] - (alias-schema (parameter-aliases schema) schema))))) - - (testing "qualified keys are not aliased" - (is (= {:foo/Bar s/Str - :Baz/DOO s/Str} - (let [schema {:foo/Bar s/Str - :Baz/DOO s/Str}] - (alias-schema (parameter-aliases schema) schema))))))) + (alias-schema (parameter-aliases schema) schema)))))) + + (testing "non-keyword keys" + (is (= {"foo-bar" s/Str + 'bazQuux s/Str} + (let [schema {"fooBar" s/Str + 'bazQuux s/Str}] + (alias-schema (parameter-aliases schema) schema))) + "Symbols are excluded for performance purposes, could work as well")) + + (testing "qualified keys are not renamed" + (is (= {:foo/Bar s/Str + :Baz/DOO s/Str} + (let [schema {:foo/Bar s/Str + :Baz/DOO s/Str}] + (alias-schema (parameter-aliases schema) schema))))) + + (testing "generic keys are not renamed" + (is (= {s/Str {:fooBar s/Str}} + (let [schema {s/Str {:fooBar s/Str}}] + (alias-schema (parameter-aliases schema) schema)))) + (is (= {s/Keyword {:fooBar s/Str}} + (let [schema {s/Keyword {:fooBar s/Str}}] + (alias-schema (parameter-aliases schema) schema)))) + (is (= (st/any-keys) + (let [schema (st/any-keys)] + (alias-schema (parameter-aliases schema) schema)))))) diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index 02164dbc..c2e8cb0e 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -264,7 +264,29 @@ :else {:QUU s/Str :Quux [{:Fizz s/Str}]})})) - "Must contain paths for both the schema and a data described by it"))) + "Must contain paths for both the schema and a data described by it")) + + (testing "non-keyword keys" + (is (= [[] + ["fooBar"]] + (key-seqs {"fooBar" s/Str + 'bazQuux s/Str})) + "Symbols are excluded for performance purposes, could work as well")) + + (testing "qualified keys" + (is (= [[] + [:foo/Bar] + [:Baz/DOO]] + (key-seqs {:foo/Bar s/Str + :Baz/DOO s/Str})))) + + (testing "generic keys" + (is (= [[]] + (key-seqs {s/Str {:foo s/Str}}))) + (is (= [[]] + (key-seqs {s/Keyword {:foo s/Str}}))) + (is (= [[]] + (key-seqs (st/any-keys)))))) (deftest prewalk-with-path-test (testing "map schemas (with all sorts of keys)" From 1beecd3c135ba6ace88735c97e63f6163dacb7e5 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sat, 11 Oct 2025 17:12:59 +0400 Subject: [PATCH 25/37] =?UTF-8?q?Improve=20performance=20=E2=80=94=20`key-?= =?UTF-8?q?seqs`=20fn=20&=20`-paths`=20method?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Make the `-paths` method emit each path rather than build a lazy seq. This makes the implementation impure, but significantly speeds it up! --- core/src/martian/schema_tools.cljc | 131 ++++++++++++++++------------- 1 file changed, 72 insertions(+), 59 deletions(-) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 8aed3ee2..66e39315 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -10,119 +10,127 @@ (s/specific-key? k) (string? k))) -(defn- concat* [& xs] - (apply concat (remove nil? xs))) +;; NB: Side-effectful emission to avoid building lazy seqs. +(def ^:dynamic *emit* nil) + +(defn emit! [path] + (when *emit* (*emit* path))) (defprotocol KeyPaths (-paths [schema path include-self?] - "Returns a sequence of path vectors found within the given prefix `path`. + "Emits a sequence of path vectors found within the given prefix `path` in + the given `schema` using the dynamically bound `emit!` function of path. If `include-self?` is true, includes `path` itself as the first element.")) (extend-protocol KeyPaths #?(:clj clojure.lang.APersistentMap :cljs cljs.core.PersistentArrayMap) (-paths [schema path include-self?] - (concat* - (when include-self? (list path)) - (mapcat (fn [[k v]] - (when (concrete-key? k) - (let [k' (explicit-key k) - path' (conj path k')] - (cons path' (-paths v path' false))))) - schema))) + (when include-self? (emit! path)) + (reduce-kv + (fn [_ k v] + (when (concrete-key? k) + (let [k' (explicit-key k) + path' (conj path k')] + (emit! path') + (-paths v path' false)))) + nil + schema) + nil) ;; NB: Vector schemas are transparent (indices are ignored). #?(:clj clojure.lang.APersistentVector :cljs cljs.core.PersistentVector) (-paths [schema path include-self?] - (concat* - (when include-self? (list path)) - (mapcat #(-paths % path false) schema))) + (when include-self? (emit! path)) + (run! #(-paths % path false) schema) + nil) schema.core.NamedSchema (-paths [schema path include-self?] + (when include-self? (emit! path)) (let [inner-schema (:schema schema)] - (concat* - (when include-self? (list path)) - (-paths inner-schema (conj path :schema) true) - (-paths inner-schema path false)))) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)) + nil) schema.core.Maybe (-paths [schema path include-self?] + (when include-self? (emit! path)) (let [inner-schema (:schema schema)] - (concat* - (when include-self? (list path)) - (-paths inner-schema (conj path :schema) true) - (-paths inner-schema path false)))) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)) + nil) schema.core.Constrained (-paths [schema path include-self?] + (when include-self? (emit! path)) (let [inner-schema (:schema schema)] - (concat* - (when include-self? (list path)) - (-paths inner-schema (conj path :schema) true) - (-paths inner-schema path false)))) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)) + nil) schema.core.One (-paths [schema path include-self?] + (when include-self? (emit! path)) (let [inner-schema (:schema schema)] - (concat* - (when include-self? (list path)) - (-paths inner-schema (conj path :schema) true) - (-paths inner-schema path false)))) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)) + nil) schema.core.Record (-paths [schema path include-self?] + (when include-self? (emit! path)) (let [inner-schema (:schema schema)] - (concat* - (when include-self? (list path)) - (-paths inner-schema (conj path :schema) true) - (-paths inner-schema path false)))) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)) + nil) schema.core.Both (-paths [schema path include-self?] + (when include-self? (emit! path)) (let [inner-schemas (:schemas schema)] - (concat* - (when include-self? (list path)) - (mapcat #(-paths % (conj path :schemas) false) inner-schemas) - (mapcat #(-paths % path false) inner-schemas)))) + (run! #(-paths % (conj path :schemas) false) inner-schemas) + (run! #(-paths % path false) inner-schemas)) + nil) schema.core.Either (-paths [schema path include-self?] + (when include-self? (emit! path)) (let [inner-schemas (:schemas schema)] - (concat* - (when include-self? (list path)) - (mapcat #(-paths % (conj path :schemas) false) inner-schemas) - (mapcat #(-paths % path false) inner-schemas)))) + (run! #(-paths % (conj path :schemas) false) inner-schemas) + (run! #(-paths % path false) inner-schemas)) + nil) schema.core.CondPre (-paths [schema path include-self?] + (when include-self? (emit! path)) (let [inner-schemas (:schemas schema)] - (concat* - (when include-self? (list path)) - (mapcat #(-paths % (conj path :schemas) false) inner-schemas) - (mapcat #(-paths % path false) inner-schemas)))) + (run! #(-paths % (conj path :schemas) false) inner-schemas) + (run! #(-paths % path false) inner-schemas)) + nil) schema.core.ConditionalSchema (-paths [schema path include-self?] + (when include-self? (emit! path)) (let [inner-schemas (map second (:preds-and-schemas schema))] - (concat* - (when include-self? (list path)) - (mapcat #(-paths % (conj path :preds-and-schemas) false) inner-schemas) - (mapcat #(-paths % path false) inner-schemas)))) + (run! #(-paths % (conj path :preds-and-schemas) false) inner-schemas) + (run! #(-paths % path false) inner-schemas)) + nil) schema_tools.impl.Default (-paths [schema path include-self?] + (when include-self? (emit! path)) (let [inner-schema (:schema schema)] - (concat* - (when include-self? (list path)) - (-paths inner-schema (conj path :schema) true) - (-paths inner-schema (conj path :value) true) - (-paths inner-schema path false)))) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema (conj path :value) true) + (-paths inner-schema path false)) + nil) #?(:clj Object :cljs default) (-paths [_ path include-self?] - (when include-self? (list path))) + (when include-self? (emit! path)) + nil) nil (-paths [_ _ _] nil)) @@ -132,9 +140,14 @@ that will cover all possible entries in a data described by `schema` as well as the `schema` itself." [schema] - (->> (-paths schema [] true) - (distinct) - (vec))) + (let [paths (transient []) + *seen (volatile! #{})] + (binding [*emit* (fn [path] + (when-not (contains? @*seen path) + (vswap! *seen conj path) + (conj! paths path)))] + (-paths schema [] true)) + (persistent! paths))) ;; From f843ae5d6212f9cdfd3a0f9636ccdf697691801c Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Sat, 11 Oct 2025 17:36:55 +0400 Subject: [PATCH 26/37] =?UTF-8?q?Improve=20performance=20=E2=80=94=20`para?= =?UTF-8?q?meter-aliases`=20fn?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Using faster `peek`/`pop` on path vectors and faster `assoc` instead of `merge`. --- core/src/martian/parameter_aliases.cljc | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/core/src/martian/parameter_aliases.cljc b/core/src/martian/parameter_aliases.cljc index a107bbfd..9cedd1f3 100644 --- a/core/src/martian/parameter_aliases.cljc +++ b/core/src/martian/parameter_aliases.cljc @@ -23,11 +23,11 @@ The result is then used with `alias-schema` and `unalias-data` functions." [schema] (reduce (fn [acc path] - (if-let [idiomatic-key (some-> path last ->idiomatic)] - (if-not (= (last path) idiomatic-key) - (update acc (idiomatic-path (drop-last path)) merge {idiomatic-key (last path)}) - acc) - acc)) + (let [leaf (peek path) + idiomatic-key (some-> leaf ->idiomatic)] + (if (and idiomatic-key (not= leaf idiomatic-key)) + (update acc (idiomatic-path (pop path)) assoc idiomatic-key leaf) + acc))) {} (key-seqs schema))) From 4842d266ea3ffead43122120b683fa3e85a7ab5d Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Mon, 13 Oct 2025 20:19:56 +0400 Subject: [PATCH 27/37] Re-impl `parameter-aliases` with lazy registry that caches and interns aliases maps for all the paths --- core/src/martian/parameter_aliases.cljc | 125 +++-- core/src/martian/schema_tools.cljc | 264 ++++++----- core/test/martian/parameter_aliases_test.cljc | 431 ++++++++++-------- core/test/martian/schema_tools_test.cljc | 398 ++++------------ 4 files changed, 563 insertions(+), 655 deletions(-) diff --git a/core/src/martian/parameter_aliases.cljc b/core/src/martian/parameter_aliases.cljc index 9cedd1f3..1d6ca5fe 100644 --- a/core/src/martian/parameter_aliases.cljc +++ b/core/src/martian/parameter_aliases.cljc @@ -1,63 +1,104 @@ (ns martian.parameter-aliases - (:require [camel-snake-kebab.core :refer [->kebab-case]] - [clojure.set :refer [rename-keys]] - [martian.schema-tools :refer [explicit-key key-seqs prewalk-with-path]] + (:require [clojure.set :refer [rename-keys]] + [martian.schema-tools :as schema-tools] [schema.core :as s])) -(defn can-be-renamed? [k] - ;; NB: See `camel-snake-kebab.internals.alter-name` ns. - (or (and (keyword? k) (not (namespace k))) (string? k))) +(defn- aliases-at + "Internal helper. Given a `schema`, a path-local `cache` (atom), an `interner` + (atom), and a `path` (vector or seq), returns the alias map for that path. -(defn ->idiomatic [k] - (when-some [k' (when k (explicit-key k))] - (when (can-be-renamed? k') - (->kebab-case k')))) + - Delegates the actual computation to `compute-aliases-at`, which understands + schema wrappers (e.g. `:schema`, `:schemas`, etc.) and vector transparency. + - Caches results per-path in the provided `cache` to avoid recomputation. + - Interns identical alias maps across the paths via `interner`, so equal maps + share a single canonical instance (reduces memory churn in large APIs). + - Returns `nil` when there are no aliases at the given path." + [schema cache interner path] + (let [path' (if (vector? path) path (vec path))] + (or (get @cache path') + (let [m (schema-tools/compute-aliases-at schema path') + m' (when m + (or (get @interner m) + (-> interner + (swap! #(if (contains? % m) % (assoc % m m))) + (get m))))] + (swap! cache assoc path' m') + m')))) -(defn- idiomatic-path [path] - (vec (keep ->idiomatic path))) +#?(:clj + (do + (deftype LazyRegistry [schema cache interner] + clojure.lang.ILookup + (valAt [_ k] + (aliases-at schema cache interner k)) + (valAt [_ k not-found] + (or (aliases-at schema cache interner k) not-found))) + + (defmethod print-method martian.parameter_aliases.LazyRegistry + [^martian.parameter_aliases.LazyRegistry r ^java.io.Writer w] + (.write w (str "#LazyRegistry (cached " (count @(.cache r)) ")"))))) + +#?(:cljs + (deftype LazyRegistry [schema cache interner] + cljs.core/ILookup + (-lookup [_ k] + (aliases-at schema cache interner k)) + (-lookup [_ k not-found] + (or (aliases-at schema cache interner k) not-found)) + + cljs.core/IPrintWithWriter + (-pr-writer [_ writer _opts] + (-write writer (str "#LazyRegistry (cached " (count @cache) ")"))))) (defn parameter-aliases - "Produces a data structure with idiomatic keys (aliases) mappings per path - in a (possibly, deeply nested) `schema` for all its unqualified keys. + "Build a lazy alias registry for the given `schema`. - The result is then used with `alias-schema` and `unalias-data` functions." + Aliases are computed on demand via `martian.schema-tools/compute-aliases-at`, + so materializing massive alias maps upfront is avoided. Per-path results are + memoized within the registry. Identical alias maps are shared to cut memory + usage. + + The returned value implements `ILookup` and is indexed by an idiomatic path + (a vector of segments as used when walking data/schemas). Looking up a path + yields the alias map for that level, mapping \"idiomatic keys\" (kebab-case, + unqualified) to their original explicit schema keys (with optional/required + wrappers when applicable)." [schema] - (reduce (fn [acc path] - (let [leaf (peek path) - idiomatic-key (some-> leaf ->idiomatic)] - (if (and idiomatic-key (not= leaf idiomatic-key)) - (update acc (idiomatic-path (pop path)) assoc idiomatic-key leaf) - acc))) - {} - (key-seqs schema))) + (when schema + (new LazyRegistry schema (atom {}) (atom {})))) + +(defn- idiomatic-path [path] + (vec (keep schema-tools/->idiomatic path))) (defn unalias-data "Given a (possibly, deeply nested) data `x`, returns the data with all keys - renamed as described by the `parameter-aliases`." + renamed from \"idiomatic\" using the given `parameter-aliases` registry." [parameter-aliases x] (if parameter-aliases - (prewalk-with-path (fn [path x] - (if (map? x) - (rename-keys x (get parameter-aliases (idiomatic-path path))) - x)) - [] - x) + (schema-tools/prewalk-with-path + (fn [path x] + (if (map? x) + (rename-keys x (get parameter-aliases (idiomatic-path path))) + x)) + [] + x) x)) (defn alias-schema "Given a (possibly, deeply nested) `schema`, renames all keys (in it and its - subschemas) into corresponding idiomatic keys (aliases) as described by the - `parameter-aliases`." + subschemas) into corresponding \"idiomatic\" keys (aliases) using the given + `parameter-aliases` registry." [parameter-aliases schema] (if parameter-aliases - (prewalk-with-path (fn [path x] - (if (map? x) - (let [kmap (reduce-kv (fn [kmap k v] - (assoc kmap v k (s/optional-key v) (s/optional-key k))) - {} - (get parameter-aliases (idiomatic-path path)))] - (rename-keys x kmap)) - x)) - [] - schema) + (schema-tools/prewalk-with-path + (fn [path x] + (if (map? x) + (let [kmap (reduce-kv (fn [kmap k v] + (assoc kmap v k (s/optional-key v) (s/optional-key k))) + {} + (get parameter-aliases (idiomatic-path path)))] + (rename-keys x kmap)) + x)) + [] + schema) schema)) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 66e39315..0fe270c5 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -1,155 +1,203 @@ (ns martian.schema-tools - (:require [schema.core :as s] - [schema-tools.impl])) + (:require [camel-snake-kebab.core :refer [->kebab-case]] + [schema.core :as s] + [schema-tools.impl]) + #?(:clj (:import (clojure.lang IDeref)))) (defn explicit-key [k] (if (s/specific-key? k) (s/explicit-schema-key k) k)) -(defn concrete-key? [k] - (or (keyword? k) - (s/specific-key? k) - (string? k))) - -;; NB: Side-effectful emission to avoid building lazy seqs. -(def ^:dynamic *emit* nil) - -(defn emit! [path] - (when *emit* (*emit* path))) - -(defprotocol KeyPaths - (-paths [schema path include-self?] - "Emits a sequence of path vectors found within the given prefix `path` in - the given `schema` using the dynamically bound `emit!` function of path. - If `include-self?` is true, includes `path` itself as the first element.")) +(defn- can-be-renamed? [k] + ;; NB: See `camel-snake-kebab.internals.alter-name` ns. + (or (and (keyword? k) (not (namespace k))) (string? k))) + +(defn ->idiomatic [k] + (when-some [k' (explicit-key k)] + (when (can-be-renamed? k') + (->kebab-case k')))) + +(defn map-entry-aliases + "Returns a map of idiomatic keys to original explicit keys for the immediate + entries of the given map schema `ms`. + + - Considers only keys that can be renamed: unqualified keywords or strings; + - Uses the `explicit-key` helper function to unwrap required/optional keys; + - Includes an entry only when the idiomatic form differs from the original; + - Returns `nil` when there are no aliasable entries at this level." + [ms] + (not-empty + (reduce-kv + (fn [acc k _] + (let [ek (explicit-key k) + ik (->idiomatic ek)] + (if (and ik (not= ik ek)) + (assoc acc ik ek) + acc))) + {} + ms))) + +(defn child-by-idiomatic + "Finds the child schema addressed by the next path segment `seg` in the map + schema `ms`. + + The `seg` is one idiomatic path segment (a kebab-case, unqualified keyword + or string). The function scans entries of `ms` and returns the value whose + key, after being idiomatized, equals `seg`." + [ms seg] + (some (fn [[k v]] (when (= seg (->idiomatic k)) v)) ms)) + +(defprotocol PathAliases + "Internal traversal API used to locate alias maps inside schemas. + + Implementations should walk `schema` along an `idiomatic-path` (a vector of + kebab-case, unqualified segments) and, when the path lands on a map schema, + return a map `{idiomatic -> original-explicit}` for that level; otherwise, + return `nil`, i.e. don't traverse past the target level or build whole-tree + results." + (-aliases-at [schema idiomatic-path] + "Returns the alias map available at `idiomatic-path` inside the `schema`, + or `nil` if that location is not a map level or has no aliasable keys.")) + +(defn combine-aliases-at + "Collects and merges alias maps from multiple `inner-schemas` at the single + idiomatic `path`. + + Calls `(-aliases-at s path)` for each inner schema, discards `nil` results, + and merges the remaining maps left-to-right with `merge` semantics. Returns + `nil` when nothing contributes, i.e. the merged result would be empty." + [path inner-schemas] + (not-empty (apply merge (keep #(-aliases-at % path) inner-schemas)))) + +(extend-protocol PathAliases -(extend-protocol KeyPaths #?(:clj clojure.lang.APersistentMap :cljs cljs.core.PersistentArrayMap) - (-paths [schema path include-self?] - (when include-self? (emit! path)) - (reduce-kv - (fn [_ k v] - (when (concrete-key? k) - (let [k' (explicit-key k) - path' (conj path k')] - (emit! path') - (-paths v path' false)))) - nil - schema) - nil) - - ;; NB: Vector schemas are transparent (indices are ignored). + (-aliases-at [ms path] + (if (empty? path) + (map-entry-aliases ms) + (let [seg (first path)] + (when (or (keyword? seg) (string? seg)) + (when-some [child (child-by-idiomatic ms seg)] + (-aliases-at child (rest path))))))) + + ;; Vector schemas are transparent: we merge aliases from element schemas, + ;; including when `path` is empty, so deeply nested vectors work as well. #?(:clj clojure.lang.APersistentVector :cljs cljs.core.PersistentVector) - (-paths [schema path include-self?] - (when include-self? (emit! path)) - (run! #(-paths % path false) schema) - nil) + (-aliases-at [vs path] + (combine-aliases-at path vs)) + + ;; Single-child wrappers: aware of the inner `:schema` hop. schema.core.NamedSchema - (-paths [schema path include-self?] - (when include-self? (emit! path)) + (-aliases-at [schema path] (let [inner-schema (:schema schema)] - (-paths inner-schema (conj path :schema) true) - (-paths inner-schema path false)) - nil) + (cond + (empty? path) (-aliases-at inner-schema []) + (= :schema (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) schema.core.Maybe - (-paths [schema path include-self?] - (when include-self? (emit! path)) + (-aliases-at [schema path] (let [inner-schema (:schema schema)] - (-paths inner-schema (conj path :schema) true) - (-paths inner-schema path false)) - nil) + (cond + (empty? path) (-aliases-at inner-schema []) + (= :schema (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) schema.core.Constrained - (-paths [schema path include-self?] - (when include-self? (emit! path)) + (-aliases-at [schema path] (let [inner-schema (:schema schema)] - (-paths inner-schema (conj path :schema) true) - (-paths inner-schema path false)) - nil) + (cond + (empty? path) (-aliases-at inner-schema []) + (= :schema (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) schema.core.One - (-paths [schema path include-self?] - (when include-self? (emit! path)) + (-aliases-at [schema path] (let [inner-schema (:schema schema)] - (-paths inner-schema (conj path :schema) true) - (-paths inner-schema path false)) - nil) + (cond + (empty? path) (-aliases-at inner-schema []) + (= :schema (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) schema.core.Record - (-paths [schema path include-self?] - (when include-self? (emit! path)) + (-aliases-at [schema path] (let [inner-schema (:schema schema)] - (-paths inner-schema (conj path :schema) true) - (-paths inner-schema path false)) - nil) + (cond + (empty? path) (-aliases-at inner-schema []) + (= :schema (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) + + ;; Multi-variant unions: combine the alternatives; aware of any inner hops. schema.core.Both - (-paths [schema path include-self?] - (when include-self? (emit! path)) + (-aliases-at [schema path] (let [inner-schemas (:schemas schema)] - (run! #(-paths % (conj path :schemas) false) inner-schemas) - (run! #(-paths % path false) inner-schemas)) - nil) + (cond + (empty? path) (combine-aliases-at [] inner-schemas) + (= :schemas (first path)) (combine-aliases-at (rest path) inner-schemas) + :else (combine-aliases-at path inner-schemas)))) schema.core.Either - (-paths [schema path include-self?] - (when include-self? (emit! path)) + (-aliases-at [schema path] (let [inner-schemas (:schemas schema)] - (run! #(-paths % (conj path :schemas) false) inner-schemas) - (run! #(-paths % path false) inner-schemas)) - nil) + (cond + (empty? path) (combine-aliases-at [] inner-schemas) + (= :schemas (first path)) (combine-aliases-at (rest path) inner-schemas) + :else (combine-aliases-at path inner-schemas)))) schema.core.CondPre - (-paths [schema path include-self?] - (when include-self? (emit! path)) + (-aliases-at [schema path] (let [inner-schemas (:schemas schema)] - (run! #(-paths % (conj path :schemas) false) inner-schemas) - (run! #(-paths % path false) inner-schemas)) - nil) + (cond + (empty? path) (combine-aliases-at [] inner-schemas) + (= :schemas (first path)) (combine-aliases-at (rest path) inner-schemas) + :else (combine-aliases-at path inner-schemas)))) schema.core.ConditionalSchema - (-paths [schema path include-self?] - (when include-self? (emit! path)) + (-aliases-at [schema path] (let [inner-schemas (map second (:preds-and-schemas schema))] - (run! #(-paths % (conj path :preds-and-schemas) false) inner-schemas) - (run! #(-paths % path false) inner-schemas)) - nil) + (cond + (empty? path) (combine-aliases-at [] inner-schemas) + (= :preds-and-schemas (first path)) (combine-aliases-at (rest path) inner-schemas) + :else (combine-aliases-at path inner-schemas)))) + ;; The `schema-tools`'s defaults: aware of the `:schema` and `:value` hops. schema_tools.impl.Default - (-paths [schema path include-self?] - (when include-self? (emit! path)) + (-aliases-at [schema path] (let [inner-schema (:schema schema)] - (-paths inner-schema (conj path :schema) true) - (-paths inner-schema (conj path :value) true) - (-paths inner-schema path false)) - nil) + (cond + (empty? path) (-aliases-at inner-schema []) + (= :schema (first path)) (-aliases-at inner-schema (rest path)) + (= :value (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) #?(:clj Object :cljs default) - (-paths [_ path include-self?] - (when include-self? (emit! path)) - nil) + (-aliases-at [_ _] nil) nil - (-paths [_ _ _] nil)) - -(defn key-seqs - "Returns a vec of unique key paths (key seqs) for `schema` and all subschemas - that will cover all possible entries in a data described by `schema` as well - as the `schema` itself." - [schema] - (let [paths (transient []) - *seen (volatile! #{})] - (binding [*emit* (fn [path] - (when-not (contains? @*seen path) - (vswap! *seen conj path) - (conj! paths path)))] - (-paths schema [] true)) - (persistent! paths))) - -;; + (-aliases-at [_ _] nil)) + +(defn compute-aliases-at + "Given a `schema` and an `idiomatic-path` (a vector of kebab-case, unqualified + segments), returns a map which describes how the idiomatic keys at that exact + map level are translated back to the schema's original keys. + + - Segments and keys are considered idiomatic when they are unqualified and + kebab-case keywords/strings, e.g. `:foo-bar`. Qualified keywords/symbols + are ignored; generic map keys (e.g. `s/Any`, `s/Keyword`) do not produce + aliases. + - Only the addressed level. The result contains aliases for the entries of + that map, not for ancestors or nested child maps. + - Vectors are transparent. If the path walks through a vector, aliases are + merged from its element schemas. + - Inner schemas hops are understood. Structural hops introduced by wrapper + or union schemas are recognized (e.g. `:schema`, `:schemas`, etc.). + - Non-map endpoints yield `nil`. If the `idiomatic-path` doesn't land on a + map (or there are no aliasable keys), the function returns `nil`." + [schema idiomatic-path] + (-aliases-at schema idiomatic-path)) (defn walk-with-path "Similar to the `schema-tools.walk/walk` except it keeps track of the `path` diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index 58e0b6e3..10c1a201 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -6,6 +6,19 @@ #?(:clj [clojure.test :refer [deftest testing is]] :cljs [cljs.test :refer-macros [deftest testing is]]))) +(defn select-aliases-from-registry + "Given a lazy registry and an expected map whose keys are paths, + pull exactly those paths and return a plain {path -> alias-map}." + [lazy-reg expected] + (into {} + (map (fn [path] [path (get lazy-reg path)])) + (keys expected))) + +(defmacro =aliases + [expected schema] + `(let [lazy-reg# (parameter-aliases ~schema)] + (= ~expected (select-aliases-from-registry lazy-reg# ~expected)))) + (defn not-blank? [s] (not (str/blank? s))) @@ -19,246 +32,270 @@ (deftest parameter-aliases-test (testing "produces idiomatic aliases for all keys in a schema" (testing "map schemas (with all sorts of keys)" - (is (= {[] {:foo-bar :fooBar - :bar :BAR - :baz :Baz}} - (parameter-aliases {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str})))) + (is (=aliases + {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz}} + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str}))) (testing "nested map and vector schemas" - (is (= {[] {:foo-bar :fooBar - :bar :BAR - :baz :Baz} - [:baz] {:quu :QUU - :quux :Quux} - [:baz :quux] {:fizz :Fizz}} - (parameter-aliases {:fooBar s/Str - (s/optional-key :BAR) s/Str - :Baz {:QUU s/Str - :Quux [{:Fizz s/Str}]}})))) + (is (=aliases + {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz} + [:baz] {:quu :QUU + :quux :Quux} + [:baz :quux] {:fizz :Fizz}} + {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz {:QUU s/Str + :Quux [{:Fizz s/Str}]}}))) (testing "deeply nested vector schemas" - (is (= {[] {:foo :FOO} - [:foo] {:bar :Bar} - [:foo :bar] {:bar-doo :barDoo - :bar-dee :barDee}} - (parameter-aliases {(s/optional-key :FOO) - {:Bar [[{:barDoo s/Str - (s/optional-key :barDee) s/Str}]]}})))) + (is (=aliases + {[] {:foo :FOO} + [:foo] {:bar :Bar} + [:foo :bar] {:bar-doo :barDoo + :bar-dee :barDee}} + {(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str + (s/optional-key :barDee) s/Str}]]}}))) (testing "default schemas" - (is (= {[] {:foo-bar :fooBar - :bar :BAR - :baz :Baz} - [:baz] {:quu :QUU - :quux :Quux} - [:baz :quux] {:fizz :Fizz} - [:baz :schema] {:quu :QUU - :quux :Quux} - [:baz :schema :quux] {:fizz :Fizz} - [:baz :value] {:quu :QUU + (is (=aliases + {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz} + [:baz] {:quu :QUU + :quux :Quux} + [:baz :quux] {:fizz :Fizz} + [:baz :schema] {:quu :QUU :quux :Quux} - [:baz :value :quux] {:fizz :Fizz}} - (parameter-aliases {:fooBar s/Str - (s/optional-key :BAR) s/Str - :Baz (st/default {:QUU s/Str - :Quux [{:Fizz s/Str}]} - {:QUU "hi" - :Quux []})})) + [:baz :schema :quux] {:fizz :Fizz} + [:baz :value] {:quu :QUU + :quux :Quux} + [:baz :value :quux] {:fizz :Fizz}} + {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})}) "Must contain aliases for both the schema and a data described by it") - (is (= {[] {:quu :QUU - :quux :Quux} - [:quux] {:fizz :Fizz} - [:schema] {:quu :QUU - :quux :Quux} - [:schema :quux] {:fizz :Fizz} - [:value] {:quu :QUU + (is (=aliases + {[] {:quu :QUU + :quux :Quux} + [:quux] {:fizz :Fizz} + [:schema] {:quu :QUU :quux :Quux} - [:value :quux] {:fizz :Fizz}} - (parameter-aliases (st/default {:QUU s/Str - :Quux [{:Fizz s/Str}]} - {:QUU "hi" - :Quux []}))) + [:schema :quux] {:fizz :Fizz} + [:value] {:quu :QUU + :quux :Quux} + [:value :quux] {:fizz :Fizz}} + (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})) "Must contain aliases for both the schema and a data described by it")) (testing "named schemas" - (is (= {[] {:foo-bar :fooBar} - [:schema] {:foo-bar :fooBar}} - (parameter-aliases (s/named {:fooBar s/Str} "FooBar"))) + (is (=aliases + {[] {:foo-bar :fooBar} + [:schema] {:foo-bar :fooBar}} + (s/named {:fooBar s/Str} "FooBar")) "Must contain aliases for both the schema and a data described by it")) (testing "maybe schemas" - (is (= {[] {:foo-bar :fooBar} - [:foo-bar] {:baz :Baz} - [:foo-bar :schema] {:baz :Baz}} - (parameter-aliases {:fooBar (s/maybe {:Baz s/Str})})) + (is (=aliases + {[] {:foo-bar :fooBar} + [:foo-bar] {:baz :Baz} + [:foo-bar :schema] {:baz :Baz}} + {:fooBar (s/maybe {:Baz s/Str})}) "Must contain aliases for both the schema and a data described by it") - (is (= {[] {:foo-bar :fooBar} - [:schema] {:foo-bar :fooBar}} - (parameter-aliases (s/maybe {:fooBar s/Str}))) + (is (=aliases + {[] {:foo-bar :fooBar} + [:schema] {:foo-bar :fooBar}} + (s/maybe {:fooBar s/Str})) "Must contain aliases for both the schema and a data described by it")) (testing "constrained schemas" - (is (= {[] {:foo-bar :fooBar}} - (parameter-aliases {:fooBar (s/constrained s/Str not-blank?)}))) - (is (= {[] {:foo-bar :fooBar} - [:foo-bar :schema] {:baz :Baz} - [:foo-bar] {:baz :Baz}} - (parameter-aliases {:fooBar (s/constrained {:Baz s/Str} some?)})) + (is (=aliases + {[] {:foo-bar :fooBar}} + {:fooBar (s/constrained s/Str not-blank?)})) + (is (=aliases + {[] {:foo-bar :fooBar} + [:foo-bar :schema] {:baz :Baz} + [:foo-bar] {:baz :Baz}} + {:fooBar (s/constrained {:Baz s/Str} some?)}) "Must contain aliases for both the schema and a data described by it")) (testing "both schemas" - (is (= {[] {:foo-bar :fooBar - :bar :BAR - :baz :Baz - :quu :QUU - :quux :Quux} - [:quux] {:fizz :Fizz} - [:schemas] {:foo-bar :fooBar - :bar :BAR - :baz :Baz - :quu :QUU - :quux :Quux} - [:schemas :quux] {:fizz :Fizz}} - (parameter-aliases (s/both {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - {:QUU s/Str - :Quux [{:Fizz s/Str}]}))) + (is (=aliases + {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:quux] {:fizz :Fizz} + [:schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:schemas :quux] {:fizz :Fizz}} + (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})) "Must contain aliases for both the schema and a data described by it") - (is (= {[] {:foo :FOO} - [:foo] {:foo-bar :fooBar - :bar :BAR - :baz :Baz - :quu :QUU - :quux :Quux} - [:foo :quux] {:fizz :Fizz} - [:foo :schemas] {:foo-bar :fooBar - :bar :BAR - :baz :Baz - :quu :QUU - :quux :Quux} - [:foo :schemas :quux] {:fizz :Fizz}} - (parameter-aliases {:FOO (s/both {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - {:QUU s/Str - :Quux [{:Fizz s/Str}]})})) + (is (=aliases + {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:foo :quux] {:fizz :Fizz} + [:foo :schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:foo :schemas :quux] {:fizz :Fizz}} + {:FOO (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}) "Must contain aliases for both the schema and a data described by it")) (testing "either schemas" - (is (= {[] {:foo-bar :fooBar - :bar :BAR - :baz :Baz - :quu :QUU - :quux :Quux} - [:quux] {:fizz :Fizz} - [:schemas] {:foo-bar :fooBar - :bar :BAR - :baz :Baz - :quu :QUU - :quux :Quux} - [:schemas :quux] {:fizz :Fizz}} - (parameter-aliases (s/either {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - {:QUU s/Str - :Quux [{:Fizz s/Str}]}))) + (is (=aliases + {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:quux] {:fizz :Fizz} + [:schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:schemas :quux] {:fizz :Fizz}} + (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})) "Must contain aliases for both the schema and a data described by it") - (is (= {[] {:foo :FOO} - [:foo] {:foo-bar :fooBar - :bar :BAR - :baz :Baz - :quu :QUU - :quux :Quux} - [:foo :quux] {:fizz :Fizz} - [:foo :schemas] {:foo-bar :fooBar - :bar :BAR - :baz :Baz - :quu :QUU - :quux :Quux} - [:foo :schemas :quux] {:fizz :Fizz}} - (parameter-aliases {:FOO (s/either {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - {:QUU s/Str - :Quux [{:Fizz s/Str}]})})) + (is (=aliases + {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:foo :quux] {:fizz :Fizz} + [:foo :schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:foo :schemas :quux] {:fizz :Fizz}} + {:FOO (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}) "Must contain aliases for both the schema and a data described by it")) (testing "cond-pre schemas" - (is (= {[] {:foo-bar :fooBar} - [:schemas] {:foo-bar :fooBar}} - (parameter-aliases (s/cond-pre {:fooBar s/Str} s/Str))) + (is (=aliases + {[] {:foo-bar :fooBar} + [:schemas] {:foo-bar :fooBar}} + (s/cond-pre {:fooBar s/Str} s/Str)) "Must contain paths for both the schema and a data described by it") - (is (= {[] {:foo :FOO} - [:foo] {:foo-bar :fooBar} - [:foo :schemas] {:foo-bar :fooBar}} - (parameter-aliases {:FOO (s/cond-pre {:fooBar s/Str} s/Str)})) + (is (=aliases + {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar} + [:foo :schemas] {:foo-bar :fooBar}} + {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}) "Must contain paths for both the schema and a data described by it")) (testing "conditional schemas" - (is (= {[] {:foo-bar :fooBar - :bar :BAR - :baz :Baz - :quu :QUU - :quux :Quux} - [:quux] {:fizz :Fizz} - [:preds-and-schemas] {:foo-bar :fooBar - :bar :BAR - :baz :Baz - :quu :QUU - :quux :Quux} - [:preds-and-schemas :quux] {:fizz :Fizz}} - (parameter-aliases (s/conditional - foo-map? - {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - :else - {:QUU s/Str - :Quux [{:Fizz s/Str}]}))) + (is (=aliases + {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:quux] {:fizz :Fizz} + [:preds-and-schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:preds-and-schemas :quux] {:fizz :Fizz}} + (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + :else + {:QUU s/Str + :Quux [{:Fizz s/Str}]})) "Must contain paths for both the schema and a data described by it") - (is (= {[] {:foo :FOO} - [:foo] {:foo-bar :fooBar - :bar :BAR - :baz :Baz - :quu :QUU - :quux :Quux} - [:foo :quux] {:fizz :Fizz} - [:foo :preds-and-schemas] {:foo-bar :fooBar - :bar :BAR - :baz :Baz - :quu :QUU - :quux :Quux} - [:foo :preds-and-schemas :quux] {:fizz :Fizz}} - (parameter-aliases {:FOO (s/conditional - foo-map? - {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - :else - {:QUU s/Str - :Quux [{:Fizz s/Str}]})})) + (is (=aliases + {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:foo :quux] {:fizz :Fizz} + [:foo :preds-and-schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:foo :preds-and-schemas :quux] {:fizz :Fizz}} + {:FOO (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + :else + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}) "Must contain paths for both the schema and a data described by it"))) (testing "non-keyword keys" - (is (= {[] {"foo-bar" "fooBar"}} - (parameter-aliases {"fooBar" s/Str - 'bazQuux s/Str})) + (is (=aliases + {[] {"foo-bar" "fooBar"}} + {"fooBar" s/Str + 'bazQuux s/Str}) "Symbols are excluded for performance purposes, could work as well")) (testing "qualified keys are not aliased" - (is (= {} (parameter-aliases {:foo/Bar s/Str - :Baz/DOO s/Str})))) + (is (=aliases + {} + {:foo/Bar s/Str + :Baz/DOO s/Str}))) (testing "generic keys are not aliased" - (is (= {} - (parameter-aliases {s/Str {:fooBar s/Str}}))) - (is (= {} - (parameter-aliases {s/Keyword {:fooBar s/Str}}))) - (is (= {} - (parameter-aliases (st/any-keys)))))) + (is (=aliases + {} + {s/Str {:fooBar s/Str}})) + (is (=aliases + {} + {s/Keyword {:fooBar s/Str}})) + (is (=aliases + {} + (st/any-keys))))) (deftest unalias-data-test (testing "renames idiomatic keys back to original" diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc index c2e8cb0e..8f393211 100644 --- a/core/test/martian/schema_tools_test.cljc +++ b/core/test/martian/schema_tools_test.cljc @@ -1,303 +1,82 @@ (ns martian.schema-tools-test - (:require [clojure.string :as str] - [martian.schema-tools :refer [key-seqs prewalk-with-path]] + (:require [martian.schema-tools :as schema-tools] [schema.core :as s] [schema-tools.core :as st] #?(:clj [clojure.test :refer [deftest testing is]] :cljs [cljs.test :refer-macros [deftest testing is]]))) -(defn not-blank? [s] - (not (str/blank? s))) - -(defn foo-map? [x] - (and (map? x) - (let [str-keys (map (comp str/lower-case name) (keys x))] - (boolean (some #(str/starts-with? % "foo") str-keys))))) - -(deftest key-seqs-test - (testing "map schemas (with all sorts of keys)" - (is (= [[] - [:fooBar] - [:BAR] - [:Baz]] - (key-seqs {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str})))) - - (testing "nested map and vector schemas" - (is (= [[] - [:fooBar] - [:BAR] - [:Baz] - [:Baz :QUU] - [:Baz :Quux] - [:Baz :Quux :Fizz]] - (key-seqs {:fooBar s/Str - (s/optional-key :BAR) s/Str - :Baz {:QUU s/Str - :Quux [{:Fizz s/Str}]}})))) - - (testing "deeply nested vector schemas" - (is (= [[] - [:FOO] - [:FOO :Bar] - [:FOO :Bar :barDoo] - [:FOO :Bar :barDee]] - (key-seqs {(s/optional-key :FOO) - {:Bar [[{:barDoo s/Str - (s/optional-key :barDee) s/Str}]]}})) - "Must contain paths with qualified indexes inside the nested vector")) - - (testing "default schemas" - (is (= [[] - [:fooBar] - [:BAR] - [:Baz] - [:Baz :schema] - [:Baz :schema :QUU] - [:Baz :schema :Quux] - [:Baz :schema :Quux :Fizz] - [:Baz :value] - [:Baz :value :QUU] - [:Baz :value :Quux] - [:Baz :value :Quux :Fizz] - [:Baz :QUU] - [:Baz :Quux] - [:Baz :Quux :Fizz]] - (key-seqs {:fooBar s/Str - (s/optional-key :BAR) s/Str - :Baz (st/default {:QUU s/Str - :Quux [{:Fizz s/Str}]} - {:QUU "hi" - :Quux []})})) - "Must contain paths for both the schema and a data described by it") - (is (= [[] - [:schema] - [:schema :QUU] - [:schema :Quux] - [:schema :Quux :Fizz] - [:value] - [:value :QUU] - [:value :Quux] - [:value :Quux :Fizz] - [:QUU] - [:Quux] - [:Quux :Fizz]] - (key-seqs (st/default {:QUU s/Str - :Quux [{:Fizz s/Str}]} - {:QUU "hi" - :Quux []}))) - "Must contain paths for both the schema and a data described by it")) - - (testing "named schemas" - (is (= [[] - [:schema] - [:schema :fooBar] - [:fooBar]] - (key-seqs (s/named {:fooBar s/Str} "FooBar"))) - "Must contain paths for both the schema and a data described by it")) - - (testing "maybe schemas" - (is (= [[] - [:schema] - [:schema :fooBar] - [:fooBar]] - (key-seqs (s/maybe {:fooBar s/Str}))) - "Must contain paths for both the schema and a data described by it") - (is (= [[] - [:fooBar] - [:fooBar :Baz] - [:fooBar :Baz :schema]] - (key-seqs {:fooBar {:Baz (s/maybe s/Str)}})) - "Must contain paths for both the schema and a data described by it")) - - (testing "constrained schemas" - (is (= [[] - [:fooBar] - [:fooBar :schema]] - (key-seqs {:fooBar (s/constrained s/Str not-blank?)})) - "Must contain paths for both the schema and a data described by it") - (is (= [[] - [:fooBar] - [:fooBar :schema] - [:fooBar :schema :Baz] - [:fooBar :Baz]] - (key-seqs {:fooBar (s/constrained {:Baz s/Str} some?)})))) - - (testing "both schemas" - (is (= [[] - [:schemas :fooBar] - [:schemas :BAR] - [:schemas :Baz] - [:schemas :QUU] - [:schemas :Quux] - [:schemas :Quux :Fizz] - [:fooBar] - [:BAR] - [:Baz] - [:QUU] - [:Quux] - [:Quux :Fizz]] - (key-seqs (s/both {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - {:QUU s/Str - :Quux [{:Fizz s/Str}]}))) - "Must contain paths for both the schema and a data described by it") - (is (= [[] - [:FOO] - [:FOO :schemas :fooBar] - [:FOO :schemas :BAR] - [:FOO :schemas :Baz] - [:FOO :schemas :QUU] - [:FOO :schemas :Quux] - [:FOO :schemas :Quux :Fizz] - [:FOO :fooBar] - [:FOO :BAR] - [:FOO :Baz] - [:FOO :QUU] - [:FOO :Quux] - [:FOO :Quux :Fizz]] - (key-seqs {:FOO (s/both {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - {:QUU s/Str - :Quux [{:Fizz s/Str}]})})) - "Must contain paths for both the schema and a data described by it")) - - (testing "either schemas" - (is (= [[] - [:schemas :fooBar] - [:schemas :BAR] - [:schemas :Baz] - [:schemas :QUU] - [:schemas :Quux] - [:schemas :Quux :Fizz] - [:fooBar] - [:BAR] - [:Baz] - [:QUU] - [:Quux] - [:Quux :Fizz]] - (key-seqs (s/either {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - {:QUU s/Str - :Quux [{:Fizz s/Str}]}))) - "Must contain paths for both the schema and a data described by it") - (is (= [[] - [:FOO] - [:FOO :schemas :fooBar] - [:FOO :schemas :BAR] - [:FOO :schemas :Baz] - [:FOO :schemas :QUU] - [:FOO :schemas :Quux] - [:FOO :schemas :Quux :Fizz] - [:FOO :fooBar] - [:FOO :BAR] - [:FOO :Baz] - [:FOO :QUU] - [:FOO :Quux] - [:FOO :Quux :Fizz]] - (key-seqs {:FOO (s/either {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - {:QUU s/Str - :Quux [{:Fizz s/Str}]})})) - "Must contain paths for both the schema and a data described by it")) - - (testing "cond-pre schemas" - (is (= [[] - [:schemas :fooBar] - [:fooBar]] - (key-seqs (s/cond-pre {:fooBar s/Str} s/Str))) - "Must contain paths for both the schema and a data described by it") - (is (= [[] - [:FOO] - [:FOO :schemas :fooBar] - [:FOO :fooBar]] - (key-seqs {:FOO (s/cond-pre {:fooBar s/Str} s/Str)})) - "Must contain paths for both the schema and a data described by it")) - - (testing "conditional schemas" - (is (= [[] - [:preds-and-schemas :fooBar] - [:preds-and-schemas :BAR] - [:preds-and-schemas :Baz] - [:preds-and-schemas :QUU] - [:preds-and-schemas :Quux] - [:preds-and-schemas :Quux :Fizz] - [:fooBar] - [:BAR] - [:Baz] - [:QUU] - [:Quux] - [:Quux :Fizz]] - (key-seqs (s/conditional - foo-map? - {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - :else - {:QUU s/Str - :Quux [{:Fizz s/Str}]}))) - "Must contain paths for both the schema and a data described by it") - (is (= [[] - [:FOO] - [:FOO :preds-and-schemas :fooBar] - [:FOO :preds-and-schemas :BAR] - [:FOO :preds-and-schemas :Baz] - [:FOO :preds-and-schemas :QUU] - [:FOO :preds-and-schemas :Quux] - [:FOO :preds-and-schemas :Quux :Fizz] - [:FOO :fooBar] - [:FOO :BAR] - [:FOO :Baz] - [:FOO :QUU] - [:FOO :Quux] - [:FOO :Quux :Fizz]] - (key-seqs {:FOO (s/conditional - foo-map? - {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str} - :else - {:QUU s/Str - :Quux [{:Fizz s/Str}]})})) - "Must contain paths for both the schema and a data described by it")) +(deftest compute-aliases-at-test + (testing "basic usage" + (let [schema {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz {:QUU s/Str + :Quux [{:Fizz s/Str}]}}] + (is (= {:foo-bar :fooBar + :bar :BAR + :baz :Baz} + (schema-tools/compute-aliases-at + schema + []))) + (is (nil? (schema-tools/compute-aliases-at + schema + [:foo-bar]))) + (is (nil? (schema-tools/compute-aliases-at + schema + [:bar]))) + (is (= {:quu :QUU + :quux :Quux} + (schema-tools/compute-aliases-at + schema + [:baz]))) + (is (nil? (schema-tools/compute-aliases-at + schema + [:baz :quu]))) + (is (= {:fizz :Fizz} + (schema-tools/compute-aliases-at + schema + [:baz :quux]))) + (is (nil? (schema-tools/compute-aliases-at + schema + [:baz :quux :fizz]))))) (testing "non-keyword keys" - (is (= [[] - ["fooBar"]] - (key-seqs {"fooBar" s/Str - 'bazQuux s/Str})) + (is (= {"foo-bar" "fooBar" + :bar-baz :Bar-Baz} + (schema-tools/compute-aliases-at + {"fooBar" s/Str + :Bar-Baz s/Str + 'bazQuux s/Str} + [])) "Symbols are excluded for performance purposes, could work as well")) (testing "qualified keys" - (is (= [[] - [:foo/Bar] - [:Baz/DOO]] - (key-seqs {:foo/Bar s/Str - :Baz/DOO s/Str})))) + (is (nil? (schema-tools/compute-aliases-at + {:foo/Bar s/Str + :Baz/DOO s/Str} + [])))) (testing "generic keys" - (is (= [[]] - (key-seqs {s/Str {:foo s/Str}}))) - (is (= [[]] - (key-seqs {s/Keyword {:foo s/Str}}))) - (is (= [[]] - (key-seqs (st/any-keys)))))) + (is (nil? (schema-tools/compute-aliases-at + {s/Str {:foo s/Str}} + []))) + (is (nil? (schema-tools/compute-aliases-at + {s/Keyword {:foo s/Str}} + []))) + (is (nil? (schema-tools/compute-aliases-at + (st/any-keys) + []))))) (deftest prewalk-with-path-test (testing "map schemas (with all sorts of keys)" (let [paths+forms (atom [])] - (prewalk-with-path (fn [path form] - (swap! paths+forms conj [path form]) - form) - [] - {:fooBar s/Str - (s/optional-key :BAR) s/Str - (s/required-key :Baz) s/Str}) + (schema-tools/prewalk-with-path + (fn [path form] + (swap! paths+forms conj [path form]) + form) + [] + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str}) (is (= [[[] {:fooBar s/Str, (s/optional-key :BAR) s/Str, :Baz s/Str}] [[] [:fooBar s/Str]] [[] :fooBar] @@ -315,14 +94,15 @@ (testing "nested map and vector schemas" (let [paths+forms (atom [])] - (prewalk-with-path (fn [path form] - (swap! paths+forms conj [path form]) - form) - [] - {:fooBar s/Str - (s/optional-key :BAR) s/Str - :Baz {:QUU s/Str - :Quux [{:Fizz s/Str}]}}) + (schema-tools/prewalk-with-path + (fn [path form] + (swap! paths+forms conj [path form]) + form) + [] + {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz {:QUU s/Str + :Quux [{:Fizz s/Str}]}}) (is (= [[[] {:fooBar s/Str, (s/optional-key :BAR) s/Str, :Baz {:QUU s/Str, :Quux [{:Fizz s/Str}]}}] @@ -352,13 +132,14 @@ (testing "deeply nested vector schemas" (let [paths+forms (atom [])] - (prewalk-with-path (fn [path form] - (swap! paths+forms conj [path form]) - form) - [] - {(s/optional-key :FOO) - {:Bar [[{:barDoo s/Str - (s/optional-key :barDee) s/Str}]]}}) + (schema-tools/prewalk-with-path + (fn [path form] + (swap! paths+forms conj [path form]) + form) + [] + {(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str + (s/optional-key :barDee) s/Str}]]}}) (is (= [[[] {(s/optional-key :FOO) {:Bar [[{:barDoo s/Str, (s/optional-key :barDee) s/Str}]]}}] [[] [(s/optional-key :FOO) @@ -391,16 +172,17 @@ (testing "default schemas" (let [paths+forms (atom [])] - (prewalk-with-path (fn [path form] - (swap! paths+forms conj [path form]) - form) - [] - {:fooBar s/Str - (s/optional-key :BAR) s/Str - :Baz (st/default {:QUU s/Str - :Quux [{:Fizz s/Str}]} - {:QUU "hi" - :Quux []})}) + (schema-tools/prewalk-with-path + (fn [path form] + (swap! paths+forms conj [path form]) + form) + [] + {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})}) (is (= [[[] {:fooBar s/Str, (s/optional-key :BAR) s/Str, :Baz (st/default {:QUU s/Str, :Quux [{:Fizz s/Str}]} {:QUU "hi", :Quux []})}] From 95bdbd953e3aaf03593232ee3f88c3962fd08a50 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Mon, 13 Oct 2025 20:20:50 +0400 Subject: [PATCH 28/37] Reshape the existing `:parameter-aliases` test case --- core/test/martian/core_test.cljc | 32 ++++++++++++++++++++------------ 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/core/test/martian/core_test.cljc b/core/test/martian/core_test.cljc index 00061930..564f6bef 100644 --- a/core/test/martian/core_test.cljc +++ b/core/test/martian/core_test.cljc @@ -416,18 +416,26 @@ :camel-version 2} {:include-query? true}))) - (is (= {:path-schema {[] {:camel-id :camelId}}, - :query-schema {[] {:camel-version :camelVersion}}, - :body-schema {[] {:camel :Camel}, - [:camel] {:camel-name :camelName, - :camel-train :camelTrain, - :any-camel :anyCamel}, - [:camel :camel-train] {:leader-name :leaderName, - :follower-camels :followerCamels}, - [:camel :camel-train :follower-camels] {:follower-name :followerName}}, - :form-schema {[] {:camel-humps :camelHumps}}, - :headers-schema {[] {:camel-token :camelToken}}} - (:parameter-aliases (martian/handler-for m :create-camel)))) + (let [param-aliases (:parameter-aliases (martian/handler-for m :create-camel))] + (is (= {:camel-id :camelId} + (get-in param-aliases [:path-schema []]))) + (is (= {:camel-version :camelVersion} + (get-in param-aliases [:query-schema []]))) + (is (= {:camel :Camel} + (get-in param-aliases [:body-schema []]))) + (is (= {:camel-name :camelName + :camel-train :camelTrain + :any-camel :anyCamel} + (get-in param-aliases [:body-schema [:camel]]))) + (is (= {:leader-name :leaderName + :follower-camels :followerCamels} + (get-in param-aliases [:body-schema [:camel :camel-train]]))) + (is (= {:follower-name :followerName} + (get-in param-aliases [:body-schema [:camel :camel-train :follower-camels]]))) + (is (= {:camel-humps :camelHumps} + (get-in param-aliases [:form-schema []]))) + (is (= {:camel-token :camelToken} + (get-in param-aliases [:headers-schema []])))) (is (= {:method :put, :url "https://camels.org/camels/1", From 367c7dad0bd08e63031db68c905c64835949d014 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Tue, 14 Oct 2025 04:41:59 +0400 Subject: [PATCH 29/37] Add some way to return param aliases as map (fixes BB) --- core/src/martian/parameter_aliases.cljc | 95 +++++++++++++------ core/test/martian/parameter_aliases_test.cljc | 69 ++++++++------ 2 files changed, 103 insertions(+), 61 deletions(-) diff --git a/core/src/martian/parameter_aliases.cljc b/core/src/martian/parameter_aliases.cljc index 1d6ca5fe..c941eb49 100644 --- a/core/src/martian/parameter_aliases.cljc +++ b/core/src/martian/parameter_aliases.cljc @@ -25,50 +25,83 @@ (swap! cache assoc path' m') m')))) -#?(:clj - (do - (deftype LazyRegistry [schema cache interner] - clojure.lang.ILookup - (valAt [_ k] - (aliases-at schema cache interner k)) - (valAt [_ k not-found] - (or (aliases-at schema cache interner k) not-found))) - - (defmethod print-method martian.parameter_aliases.LazyRegistry - [^martian.parameter_aliases.LazyRegistry r ^java.io.Writer w] - (.write w (str "#LazyRegistry (cached " (count @(.cache r)) ")"))))) - -#?(:cljs +#?(:bb nil + + :clj + (deftype LazyRegistry [schema cache interner] + clojure.lang.ILookup + (valAt [_ k] + (aliases-at schema cache interner k)) + (valAt [_ k not-found] + (or (aliases-at schema cache interner k) not-found)) + Object + (toString [_] (str "#LazyRegistry (cached " (count @cache) ")"))) + + :cljs (deftype LazyRegistry [schema cache interner] cljs.core/ILookup (-lookup [_ k] (aliases-at schema cache interner k)) (-lookup [_ k not-found] (or (aliases-at schema cache interner k) not-found)) - cljs.core/IPrintWithWriter (-pr-writer [_ writer _opts] (-write writer (str "#LazyRegistry (cached " (count @cache) ")"))))) +(defn- idiomatic-path [path] + (vec (keep schema-tools/->idiomatic path))) + +(defn aliases-hash-map + "Eagerly compute the registry as a plain hash map for the given `schema`. + + NB: This covers schema wrapper-aware paths (e.g. `[:baz :schema :quux]`) + and equivalent data-level paths (e.g. `[:baz :quux]`) uniformly." + [schema] + (let [*amap (volatile! {}) + *seen (volatile! #{}) + *pick (volatile! []) + + explore! (fn [path] + (when-not (contains? @*seen path) + (vswap! *seen conj path) + (when-let [m (schema-tools/compute-aliases-at schema path)] + (vswap! *amap assoc path m) + (vswap! *pick into (map #(conj path %) (keys m))))))] + ;; structure-driven seeding + (schema-tools/prewalk-with-path + (fn [p x] (explore! (idiomatic-path p)) x) + [] + schema) + ;; drain alias-driven paths (covers data-level hops) + (loop [] + (when-some [paths (not-empty @*pick)] + (vreset! *pick (pop paths)) + (explore! (peek paths)) + (recur))) + @*amap)) + (defn parameter-aliases - "Build a lazy alias registry for the given `schema`. - - Aliases are computed on demand via `martian.schema-tools/compute-aliases-at`, - so materializing massive alias maps upfront is avoided. Per-path results are - memoized within the registry. Identical alias maps are shared to cut memory - usage. - - The returned value implements `ILookup` and is indexed by an idiomatic path - (a vector of segments as used when walking data/schemas). Looking up a path - yields the alias map for that level, mapping \"idiomatic keys\" (kebab-case, - unqualified) to their original explicit schema keys (with optional/required - wrappers when applicable)." + "Builds a lookupable registry of parameter alias maps for the given `schema`. + + - On JVM/CLJS: + Returns an instance of a lazy registry. + + Aliases are computed on demand (via `compute-aliases-at`), so materializing + massive alias maps upfront is avoided. Per-path results are memoized within + the registry. Identical alias maps are shared to cut memory usage. + + The returned value implements `ILookup` and is indexed by an idiomatic path + (a vector of segments as used when walking data/schemas). Looking up a path + yields the alias map for that level, mapping \"idiomatic keys\" (kebab-case, + unqualified) to their original explicit schema keys (with optional/required + wrappers when applicable). + + - On Babashka: + Returns a plain hash map that is computed eagerly via `compute-aliases-at`." [schema] (when schema - (new LazyRegistry schema (atom {}) (atom {})))) - -(defn- idiomatic-path [path] - (vec (keep schema-tools/->idiomatic path))) + #?(:bb (aliases-hash-map schema) + :default (new LazyRegistry schema (atom {}) (atom {}))))) (defn unalias-data "Given a (possibly, deeply nested) data `x`, returns the data with all keys diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index 10c1a201..da240247 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -213,18 +213,21 @@ :Quux [{:Fizz s/Str}]})}) "Must contain aliases for both the schema and a data described by it")) - (testing "cond-pre schemas" - (is (=aliases - {[] {:foo-bar :fooBar} - [:schemas] {:foo-bar :fooBar}} - (s/cond-pre {:fooBar s/Str} s/Str)) - "Must contain paths for both the schema and a data described by it") - (is (=aliases - {[] {:foo :FOO} - [:foo] {:foo-bar :fooBar} - [:foo :schemas] {:foo-bar :fooBar}} - {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}) - "Must contain paths for both the schema and a data described by it")) + ;; TODO: An SCI issue happens for this test case. Unwrap when fixed. + #?(:bb nil + :default + (testing "cond-pre schemas" + (is (=aliases + {[] {:foo-bar :fooBar} + [:schemas] {:foo-bar :fooBar}} + (s/cond-pre {:fooBar s/Str} s/Str)) + "Must contain paths for both the schema and a data described by it") + (is (=aliases + {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar} + [:foo :schemas] {:foo-bar :fooBar}} + {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}) + "Must contain paths for both the schema and a data described by it"))) (testing "conditional schemas" (is (=aliases @@ -436,17 +439,20 @@ (unalias-data (parameter-aliases schema) {:foo {:quu "x" :quux [{:fizz "y"}]}}))))) - (testing "cond-pre schemas" - (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] - (is (= {:fooBar "a"} - (unalias-data (parameter-aliases schema) {:foo-bar "a"}))) - (is (= "b" - (unalias-data (parameter-aliases schema) "b")))) - (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] - (is (= {:FOO {:fooBar "a"}} - (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a"}}))) - (is (= {:FOO "b"} - (unalias-data (parameter-aliases schema) {:foo "b"}))))) + ;; TODO: An SCI issue happens for this test case. Unwrap when fixed. + #?(:bb nil + :default + (testing "cond-pre schemas" + (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] + (is (= {:fooBar "a"} + (unalias-data (parameter-aliases schema) {:foo-bar "a"}))) + (is (= "b" + (unalias-data (parameter-aliases schema) "b")))) + (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] + (is (= {:FOO {:fooBar "a"}} + (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a"}}))) + (is (= {:FOO "b"} + (unalias-data (parameter-aliases schema) {:foo "b"})))))) (testing "conditional schemas" (let [schema (s/conditional @@ -634,13 +640,16 @@ :Quux [{:Fizz s/Str}]})}] (alias-schema (parameter-aliases schema) schema))))) - (testing "cond-pre schemas" - (is (= (s/cond-pre {:foo-bar s/Str} s/Str) - (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] - (alias-schema (parameter-aliases schema) schema)))) - (is (= {:foo (s/cond-pre {:foo-bar s/Str} s/Str)} - (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] - (alias-schema (parameter-aliases schema) schema))))) + ;; TODO: An SCI issue happens for this test case. Unwrap when fixed. + #?(:bb nil + :default + (testing "cond-pre schemas" + (is (= (s/cond-pre {:foo-bar s/Str} s/Str) + (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] + (alias-schema (parameter-aliases schema) schema)))) + (is (= {:foo (s/cond-pre {:foo-bar s/Str} s/Str)} + (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] + (alias-schema (parameter-aliases schema) schema)))))) (testing "conditional schemas" (is (= (s/conditional From a5ad9f4dab108baa91df8a4a6bbb1bf342f59926 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Tue, 14 Oct 2025 05:21:03 +0400 Subject: [PATCH 30/37] Add support for `schema.core.Recursive` schemas --- core/src/martian/schema_tools.cljc | 10 +++ core/test/martian/parameter_aliases_test.cljc | 61 ++++++++++++++++++- 2 files changed, 69 insertions(+), 2 deletions(-) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 0fe270c5..47557276 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -129,6 +129,16 @@ (= :schema (first path)) (-aliases-at inner-schema (rest path)) :else (-aliases-at inner-schema path)))) + ;; Recursive schemas: no cycle guards are required in this per-path lookup. + + schema.core.Recursive + (-aliases-at [schema path] + (let [inner-schema @(:derefable schema)] + (cond + (empty? path) (-aliases-at inner-schema []) + (= :derefable (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) + ;; Multi-variant unions: combine the alternatives; aware of any inner hops. schema.core.Both diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index da240247..9bbe19d4 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -29,6 +29,12 @@ (def not-foo-map? (complement foo-map?)) +(declare schema-b) +(def schema-a {:FOO s/Str + :Bar (s/recursive #'schema-b)}) +(def schema-b {:BAZ s/Str + :Quu (s/recursive #'schema-a)}) + (deftest parameter-aliases-test (testing "produces idiomatic aliases for all keys in a schema" (testing "map schemas (with all sorts of keys)" @@ -274,6 +280,19 @@ :else {:QUU s/Str :Quux [{:Fizz s/Str}]})}) + "Must contain paths for both the schema and a data described by it")) + + (testing "recursive schemas" + (is (=aliases + {[] {:foo :FOO, :bar :Bar} + [:bar] {:baz :BAZ, :quu :Quu} + [:bar :derefable] {:baz :BAZ, :quu :Quu} + [:bar :quu] {:foo :FOO, :bar :Bar} + [:bar :quu :derefable] {:foo :FOO, :bar :Bar} + [:bar :quu :bar] {:baz :BAZ, :quu :Quu} + [:bar :quu :bar :derefable] {:baz :BAZ, :quu :Quu} + #_"..."} + schema-a) "Must contain paths for both the schema and a data described by it"))) (testing "non-keyword keys" @@ -490,7 +509,37 @@ (is (= {:FOO {:QUU "x" :Quux [{:Fizz "y"}]}} (unalias-data (parameter-aliases schema) {:foo {:quu "x" - :quux [{:fizz "y"}]}})))))) + :quux [{:fizz "y"}]}}))))) + + (testing "recursive schemas" + (is (= {:FOO "a" + :Bar nil} + (unalias-data (parameter-aliases schema-a) {:foo "a" + :bar nil}))) + (is (= {:FOO "a" + :Bar {:BAZ "b" + :Quu nil}} + (unalias-data (parameter-aliases schema-a) {:foo "a" + :bar {:baz "b" + :quu nil}}))) + (is (= {:FOO "a1" + :Bar {:BAZ "b1" + :Quu {:FOO "a2" + :Bar nil}}} + (unalias-data (parameter-aliases schema-a) {:foo "a1" + :bar {:baz "b1" + :quu {:foo "a2" + :bar nil}}}))) + (is (= {:FOO "a1" + :Bar {:BAZ "b1" + :Quu {:FOO "a2" + :Bar {:BAZ "b2" + :Quu nil}}}} + (unalias-data (parameter-aliases schema-a) {:foo "a1" + :bar {:baz "b1" + :quu {:foo "a2" + :bar {:baz "b2" + :quu nil}}}}))))) (testing "non-keyword keys" (is (= {"fooBar" "a" @@ -685,7 +734,15 @@ not-foo-map? {:QUU s/Str :Quux [{:Fizz s/Str}]})}] - (alias-schema (parameter-aliases schema) schema)))))) + (alias-schema (parameter-aliases schema) schema))))) + + (testing "recursive schemas" + (is (= {:foo s/Str + :bar (s/recursive #'schema-b)} + (alias-schema (parameter-aliases schema-a) schema-a))) + (is (= {:baz s/Str + :quu (s/recursive #'schema-a)} + (alias-schema (parameter-aliases schema-b) schema-b))))) (testing "non-keyword keys" (is (= {"foo-bar" s/Str From cbcb972735a27d641a4f3648f65ebeb3f5d1d2ba Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Tue, 14 Oct 2025 06:35:05 +0400 Subject: [PATCH 31/37] Fix Babashka tests + introduce a recursion limit for the `aliases-hash-map` function implementation (eager counterpart) --- core/src/martian/parameter_aliases.cljc | 7 +++- core/test/martian/parameter_aliases_test.cljc | 37 +++++++++++++------ 2 files changed, 31 insertions(+), 13 deletions(-) diff --git a/core/src/martian/parameter_aliases.cljc b/core/src/martian/parameter_aliases.cljc index c941eb49..941dec09 100644 --- a/core/src/martian/parameter_aliases.cljc +++ b/core/src/martian/parameter_aliases.cljc @@ -51,6 +51,10 @@ (defn- idiomatic-path [path] (vec (keep schema-tools/->idiomatic path))) +(def ^:dynamic *max-aliases-path-length* + "Maximum idiomatic path length allowed during the alias-driven expansion." + 20) + (defn aliases-hash-map "Eagerly compute the registry as a plain hash map for the given `schema`. @@ -66,7 +70,8 @@ (vswap! *seen conj path) (when-let [m (schema-tools/compute-aliases-at schema path)] (vswap! *amap assoc path m) - (vswap! *pick into (map #(conj path %) (keys m))))))] + (when (< (count path) *max-aliases-path-length*) + (vswap! *pick into (map #(conj path %) (keys m)))))))] ;; structure-driven seeding (schema-tools/prewalk-with-path (fn [p x] (explore! (idiomatic-path p)) x) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index 9bbe19d4..e963c1bb 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -282,18 +282,31 @@ :Quux [{:Fizz s/Str}]})}) "Must contain paths for both the schema and a data described by it")) - (testing "recursive schemas" - (is (=aliases - {[] {:foo :FOO, :bar :Bar} - [:bar] {:baz :BAZ, :quu :Quu} - [:bar :derefable] {:baz :BAZ, :quu :Quu} - [:bar :quu] {:foo :FOO, :bar :Bar} - [:bar :quu :derefable] {:foo :FOO, :bar :Bar} - [:bar :quu :bar] {:baz :BAZ, :quu :Quu} - [:bar :quu :bar :derefable] {:baz :BAZ, :quu :Quu} - #_"..."} - schema-a) - "Must contain paths for both the schema and a data described by it"))) + #?(:bb + ;; NB: The Babashka version is not that deep, since it uses plain hash map. + (testing "recursive schemas" + (is (=aliases + {[] {:foo :FOO, :bar :Bar} + [:bar] {:baz :BAZ, :quu :Quu} + [:bar :derefable] {:baz :BAZ, :quu :Quu} + [:bar :quu] {:foo :FOO, :bar :Bar} + [:bar :quu :bar] {:baz :BAZ, :quu :Quu} + #_"..."} + schema-a) + "Must contain paths for both the schema and a data described by it")) + :default + (testing "recursive schemas" + (is (=aliases + {[] {:foo :FOO, :bar :Bar} + [:bar] {:baz :BAZ, :quu :Quu} + [:bar :derefable] {:baz :BAZ, :quu :Quu} + [:bar :quu] {:foo :FOO, :bar :Bar} + [:bar :quu :derefable] {:foo :FOO, :bar :Bar} + [:bar :quu :bar] {:baz :BAZ, :quu :Quu} + [:bar :quu :bar :derefable] {:baz :BAZ, :quu :Quu} + #_"..."} + schema-a) + "Must contain paths for both the schema and a data described by it")))) (testing "non-keyword keys" (is (=aliases From 8ca01bc4137d08c8233e93b6347144bcb82eb1ae Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Tue, 14 Oct 2025 07:03:29 +0400 Subject: [PATCH 32/37] Improve and fine tune the `aliases-hash-map` fn --- core/src/martian/parameter_aliases.cljc | 14 +++++-- core/test/martian/parameter_aliases_test.cljc | 37 ++++++------------- 2 files changed, 22 insertions(+), 29 deletions(-) diff --git a/core/src/martian/parameter_aliases.cljc b/core/src/martian/parameter_aliases.cljc index 941dec09..76a897f3 100644 --- a/core/src/martian/parameter_aliases.cljc +++ b/core/src/martian/parameter_aliases.cljc @@ -53,7 +53,7 @@ (def ^:dynamic *max-aliases-path-length* "Maximum idiomatic path length allowed during the alias-driven expansion." - 20) + 10) (defn aliases-hash-map "Eagerly compute the registry as a plain hash map for the given `schema`. @@ -64,17 +64,23 @@ (let [*amap (volatile! {}) *seen (volatile! #{}) *pick (volatile! []) - + *ends (volatile! #{}) explore! (fn [path] (when-not (contains? @*seen path) (vswap! *seen conj path) (when-let [m (schema-tools/compute-aliases-at schema path)] (vswap! *amap assoc path m) (when (< (count path) *max-aliases-path-length*) - (vswap! *pick into (map #(conj path %) (keys m)))))))] + (vswap! *pick into (map #(conj path %) (keys m))) + (vswap! *pick into (map #(conj path %) @*ends))))))] ;; structure-driven seeding (schema-tools/prewalk-with-path - (fn [p x] (explore! (idiomatic-path p)) x) + (fn [p x] + (let [ip (idiomatic-path p)] + ;; learn tail segments (e.g. `:schema`, etc.) + (when (seq ip) (vswap! *ends conj (peek ip))) + (explore! ip)) + x) [] schema) ;; drain alias-driven paths (covers data-level hops) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index e963c1bb..9bbe19d4 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -282,31 +282,18 @@ :Quux [{:Fizz s/Str}]})}) "Must contain paths for both the schema and a data described by it")) - #?(:bb - ;; NB: The Babashka version is not that deep, since it uses plain hash map. - (testing "recursive schemas" - (is (=aliases - {[] {:foo :FOO, :bar :Bar} - [:bar] {:baz :BAZ, :quu :Quu} - [:bar :derefable] {:baz :BAZ, :quu :Quu} - [:bar :quu] {:foo :FOO, :bar :Bar} - [:bar :quu :bar] {:baz :BAZ, :quu :Quu} - #_"..."} - schema-a) - "Must contain paths for both the schema and a data described by it")) - :default - (testing "recursive schemas" - (is (=aliases - {[] {:foo :FOO, :bar :Bar} - [:bar] {:baz :BAZ, :quu :Quu} - [:bar :derefable] {:baz :BAZ, :quu :Quu} - [:bar :quu] {:foo :FOO, :bar :Bar} - [:bar :quu :derefable] {:foo :FOO, :bar :Bar} - [:bar :quu :bar] {:baz :BAZ, :quu :Quu} - [:bar :quu :bar :derefable] {:baz :BAZ, :quu :Quu} - #_"..."} - schema-a) - "Must contain paths for both the schema and a data described by it")))) + (testing "recursive schemas" + (is (=aliases + {[] {:foo :FOO, :bar :Bar} + [:bar] {:baz :BAZ, :quu :Quu} + [:bar :derefable] {:baz :BAZ, :quu :Quu} + [:bar :quu] {:foo :FOO, :bar :Bar} + [:bar :quu :derefable] {:foo :FOO, :bar :Bar} + [:bar :quu :bar] {:baz :BAZ, :quu :Quu} + [:bar :quu :bar :derefable] {:baz :BAZ, :quu :Quu} + #_"..."} + schema-a) + "Must contain paths for both the schema and a data described by it"))) (testing "non-keyword keys" (is (=aliases From ec3233900ef23fe1700b51d0c923697b7115c7db Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Wed, 15 Oct 2025 09:32:05 +0400 Subject: [PATCH 33/37] Improve on recursive schemas test's completeness --- core/test/martian/parameter_aliases_test.cljc | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index 9bbe19d4..561800c8 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -286,11 +286,15 @@ (is (=aliases {[] {:foo :FOO, :bar :Bar} [:bar] {:baz :BAZ, :quu :Quu} - [:bar :derefable] {:baz :BAZ, :quu :Quu} [:bar :quu] {:foo :FOO, :bar :Bar} - [:bar :quu :derefable] {:foo :FOO, :bar :Bar} [:bar :quu :bar] {:baz :BAZ, :quu :Quu} [:bar :quu :bar :derefable] {:baz :BAZ, :quu :Quu} + [:bar :quu :derefable] {:foo :FOO, :bar :Bar} + [:bar :quu :derefable :bar] {:baz :BAZ, :quu :Quu} + [:bar :quu :derefable :bar :derefable] {:baz :BAZ, :quu :Quu} + [:bar :derefable] {:baz :BAZ, :quu :Quu} + [:bar :derefable :quu] {:foo :FOO, :bar :Bar} + [:bar :derefable :quu :derefable] {:foo :FOO, :bar :Bar} #_"..."} schema-a) "Must contain paths for both the schema and a data described by it"))) From 9c4fda4cb8fc16f192f243458b49efd91fa8b395 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Wed, 15 Oct 2025 09:47:29 +0400 Subject: [PATCH 34/37] Re-impl the `aliases-hash-map` fn via prev protocol --- core/src/martian/parameter_aliases.cljc | 59 +++------- core/src/martian/schema_tools.cljc | 146 +++++++++++++++++++++--- 2 files changed, 148 insertions(+), 57 deletions(-) diff --git a/core/src/martian/parameter_aliases.cljc b/core/src/martian/parameter_aliases.cljc index 76a897f3..6ec6fb3c 100644 --- a/core/src/martian/parameter_aliases.cljc +++ b/core/src/martian/parameter_aliases.cljc @@ -51,45 +51,22 @@ (defn- idiomatic-path [path] (vec (keep schema-tools/->idiomatic path))) -(def ^:dynamic *max-aliases-path-length* - "Maximum idiomatic path length allowed during the alias-driven expansion." - 10) - (defn aliases-hash-map - "Eagerly compute the registry as a plain hash map for the given `schema`. + "Eagerly computes the registry as a data structure for the given `schema`. + + Produces a plain hash map with idiomatic keys (aliases) mappings per path + in a (possibly, deeply nested) `schema` for all its unqualified keys. - NB: This covers schema wrapper-aware paths (e.g. `[:baz :schema :quux]`) - and equivalent data-level paths (e.g. `[:baz :quux]`) uniformly." + The result is then used with `alias-schema` and `unalias-data` functions." [schema] - (let [*amap (volatile! {}) - *seen (volatile! #{}) - *pick (volatile! []) - *ends (volatile! #{}) - explore! (fn [path] - (when-not (contains? @*seen path) - (vswap! *seen conj path) - (when-let [m (schema-tools/compute-aliases-at schema path)] - (vswap! *amap assoc path m) - (when (< (count path) *max-aliases-path-length*) - (vswap! *pick into (map #(conj path %) (keys m))) - (vswap! *pick into (map #(conj path %) @*ends))))))] - ;; structure-driven seeding - (schema-tools/prewalk-with-path - (fn [p x] - (let [ip (idiomatic-path p)] - ;; learn tail segments (e.g. `:schema`, etc.) - (when (seq ip) (vswap! *ends conj (peek ip))) - (explore! ip)) - x) - [] - schema) - ;; drain alias-driven paths (covers data-level hops) - (loop [] - (when-some [paths (not-empty @*pick)] - (vreset! *pick (pop paths)) - (explore! (peek paths)) - (recur))) - @*amap)) + (reduce (fn [acc path] + (let [leaf (peek path) + idiomatic-key (some-> leaf (schema-tools/->idiomatic))] + (if (and idiomatic-key (not= leaf idiomatic-key)) + (update acc (idiomatic-path (pop path)) assoc idiomatic-key leaf) + acc))) + {} + (schema-tools/key-seqs schema))) (defn parameter-aliases "Builds a lookupable registry of parameter alias maps for the given `schema`. @@ -101,14 +78,12 @@ massive alias maps upfront is avoided. Per-path results are memoized within the registry. Identical alias maps are shared to cut memory usage. - The returned value implements `ILookup` and is indexed by an idiomatic path - (a vector of segments as used when walking data/schemas). Looking up a path - yields the alias map for that level, mapping \"idiomatic keys\" (kebab-case, - unqualified) to their original explicit schema keys (with optional/required - wrappers when applicable). + A returned value implements `ILookup` and is indexed by \"idiomatic paths\". + Looking up a path gives an alias map for that level, mapping idiomatic keys + (kebab-case, unqualified) to their original schema keys. - On Babashka: - Returns a plain hash map that is computed eagerly via `compute-aliases-at`." + Returns a plain hash map registry that is computed eagerly via `key-seqs`." [schema] (when schema #?(:bb (aliases-hash-map schema) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 47557276..45f86bde 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -7,6 +7,9 @@ (defn explicit-key [k] (if (s/specific-key? k) (s/explicit-schema-key k) k)) +(defn concrete-key? [k] + (or (keyword? k) (s/specific-key? k) (string? k))) + (defn- can-be-renamed? [k] ;; NB: See `camel-snake-kebab.internals.alter-name` ns. (or (and (keyword? k) (not (namespace k))) (string? k))) @@ -46,17 +49,31 @@ [ms seg] (some (fn [[k v]] (when (= seg (->idiomatic k)) v)) ms)) -(defprotocol PathAliases - "Internal traversal API used to locate alias maps inside schemas. +(defn- concat* [& xs] + (apply concat (remove nil? xs))) + +(def ^:dynamic *seen-recursion* + "Cycle/budget guard for `s/recursive` schema targets. Bound in `key-seqs` fn." + nil) - Implementations should walk `schema` along an `idiomatic-path` (a vector of - kebab-case, unqualified segments) and, when the path lands on a map schema, - return a map `{idiomatic -> original-explicit}` for that level; otherwise, - return `nil`, i.e. don't traverse past the target level or build whole-tree - results." +(def ^:dynamic *max-recursions-per-target* + "Maximum number of times the same recursive schema target may be expanded + along a single path." + 3) + +(defprotocol PathAliases + "Internal traversal API used to locate alias maps inside Prismatic schemas." + (-paths [schema path include-self?] + "Returns a sequence of path vectors found within the given prefix `path`. + If `include-self?` is true, includes `path` itself as the first element.") (-aliases-at [schema idiomatic-path] "Returns the alias map available at `idiomatic-path` inside the `schema`, - or `nil` if that location is not a map level or has no aliasable keys.")) + or `nil` if that location is not a map level or has no aliasable keys. + + Implementations should walk `schema` along an `idiomatic-path` (a vector of + kebab-case, unqualified segments) and, when the path lands on a map schema, + return an alias map for that level; otherwise return `nil`. Do not traverse + past the target level or build whole-tree results.")) (defn combine-aliases-at "Collects and merges alias maps from multiple `inner-schemas` at the single @@ -72,6 +89,15 @@ #?(:clj clojure.lang.APersistentMap :cljs cljs.core.PersistentArrayMap) + (-paths [schema path include-self?] + (concat* + (when include-self? (list path)) + (mapcat (fn [[k v]] + (when (concrete-key? k) + (let [k' (explicit-key k) + path' (conj path k')] + (cons path' (-paths v path' false))))) + schema))) (-aliases-at [ms path] (if (empty? path) (map-entry-aliases ms) @@ -80,16 +106,25 @@ (when-some [child (child-by-idiomatic ms seg)] (-aliases-at child (rest path))))))) - ;; Vector schemas are transparent: we merge aliases from element schemas, - ;; including when `path` is empty, so deeply nested vectors work as well. + ;; Vector schemas are transparent #?(:clj clojure.lang.APersistentVector :cljs cljs.core.PersistentVector) + (-paths [schema path include-self?] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % path false) schema))) (-aliases-at [vs path] (combine-aliases-at path vs)) - ;; Single-child wrappers: aware of the inner `:schema` hop. + ;; Single-child wrappers schema.core.NamedSchema + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) (-aliases-at [schema path] (let [inner-schema (:schema schema)] (cond @@ -98,6 +133,12 @@ :else (-aliases-at inner-schema path)))) schema.core.Maybe + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) (-aliases-at [schema path] (let [inner-schema (:schema schema)] (cond @@ -106,6 +147,12 @@ :else (-aliases-at inner-schema path)))) schema.core.Constrained + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) (-aliases-at [schema path] (let [inner-schema (:schema schema)] (cond @@ -114,6 +161,12 @@ :else (-aliases-at inner-schema path)))) schema.core.One + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) (-aliases-at [schema path] (let [inner-schema (:schema schema)] (cond @@ -122,6 +175,12 @@ :else (-aliases-at inner-schema path)))) schema.core.Record + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) (-aliases-at [schema path] (let [inner-schema (:schema schema)] (cond @@ -129,9 +188,22 @@ (= :schema (first path)) (-aliases-at inner-schema (rest path)) :else (-aliases-at inner-schema path)))) - ;; Recursive schemas: no cycle guards are required in this per-path lookup. - + ;; Recursive schemas schema.core.Recursive + (-paths [schema path include-self?] + (let [target (:derefable schema)] + (concat* + (when include-self? (list path)) + (when target + (let [n (get @*seen-recursion* target 0)] + (when (< n *max-recursions-per-target*) + (vswap! *seen-recursion* update target (fnil inc 0)) + (let [inner-schema @target + res (concat + (-paths inner-schema (conj path :derefable) true) + (-paths inner-schema path false))] + (vswap! *seen-recursion* update target #(max 0 (dec %))) + res))))))) (-aliases-at [schema path] (let [inner-schema @(:derefable schema)] (cond @@ -139,9 +211,15 @@ (= :derefable (first path)) (-aliases-at inner-schema (rest path)) :else (-aliases-at inner-schema path)))) - ;; Multi-variant unions: combine the alternatives; aware of any inner hops. + ;; Multi-variant unions schema.core.Both + (-paths [schema path include-self?] + (let [inner-schemas (:schemas schema)] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % (conj path :schemas) false) inner-schemas) + (mapcat #(-paths % path false) inner-schemas)))) (-aliases-at [schema path] (let [inner-schemas (:schemas schema)] (cond @@ -150,6 +228,12 @@ :else (combine-aliases-at path inner-schemas)))) schema.core.Either + (-paths [schema path include-self?] + (let [inner-schemas (:schemas schema)] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % (conj path :schemas) false) inner-schemas) + (mapcat #(-paths % path false) inner-schemas)))) (-aliases-at [schema path] (let [inner-schemas (:schemas schema)] (cond @@ -158,6 +242,12 @@ :else (combine-aliases-at path inner-schemas)))) schema.core.CondPre + (-paths [schema path include-self?] + (let [inner-schemas (:schemas schema)] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % (conj path :schemas) false) inner-schemas) + (mapcat #(-paths % path false) inner-schemas)))) (-aliases-at [schema path] (let [inner-schemas (:schemas schema)] (cond @@ -166,6 +256,12 @@ :else (combine-aliases-at path inner-schemas)))) schema.core.ConditionalSchema + (-paths [schema path include-self?] + (let [inner-schemas (map second (:preds-and-schemas schema))] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % (conj path :preds-and-schemas) false) inner-schemas) + (mapcat #(-paths % path false) inner-schemas)))) (-aliases-at [schema path] (let [inner-schemas (map second (:preds-and-schemas schema))] (cond @@ -173,8 +269,15 @@ (= :preds-and-schemas (first path)) (combine-aliases-at (rest path) inner-schemas) :else (combine-aliases-at path inner-schemas)))) - ;; The `schema-tools`'s defaults: aware of the `:schema` and `:value` hops. + ;; Default schemas (from `schema-tools`) schema_tools.impl.Default + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema (conj path :value) true) + (-paths inner-schema path false)))) (-aliases-at [schema path] (let [inner-schema (:schema schema)] (cond @@ -184,11 +287,24 @@ :else (-aliases-at inner-schema path)))) #?(:clj Object :cljs default) + (-paths [_ path include-self?] + (when include-self? (list path))) (-aliases-at [_ _] nil) nil + (-paths [_ _ _] nil) (-aliases-at [_ _] nil)) +(defn key-seqs + "Returns a vec of unique key paths (key seqs) for `schema` and all subschemas + that will cover all possible entries in a data described by `schema` as well + as the `schema` itself." + [schema] + (->> (binding [*seen-recursion* (volatile! {})] + (-paths schema [] true)) + (distinct) + (vec))) + (defn compute-aliases-at "Given a `schema` and an `idiomatic-path` (a vector of kebab-case, unqualified segments), returns a map which describes how the idiomatic keys at that exact From 71d6438efa4eb15125ba3ede9edc70f0fbffd09e Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Wed, 15 Oct 2025 10:37:44 +0400 Subject: [PATCH 35/37] Misc improvements (names, docstrings, arglists) --- core/src/martian/core.cljc | 4 +- core/src/martian/parameter_aliases.cljc | 44 ++-- core/src/martian/schema_tools.cljc | 70 +++--- core/test/martian/parameter_aliases_test.cljc | 210 +++++++++--------- 4 files changed, 172 insertions(+), 156 deletions(-) diff --git a/core/src/martian/core.cljc b/core/src/martian/core.cljc index d2da6d6d..46fe4a83 100644 --- a/core/src/martian/core.cljc +++ b/core/src/martian/core.cljc @@ -6,7 +6,7 @@ [lambdaisland.uri :refer [map->query-string]] [martian.interceptors :as interceptors] [martian.openapi :refer [openapi->handlers openapi-schema?]] - [martian.parameter-aliases :refer [parameter-aliases alias-schema]] + [martian.parameter-aliases :refer [registry alias-schema]] [martian.schema :as schema] [martian.spec :as mspec] [martian.swagger :refer [swagger->handlers]] @@ -133,7 +133,7 @@ (defn- collect-parameter-aliases [handler] (reduce (fn [aliases param-key] - (assoc aliases param-key (parameter-aliases (get handler param-key)))) + (assoc aliases param-key (registry (get handler param-key)))) {} parameter-schemas)) diff --git a/core/src/martian/parameter_aliases.cljc b/core/src/martian/parameter_aliases.cljc index 6ec6fb3c..ccec9437 100644 --- a/core/src/martian/parameter_aliases.cljc +++ b/core/src/martian/parameter_aliases.cljc @@ -68,7 +68,7 @@ {} (schema-tools/key-seqs schema))) -(defn parameter-aliases +(defn registry "Builds a lookupable registry of parameter alias maps for the given `schema`. - On JVM/CLJS: @@ -89,35 +89,39 @@ #?(:bb (aliases-hash-map schema) :default (new LazyRegistry schema (atom {}) (atom {}))))) +;; TODO: An alias for backward compatibility. Remove later on. +(def parameter-aliases registry) + (defn unalias-data - "Given a (possibly, deeply nested) data `x`, returns the data with all keys - renamed from \"idiomatic\" using the given `parameter-aliases` registry." - [parameter-aliases x] - (if parameter-aliases + "Given a (possibly, deeply nested) `data` structure, returns it with all its + keys renamed from \"idiomatic\" (aliases) using the given parameter aliases + `registry`." + [registry data] + (if registry (schema-tools/prewalk-with-path (fn [path x] (if (map? x) - (rename-keys x (get parameter-aliases (idiomatic-path path))) + (rename-keys x (get registry (idiomatic-path path))) x)) - [] - x) - x)) + data) + data)) (defn alias-schema "Given a (possibly, deeply nested) `schema`, renames all keys (in it and its subschemas) into corresponding \"idiomatic\" keys (aliases) using the given - `parameter-aliases` registry." - [parameter-aliases schema] - (if parameter-aliases + parameter aliases `registry`." + [registry schema] + (if registry (schema-tools/prewalk-with-path - (fn [path x] - (if (map? x) - (let [kmap (reduce-kv (fn [kmap k v] - (assoc kmap v k (s/optional-key v) (s/optional-key k))) + (fn [path subschema] + (if (map? subschema) + (let [kmap (reduce-kv (fn [kmap idiomatic original] + (assoc kmap + original idiomatic + (s/optional-key original) (s/optional-key idiomatic))) {} - (get parameter-aliases (idiomatic-path path)))] - (rename-keys x kmap)) - x)) - [] + (get registry (idiomatic-path path)))] + (rename-keys subschema kmap)) + subschema)) schema) schema)) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 45f86bde..4b2ed074 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -1,13 +1,14 @@ (ns martian.schema-tools (:require [camel-snake-kebab.core :refer [->kebab-case]] [schema.core :as s] - [schema-tools.impl]) - #?(:clj (:import (clojure.lang IDeref)))) + [schema-tools.impl])) (defn explicit-key [k] (if (s/specific-key? k) (s/explicit-schema-key k) k)) -(defn concrete-key? [k] +(defn concrete-key? + "Checks if the schema key `k` is not generic (`s/Any`, `s/Keyword`, etc.)." + [k] (or (keyword? k) (s/specific-key? k) (string? k))) (defn- can-be-renamed? [k] @@ -61,6 +62,15 @@ along a single path." 3) +(defmacro with-recursion-guard [rec-target form] + `(when ~rec-target + (let [n# (get @*seen-recursion* ~rec-target 0)] + (when (< n# *max-recursions-per-target*) + (vswap! *seen-recursion* update ~rec-target (fnil inc 0)) + (let [res# ~form] + (vswap! *seen-recursion* update ~rec-target #(max 0 (dec %))) + res#))))) + (defprotocol PathAliases "Internal traversal API used to locate alias maps inside Prismatic schemas." (-paths [schema path include-self?] @@ -98,12 +108,12 @@ path' (conj path k')] (cons path' (-paths v path' false))))) schema))) - (-aliases-at [ms path] + (-aliases-at [schema path] (if (empty? path) - (map-entry-aliases ms) + (map-entry-aliases schema) (let [seg (first path)] (when (or (keyword? seg) (string? seg)) - (when-some [child (child-by-idiomatic ms seg)] + (when-some [child (child-by-idiomatic schema seg)] (-aliases-at child (rest path))))))) ;; Vector schemas are transparent @@ -113,8 +123,8 @@ (concat* (when include-self? (list path)) (mapcat #(-paths % path false) schema))) - (-aliases-at [vs path] - (combine-aliases-at path vs)) + (-aliases-at [schema path] + (combine-aliases-at path schema)) ;; Single-child wrappers @@ -194,16 +204,12 @@ (let [target (:derefable schema)] (concat* (when include-self? (list path)) - (when target - (let [n (get @*seen-recursion* target 0)] - (when (< n *max-recursions-per-target*) - (vswap! *seen-recursion* update target (fnil inc 0)) - (let [inner-schema @target - res (concat - (-paths inner-schema (conj path :derefable) true) - (-paths inner-schema path false))] - (vswap! *seen-recursion* update target #(max 0 (dec %))) - res))))))) + (with-recursion-guard + target + (let [inner-schema @target] + (concat + (-paths inner-schema (conj path :derefable) true) + (-paths inner-schema path false))))))) (-aliases-at [schema path] (let [inner-schema @(:derefable schema)] (cond @@ -345,14 +351,20 @@ (outer path (into (empty form) (map #(inner path %) form))) :else (outer path form)))) -(defn postwalk-with-path [f path form] - (walk-with-path (fn [path form] (postwalk-with-path f path form)) - f - path - form)) - -(defn prewalk-with-path [f path form] - (walk-with-path (fn [path form] (prewalk-with-path f path form)) - (fn [_path form] form) - path - (f path form))) +(defn postwalk-with-path + ([f form] + (postwalk-with-path f [] form)) + ([f path form] + (walk-with-path (fn [path form] (postwalk-with-path f path form)) + f + path + form))) + +(defn prewalk-with-path + ([f form] + (prewalk-with-path f [] form)) + ([f path form] + (walk-with-path (fn [path form] (prewalk-with-path f path form)) + (fn [_path form] form) + path + (f path form)))) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index 561800c8..b96bad0c 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -1,23 +1,23 @@ (ns martian.parameter-aliases-test (:require [clojure.string :as str] - [martian.parameter-aliases :refer [parameter-aliases unalias-data alias-schema]] + [martian.parameter-aliases :refer [registry unalias-data alias-schema]] [schema-tools.core :as st] [schema.core :as s] #?(:clj [clojure.test :refer [deftest testing is]] :cljs [cljs.test :refer-macros [deftest testing is]]))) (defn select-aliases-from-registry - "Given a lazy registry and an expected map whose keys are paths, + "Given a (possibly, lazy) registry and an expected map whose keys are paths, pull exactly those paths and return a plain {path -> alias-map}." - [lazy-reg expected] + [registry expected] (into {} - (map (fn [path] [path (get lazy-reg path)])) + (map (fn [path] [path (get registry path)])) (keys expected))) (defmacro =aliases [expected schema] - `(let [lazy-reg# (parameter-aliases ~schema)] - (= ~expected (select-aliases-from-registry lazy-reg# ~expected)))) + `(let [reg# (registry ~schema)] + (= ~expected (select-aliases-from-registry reg# ~expected)))) (defn not-blank? [s] (not (str/blank? s))) @@ -35,7 +35,7 @@ (def schema-b {:BAZ s/Str :Quu (s/recursive #'schema-a)}) -(deftest parameter-aliases-test +(deftest registry-test (testing "produces idiomatic aliases for all keys in a schema" (testing "map schemas (with all sorts of keys)" (is (=aliases @@ -332,17 +332,17 @@ (let [schema {:fooBar s/Str (s/optional-key :BAR) s/Str (s/required-key :Baz) s/Str}] - (unalias-data (parameter-aliases schema) {:foo-bar "a" - :bar "b" - :baz "c"}))))) + (unalias-data (registry schema) {:foo-bar "a" + :bar "b" + :baz "c"}))))) (testing "nested map and vector schemas" (is (= {:FOO {:fooBar "b" :Bar [{:BAZ "c"}]}} (let [schema {:FOO {:fooBar s/Str (s/optional-key :Bar) [{:BAZ s/Str}]}}] - (unalias-data (parameter-aliases schema) {:foo {:foo-bar "b" - :bar [{:baz "c"}]}}))))) + (unalias-data (registry schema) {:foo {:foo-bar "b" + :bar [{:baz "c"}]}}))))) (testing "deeply nested vector schemas" (is (= {:FOO {:Bar [[{:barDoo "a" @@ -350,8 +350,8 @@ (let [schema {(s/optional-key :FOO) {:Bar [[{:barDoo s/Str (s/optional-key :barDee) s/Str}]]}}] - (unalias-data (parameter-aliases schema) {:foo {:bar [[{:bar-doo "a" - :bar-dee "b"}]]}}))))) + (unalias-data (registry schema) {:foo {:bar [[{:bar-doo "a" + :bar-dee "b"}]]}}))))) (testing "default schemas" (is (= {:fooBar "a" @@ -364,39 +364,39 @@ :Quux [{:Fizz s/Str}]} {:QUU "hi" :Quux []})}] - (unalias-data (parameter-aliases schema) {:foo-bar "a" - :bar "b" - :baz {:quu "x" - :quux [{:fizz "y"}]}})))) + (unalias-data (registry schema) {:foo-bar "a" + :bar "b" + :baz {:quu "x" + :quux [{:fizz "y"}]}})))) (is (= {:QUU "x" :Quux [{:Fizz "y"}]} (let [schema (st/default {:QUU s/Str :Quux [{:Fizz s/Str}]} {:QUU "hi" :Quux []})] - (unalias-data (parameter-aliases schema) {:quu "x" - :quux [{:fizz "y"}]}))))) + (unalias-data (registry schema) {:quu "x" + :quux [{:fizz "y"}]}))))) (testing "named schemas" (is (= {:fooBar "a"} (let [schema (s/named {:fooBar s/Str} "FooBar")] - (unalias-data (parameter-aliases schema) {:foo-bar "a"}))))) + (unalias-data (registry schema) {:foo-bar "a"}))))) (testing "maybe schemas" (is (= {:fooBar {:Baz "a"}} (let [schema {:fooBar (s/maybe {:Baz s/Str})}] - (unalias-data (parameter-aliases schema) {:foo-bar {:baz "a"}})))) + (unalias-data (registry schema) {:foo-bar {:baz "a"}})))) (is (= {:fooBar "a"} (let [schema (s/maybe {:fooBar s/Str})] - (unalias-data (parameter-aliases schema) {:foo-bar "a"}))))) + (unalias-data (registry schema) {:foo-bar "a"}))))) (testing "constrained schemas" (is (= {:fooBar "a"} (let [schema {:fooBar (s/constrained s/Str not-blank?)}] - (unalias-data (parameter-aliases schema) {:foo-bar "a"})))) + (unalias-data (registry schema) {:foo-bar "a"})))) (is (= {:fooBar {:Baz "b"}} (let [schema {:fooBar (s/constrained {:Baz s/Str} some?)}] - (unalias-data (parameter-aliases schema) {:foo-bar {:baz "b"}}))))) + (unalias-data (registry schema) {:foo-bar {:baz "b"}}))))) (testing "both schemas" (is (= {:fooBar "a" @@ -409,11 +409,11 @@ (s/required-key :Baz) s/Str} {:QUU s/Str :Quux [{:Fizz s/Str}]})] - (unalias-data (parameter-aliases schema) {:foo-bar "a" - :bar "b" - :baz "c" - :quu "x" - :quux [{:fizz "y"}]})))) + (unalias-data (registry schema) {:foo-bar "a" + :bar "b" + :baz "c" + :quu "x" + :quux [{:fizz "y"}]})))) (is (= {:FOO {:fooBar "a" :BAR "b" :Baz "c" @@ -424,11 +424,11 @@ (s/required-key :Baz) s/Str} {:QUU s/Str :Quux [{:Fizz s/Str}]})}] - (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a" - :bar "b" - :baz "c" - :quu "x" - :quux [{:fizz "y"}]}}))))) + (unalias-data (registry schema) {:foo {:foo-bar "a" + :bar "b" + :baz "c" + :quu "x" + :quux [{:fizz "y"}]}}))))) (testing "either schemas" (let [schema (s/either {:fooBar s/Str @@ -439,13 +439,13 @@ (is (= {:fooBar "a" :BAR "b" :Baz "c"} - (unalias-data (parameter-aliases schema) {:foo-bar "a" - :bar "b" - :baz "c"}))) + (unalias-data (registry schema) {:foo-bar "a" + :bar "b" + :baz "c"}))) (is (= {:QUU "x" :Quux [{:Fizz "y"}]} - (unalias-data (parameter-aliases schema) {:quu "x" - :quux [{:fizz "y"}]})))) + (unalias-data (registry schema) {:quu "x" + :quux [{:fizz "y"}]})))) (let [schema {:FOO (s/either {:fooBar s/Str (s/optional-key :BAR) s/Str (s/required-key :Baz) s/Str} @@ -454,13 +454,13 @@ (is (= {:FOO {:fooBar "a" :BAR "b" :Baz "c"}} - (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a" - :bar "b" - :baz "c"}}))) + (unalias-data (registry schema) {:foo {:foo-bar "a" + :bar "b" + :baz "c"}}))) (is (= {:FOO {:QUU "x" :Quux [{:Fizz "y"}]}} - (unalias-data (parameter-aliases schema) {:foo {:quu "x" - :quux [{:fizz "y"}]}}))))) + (unalias-data (registry schema) {:foo {:quu "x" + :quux [{:fizz "y"}]}}))))) ;; TODO: An SCI issue happens for this test case. Unwrap when fixed. #?(:bb nil @@ -468,14 +468,14 @@ (testing "cond-pre schemas" (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] (is (= {:fooBar "a"} - (unalias-data (parameter-aliases schema) {:foo-bar "a"}))) + (unalias-data (registry schema) {:foo-bar "a"}))) (is (= "b" - (unalias-data (parameter-aliases schema) "b")))) + (unalias-data (registry schema) "b")))) (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] (is (= {:FOO {:fooBar "a"}} - (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a"}}))) + (unalias-data (registry schema) {:foo {:foo-bar "a"}}))) (is (= {:FOO "b"} - (unalias-data (parameter-aliases schema) {:foo "b"})))))) + (unalias-data (registry schema) {:foo "b"})))))) (testing "conditional schemas" (let [schema (s/conditional @@ -489,13 +489,13 @@ (is (= {:fooBar "a" :BAR "b" :Baz "c"} - (unalias-data (parameter-aliases schema) {:foo-bar "a" - :bar "b" - :baz "c"}))) + (unalias-data (registry schema) {:foo-bar "a" + :bar "b" + :baz "c"}))) (is (= {:QUU "x" :Quux [{:Fizz "y"}]} - (unalias-data (parameter-aliases schema) {:quu "x" - :quux [{:fizz "y"}]})))) + (unalias-data (registry schema) {:quu "x" + :quux [{:fizz "y"}]})))) (let [schema {:FOO (s/conditional foo-map? {:fooBar s/Str @@ -507,51 +507,51 @@ (is (= {:FOO {:fooBar "a" :BAR "b" :Baz "c"}} - (unalias-data (parameter-aliases schema) {:foo {:foo-bar "a" - :bar "b" - :baz "c"}}))) + (unalias-data (registry schema) {:foo {:foo-bar "a" + :bar "b" + :baz "c"}}))) (is (= {:FOO {:QUU "x" :Quux [{:Fizz "y"}]}} - (unalias-data (parameter-aliases schema) {:foo {:quu "x" - :quux [{:fizz "y"}]}}))))) + (unalias-data (registry schema) {:foo {:quu "x" + :quux [{:fizz "y"}]}}))))) (testing "recursive schemas" (is (= {:FOO "a" :Bar nil} - (unalias-data (parameter-aliases schema-a) {:foo "a" - :bar nil}))) + (unalias-data (registry schema-a) {:foo "a" + :bar nil}))) (is (= {:FOO "a" :Bar {:BAZ "b" :Quu nil}} - (unalias-data (parameter-aliases schema-a) {:foo "a" - :bar {:baz "b" - :quu nil}}))) + (unalias-data (registry schema-a) {:foo "a" + :bar {:baz "b" + :quu nil}}))) (is (= {:FOO "a1" :Bar {:BAZ "b1" :Quu {:FOO "a2" :Bar nil}}} - (unalias-data (parameter-aliases schema-a) {:foo "a1" - :bar {:baz "b1" - :quu {:foo "a2" - :bar nil}}}))) + (unalias-data (registry schema-a) {:foo "a1" + :bar {:baz "b1" + :quu {:foo "a2" + :bar nil}}}))) (is (= {:FOO "a1" :Bar {:BAZ "b1" :Quu {:FOO "a2" :Bar {:BAZ "b2" :Quu nil}}}} - (unalias-data (parameter-aliases schema-a) {:foo "a1" - :bar {:baz "b1" - :quu {:foo "a2" - :bar {:baz "b2" - :quu nil}}}}))))) + (unalias-data (registry schema-a) {:foo "a1" + :bar {:baz "b1" + :quu {:foo "a2" + :bar {:baz "b2" + :quu nil}}}}))))) (testing "non-keyword keys" (is (= {"fooBar" "a" 'baz-quux "b"} (let [schema {"fooBar" s/Str 'bazQuux s/Str}] - (unalias-data (parameter-aliases schema) {"foo-bar" "a" - 'baz-quux "b"}))) + (unalias-data (registry schema) {"foo-bar" "a" + 'baz-quux "b"}))) "Symbols are excluded for performance purposes, could work as well")) (testing "qualified keys are not renamed" @@ -559,19 +559,19 @@ :Baz/DOO "b"} (let [schema {:foo/Bar s/Str :Baz/DOO s/Str}] - (unalias-data (parameter-aliases schema) {:foo/Bar "a" - :Baz/DOO "b"}))))) + (unalias-data (registry schema) {:foo/Bar "a" + :Baz/DOO "b"}))))) (testing "generic keys are not renamed" (is (= {"a" {:foo-bar "b"}} (let [schema {s/Str {:fooBar s/Str}}] - (unalias-data (parameter-aliases schema) {"a" {:foo-bar "b"}})))) + (unalias-data (registry schema) {"a" {:foo-bar "b"}})))) (is (= {:a {:foo-bar "b"}} (let [schema {s/Keyword {:fooBar s/Str}}] - (unalias-data (parameter-aliases schema) {:a {:foo-bar "b"}})))) + (unalias-data (registry schema) {:a {:foo-bar "b"}})))) (is (= {:foo-bar "a"} (let [schema (st/any-keys)] - (unalias-data (parameter-aliases schema) {:foo-bar "a"})))))) + (unalias-data (registry schema) {:foo-bar "a"})))))) (deftest alias-schema-test (testing "renames schema keys into idiomatic keys" @@ -582,14 +582,14 @@ (let [schema {:fooBar s/Str (s/optional-key :BAR) s/Str (s/required-key :Baz) s/Str}] - (alias-schema (parameter-aliases schema) schema))))) + (alias-schema (registry schema) schema))))) (testing "nested map and vector schemas" (is (= {:foo {:foo-bar s/Str (s/optional-key :bar) [{:baz s/Str}]}} (let [schema {:FOO {:fooBar s/Str (s/optional-key :Bar) [{:BAZ s/Str}]}}] - (alias-schema (parameter-aliases schema) schema))))) + (alias-schema (registry schema) schema))))) (testing "deeply nested vector schemas" (is (= {(s/optional-key :foo) @@ -598,7 +598,7 @@ (let [schema {(s/optional-key :FOO) {:Bar [[{:barDoo s/Str (s/optional-key :barDee) s/Str}]]}}] - (alias-schema (parameter-aliases schema) schema))))) + (alias-schema (registry schema) schema))))) (testing "default schemas" (is (= {:foo-bar s/Str @@ -613,7 +613,7 @@ :Quux [{:Fizz s/Str}]} {:QUU "hi" :Quux []})}] - (alias-schema (parameter-aliases schema) schema)))) + (alias-schema (registry schema) schema)))) (is (= (st/default {:quu s/Str :quux [{:fizz s/Str}]} {:quu "hi" @@ -622,28 +622,28 @@ :Quux [{:Fizz s/Str}]} {:QUU "hi" :Quux []})] - (alias-schema (parameter-aliases schema) schema))))) + (alias-schema (registry schema) schema))))) (testing "named schemas" (is (= (s/named {:foo-bar s/Str} "FooBar") (let [schema (s/named {:fooBar s/Str} "FooBar")] - (alias-schema (parameter-aliases schema) schema))))) + (alias-schema (registry schema) schema))))) (testing "maybe schemas" (is (= {:foo-bar (s/maybe {:baz s/Str})} (let [schema {:fooBar (s/maybe {:Baz s/Str})}] - (alias-schema (parameter-aliases schema) schema)))) + (alias-schema (registry schema) schema)))) (is (= (s/maybe {:foo-bar s/Str}) (let [schema (s/maybe {:fooBar s/Str})] - (alias-schema (parameter-aliases schema) schema))))) + (alias-schema (registry schema) schema))))) (testing "constrained schemas" (is (= {:foo-bar (s/constrained s/Str not-blank?)} (let [schema {:fooBar (s/constrained s/Str not-blank?)}] - (alias-schema (parameter-aliases schema) schema)))) + (alias-schema (registry schema) schema)))) (is (= {:foo-bar (s/constrained {:baz s/Str} some?)} (let [schema {:fooBar (s/constrained {:Baz s/Str} some?)}] - (alias-schema (parameter-aliases schema) schema))))) + (alias-schema (registry schema) schema))))) (testing "both schemas" (is (= (s/both {:foo-bar s/Str @@ -656,7 +656,7 @@ (s/required-key :Baz) s/Str} {:QUU s/Str :Quux [{:Fizz s/Str}]})] - (alias-schema (parameter-aliases schema) schema)))) + (alias-schema (registry schema) schema)))) (is (= {:foo (s/both {:foo-bar s/Str (s/optional-key :bar) s/Str (s/required-key :baz) s/Str} @@ -667,7 +667,7 @@ (s/required-key :Baz) s/Str} {:QUU s/Str :Quux [{:Fizz s/Str}]})}] - (alias-schema (parameter-aliases schema) schema))))) + (alias-schema (registry schema) schema))))) (testing "either schemas" (is (= (s/either {:foo-bar s/Str @@ -680,7 +680,7 @@ (s/required-key :Baz) s/Str} {:QUU s/Str :Quux [{:Fizz s/Str}]})] - (alias-schema (parameter-aliases schema) schema)))) + (alias-schema (registry schema) schema)))) (is (= {:foo (s/either {:foo-bar s/Str (s/optional-key :bar) s/Str (s/required-key :baz) s/Str} @@ -691,7 +691,7 @@ (s/required-key :Baz) s/Str} {:QUU s/Str :Quux [{:Fizz s/Str}]})}] - (alias-schema (parameter-aliases schema) schema))))) + (alias-schema (registry schema) schema))))) ;; TODO: An SCI issue happens for this test case. Unwrap when fixed. #?(:bb nil @@ -699,10 +699,10 @@ (testing "cond-pre schemas" (is (= (s/cond-pre {:foo-bar s/Str} s/Str) (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] - (alias-schema (parameter-aliases schema) schema)))) + (alias-schema (registry schema) schema)))) (is (= {:foo (s/cond-pre {:foo-bar s/Str} s/Str)} (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] - (alias-schema (parameter-aliases schema) schema)))))) + (alias-schema (registry schema) schema)))))) (testing "conditional schemas" (is (= (s/conditional @@ -721,7 +721,7 @@ not-foo-map? {:QUU s/Str :Quux [{:Fizz s/Str}]})] - (alias-schema (parameter-aliases schema) schema)))) + (alias-schema (registry schema) schema)))) (is (= {:foo (s/conditional foo-map? {:foo-bar s/Str @@ -738,22 +738,22 @@ not-foo-map? {:QUU s/Str :Quux [{:Fizz s/Str}]})}] - (alias-schema (parameter-aliases schema) schema))))) + (alias-schema (registry schema) schema))))) (testing "recursive schemas" (is (= {:foo s/Str :bar (s/recursive #'schema-b)} - (alias-schema (parameter-aliases schema-a) schema-a))) + (alias-schema (registry schema-a) schema-a))) (is (= {:baz s/Str :quu (s/recursive #'schema-a)} - (alias-schema (parameter-aliases schema-b) schema-b))))) + (alias-schema (registry schema-b) schema-b))))) (testing "non-keyword keys" (is (= {"foo-bar" s/Str 'bazQuux s/Str} (let [schema {"fooBar" s/Str 'bazQuux s/Str}] - (alias-schema (parameter-aliases schema) schema))) + (alias-schema (registry schema) schema))) "Symbols are excluded for performance purposes, could work as well")) (testing "qualified keys are not renamed" @@ -761,15 +761,15 @@ :Baz/DOO s/Str} (let [schema {:foo/Bar s/Str :Baz/DOO s/Str}] - (alias-schema (parameter-aliases schema) schema))))) + (alias-schema (registry schema) schema))))) (testing "generic keys are not renamed" (is (= {s/Str {:fooBar s/Str}} (let [schema {s/Str {:fooBar s/Str}}] - (alias-schema (parameter-aliases schema) schema)))) + (alias-schema (registry schema) schema)))) (is (= {s/Keyword {:fooBar s/Str}} (let [schema {s/Keyword {:fooBar s/Str}}] - (alias-schema (parameter-aliases schema) schema)))) + (alias-schema (registry schema) schema)))) (is (= (st/any-keys) (let [schema (st/any-keys)] - (alias-schema (parameter-aliases schema) schema)))))) + (alias-schema (registry schema) schema)))))) From afb6984f969414d9b0d34d0d70de76986209ca0e Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Wed, 15 Oct 2025 10:39:04 +0400 Subject: [PATCH 36/37] Re-enable `cond-pre` schemas tests for Babashka --- core/test/martian/parameter_aliases_test.cljc | 69 ++++++++----------- 1 file changed, 30 insertions(+), 39 deletions(-) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index b96bad0c..a458e507 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -219,21 +219,18 @@ :Quux [{:Fizz s/Str}]})}) "Must contain aliases for both the schema and a data described by it")) - ;; TODO: An SCI issue happens for this test case. Unwrap when fixed. - #?(:bb nil - :default - (testing "cond-pre schemas" - (is (=aliases - {[] {:foo-bar :fooBar} - [:schemas] {:foo-bar :fooBar}} - (s/cond-pre {:fooBar s/Str} s/Str)) - "Must contain paths for both the schema and a data described by it") - (is (=aliases - {[] {:foo :FOO} - [:foo] {:foo-bar :fooBar} - [:foo :schemas] {:foo-bar :fooBar}} - {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}) - "Must contain paths for both the schema and a data described by it"))) + (testing "cond-pre schemas" + (is (=aliases + {[] {:foo-bar :fooBar} + [:schemas] {:foo-bar :fooBar}} + (s/cond-pre {:fooBar s/Str} s/Str)) + "Must contain paths for both the schema and a data described by it") + (is (=aliases + {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar} + [:foo :schemas] {:foo-bar :fooBar}} + {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}) + "Must contain paths for both the schema and a data described by it")) (testing "conditional schemas" (is (=aliases @@ -462,20 +459,17 @@ (unalias-data (registry schema) {:foo {:quu "x" :quux [{:fizz "y"}]}}))))) - ;; TODO: An SCI issue happens for this test case. Unwrap when fixed. - #?(:bb nil - :default - (testing "cond-pre schemas" - (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] - (is (= {:fooBar "a"} - (unalias-data (registry schema) {:foo-bar "a"}))) - (is (= "b" - (unalias-data (registry schema) "b")))) - (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] - (is (= {:FOO {:fooBar "a"}} - (unalias-data (registry schema) {:foo {:foo-bar "a"}}))) - (is (= {:FOO "b"} - (unalias-data (registry schema) {:foo "b"})))))) + (testing "cond-pre schemas" + (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] + (is (= {:fooBar "a"} + (unalias-data (registry schema) {:foo-bar "a"}))) + (is (= "b" + (unalias-data (registry schema) "b")))) + (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] + (is (= {:FOO {:fooBar "a"}} + (unalias-data (registry schema) {:foo {:foo-bar "a"}}))) + (is (= {:FOO "b"} + (unalias-data (registry schema) {:foo "b"}))))) (testing "conditional schemas" (let [schema (s/conditional @@ -693,16 +687,13 @@ :Quux [{:Fizz s/Str}]})}] (alias-schema (registry schema) schema))))) - ;; TODO: An SCI issue happens for this test case. Unwrap when fixed. - #?(:bb nil - :default - (testing "cond-pre schemas" - (is (= (s/cond-pre {:foo-bar s/Str} s/Str) - (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] - (alias-schema (registry schema) schema)))) - (is (= {:foo (s/cond-pre {:foo-bar s/Str} s/Str)} - (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] - (alias-schema (registry schema) schema)))))) + (testing "cond-pre schemas" + (is (= (s/cond-pre {:foo-bar s/Str} s/Str) + (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] + (alias-schema (registry schema) schema)))) + (is (= {:foo (s/cond-pre {:foo-bar s/Str} s/Str)} + (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] + (alias-schema (registry schema) schema))))) (testing "conditional schemas" (is (= (s/conditional From b9d6df0f1e0fd81cac63fa4a27528fb0911d4b89 Mon Sep 17 00:00:00 2001 From: Mark Sto Date: Tue, 21 Oct 2025 18:33:13 +0400 Subject: [PATCH 37/37] Add more test coverage for HTTP headers mapping --- core/test/martian/core_test.cljc | 65 ++++++++++++++++++-------------- 1 file changed, 37 insertions(+), 28 deletions(-) diff --git a/core/test/martian/core_test.cljc b/core/test/martian/core_test.cljc index 564f6bef..0cb360ba 100644 --- a/core/test/martian/core_test.cljc +++ b/core/test/martian/core_test.cljc @@ -301,12 +301,12 @@ (let [add-default-headers-interceptor {:name ::add-default-headers :enter (fn [ctx] (update-in ctx [:request :headers] - assoc :x-api-key "ABC123"))} + assoc :X-API-key "ABC123"))} m (martian/bootstrap "https://defaultheaders.com" [{:route-name :get-item :produces ["application/json"] :consumes ["application/json"] - :headers-schema {:x-api-key s/Str} + :headers-schema {:X-API-key s/Str} :path-parts ["/api/" :id] :path-schema {:id s/Str} :method :get}] @@ -314,7 +314,7 @@ (is (= {:method :get :url "https://defaultheaders.com/api/123" - :headers {"x-api-key" "ABC123"}} + :headers {"X-API-key" "ABC123"}} (martian/request-for m :get-item {:id "123"}))))) (deftest any-body-test @@ -396,16 +396,19 @@ (deftest kebab-mapping-test (let [m (martian/bootstrap "https://camels.org" [{:route-name :create-camel - :path-parts ["/camels/" :camelId] - :method :put - :path-schema {:camelId s/Int} - :query-schema {:camelVersion s/Int} - :body-schema {:Camel {:camelName s/Str - :camelTrain {:leaderName s/Str - (s/optional-key :followerCamels) [{:followerName s/Str}]} - :anyCamel s/Any}} - :headers-schema {(s/optional-key :camelToken) s/Str} - :form-schema {:camelHumps (s/maybe s/Int)}}])] + :path-parts ["/camels/" :camelId] + :method :put + :path-schema {:camelId s/Int} + :query-schema {:camelVersion s/Int} + :body-schema {:Camel {:camelName s/Str + :camelTrain {:leaderName s/Str + (s/optional-key :followerCamels) [{:followerName s/Str}]} + :anyCamel s/Any}} + :headers-schema {(s/optional-key "Content-Security-Policy") s/Str + (s/optional-key "WWW-Authenticate") s/Str + (s/optional-key "X-XSS-Protection") s/Str + (s/optional-key :camelToken) s/Str} + :form-schema {:camelHumps (s/maybe s/Int)}}])] (is (= "https://camels.org/camels/1" (martian/url-for m :create-camel {:camel-id 1 @@ -434,17 +437,20 @@ (get-in param-aliases [:body-schema [:camel :camel-train :follower-camels]]))) (is (= {:camel-humps :camelHumps} (get-in param-aliases [:form-schema []]))) - (is (= {:camel-token :camelToken} + (is (= {"content-security-policy" "Content-Security-Policy" + "www-authenticate" "WWW-Authenticate" + "x-xss-protection" "X-XSS-Protection" + :camel-token :camelToken} (get-in param-aliases [:headers-schema []])))) - (is (= {:method :put, - :url "https://camels.org/camels/1", - :query-params {:camelVersion 2}, + (is (= {:method :put + :url "https://camels.org/camels/1" + :query-params {:camelVersion 2} :body {:camelName "kebab" :camelTrain {:leaderName "camel leader" :followerCamels [{:followerName "OCaml"}]} - :anyCamel {:camel-train "choo choo"}}, - :form-params {:camelHumps 2}, + :anyCamel {:camel-train "choo choo"}} + :form-params {:camelHumps 2} :headers {"camelToken" "cAmEl"}} ;; fully destructured @@ -488,16 +494,19 @@ :anyCamel {:camel-train "choo choo"}}}))) (testing "explore shows idiomatic kebab keys" - (is (= {:summary nil, + (is (= {:summary nil :parameters - {:camel-id s/Int, - :camel-version s/Int, - :camel {:camel-name s/Str - :camel-train {:leader-name s/Str - (s/optional-key :follower-camels) [{:follower-name s/Str}]} - :any-camel s/Any}, - :camel-humps (s/maybe s/Int) - (s/optional-key :camel-token) s/Str}, + {:camel-id s/Int + :camel-version s/Int + :camel {:camel-name s/Str + :camel-train {:leader-name s/Str + (s/optional-key :follower-camels) [{:follower-name s/Str}]} + :any-camel s/Any} + :camel-humps (s/maybe s/Int) + (s/optional-key "content-security-policy") s/Str + (s/optional-key "www-authenticate") s/Str + (s/optional-key "x-xss-protection") s/Str + (s/optional-key :camel-token) s/Str} :returns {}} (martian/explore m :create-camel))))))