Make parameter aliases work for all schemas

core/src/martian/parameter_aliases.cljc

@@ -1,20 +1,26 @@
 (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 [key-seqs prewalk-with-path]]))
+            [martian.schema-tools :refer [explicit-key key-seqs prewalk-with-path]]
+            [schema.core :as s]))
 
-;; todo lean on schema-tools.core for some of this
+(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 (and k (s/specific-key? k) (not (and (keyword? k) (namespace k))))
-    (->kebab-case (s/explicit-schema-key k))))
+  (when-some [k' (when k (explicit-key k))]
+    (when (can-be-renamed? k')
+      (->kebab-case k'))))
 
 (defn- idiomatic-path [path]
   (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)]
@@ -26,7 +32,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]
@@ -38,7 +45,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]

core/src/martian/schema_tools.cljc

@@ -1,50 +1,171 @@
 (ns martian.schema-tools
-  (:require [schema.core :as s #?@(:cljs [:refer [MapEntry EqSchema]])]
-            [schema.spec.core :as spec])
-  #?(:clj (:import [schema.core MapEntry EqSchema])))
-
-;; todo
-;; write some tests and lean on schema-tools.core where possible
-
-(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}))
-        (spec/subschemas (s/spec schema))))
+  (:require [schema.core :as s]
+            [schema-tools.impl]))
+
+(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)))
+
+(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]]
+                (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).
+  #?(: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 collection of paths which would address all possible entries (using `get-in`) in data described by the schema"
+  "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)))
-        paths))))
+  (->> (-paths schema [] true)
+       (distinct)
+       (vec)))
+
+;;
 
 (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
-     (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)))