[#38] Refactor :key-schema to ::navigate and ::validate interpreters

zen-lang · Jan 20, 2023 · e98e34d · e98e34d
1 parent a9b2b87
commit e98e34d
Show file tree

Hide file tree

Showing 2 changed files with 63 additions and 37 deletions.
diff --git a/src/zen/schema.clj b/src/zen/schema.clj
@@ -157,6 +157,7 @@
 (defmethod compile-key :values          [_ _ _] {:when map?})
 (defmethod compile-key :schema-key      [_ _ _] {:when map?})
 (defmethod compile-key :keyname-schemas [_ _ _] {:when map?})
+(defmethod compile-key :key-schema      [_ _ _] {:when map?})
 
 (defmethod compile-key :scale     [_ _ _] {:when number?})
 (defmethod compile-key :precision [_ _ _] {:when number?})
@@ -393,3 +394,34 @@
                          (validation.utils/merge-vtx vtx*)))))
                vtx
                data)))))
+
+
+(register-compile-key-interpreter!
+ [:key-schema ::navigate]
+ (fn [_ ztx {:keys [tags key]}]
+   (let [keys-schemas
+         (->> tags
+              (mapcat #(utils/get-tag ztx %))
+              (mapv (fn [sch-name]
+                      (let [sch (utils/get-symbol ztx sch-name)] ;; TODO get rid of type coercion
+                        {:sch-key (if (= "zen" (namespace sch-name))
+                                    (keyword (name sch-name))
+                                    (keyword sch-name))
+                         :for?    (:for sch)
+                         :v       (get-cached ztx sch false)}))))]
+    (fn key-schema-fn [vtx data opts]
+      (let [key-rules
+            (into {}
+                  (keep (fn [{:keys [sch-key for? v]}]
+                          (when (or (nil? for?)
+                                    (contains? for? (get data key)))
+                            [sch-key v])))
+                  keys-schemas)]
+        (reduce (fn [vtx* [k v]]
+                  (if (not (contains? key-rules k))
+                    vtx*
+                    (-> (validation.utils/node-vtx&log vtx* [k] [k])
+                        ((get key-rules k) v opts)
+                        (validation.utils/merge-vtx vtx*))))
+                vtx
+                (seq data)))))))
diff --git a/src/zen/v2_validation.clj b/src/zen/v2_validation.clj
@@ -607,40 +607,34 @@ Probably safe to remove if no one relies on them"
     (fn fail-fn [vtx data opts]
       (add-err vtx :fail {:message err-msg}))))
 
-(defmethod compile-key :key-schema
-  [_ ztx {:keys [tags key]}]
-  {:when map?
-   :rule
-   (fn key-schema-fn [vtx data opts]
-     (let [keys-schemas
-           (->> tags
-                (mapcat #(utils/get-tag ztx %))
-                (mapv (fn [sch-name]
-                        (let [sch (utils/get-symbol ztx sch-name)] ;; TODO get rid of type coercion
-                          {:sch-key (if (= "zen" (namespace sch-name))
-                                      (keyword (name sch-name))
-                                      (keyword sch-name))
-                           :for?    (:for sch)
-                           :v       (get-cached ztx sch false)}))))
-
-           key-rules
-           (into {}
-                 (keep (fn [{:keys [sch-key for? v]}]
-                         (when (or (nil? for?)
-                                   (contains? for? (get data key)))
-                           [sch-key v])))
-                 keys-schemas)]
-
-       (loop [data (seq data)
-              unknown (transient [])
-              vtx* vtx]
-         (if (empty? data)
-           (update vtx* :unknown-keys into (persistent! unknown))
-           (let [[k v] (first data)]
-             (if (not (contains? key-rules k))
-               (recur (rest data) (conj! unknown (conj (:path vtx) k)) vtx*)
-               (recur (rest data)
-                      unknown
-                      (-> (node-vtx&log vtx* [k] [k])
-                          ((get key-rules k) v opts)
-                          (merge-vtx vtx*)))))))))})
+(zen.schema/register-compile-key-interpreter!
+ [:key-schema ::validate]
+ (fn [_ ztx {:keys [tags key]}]
+   (let [keys-schemas
+         (->> tags
+              (mapcat #(utils/get-tag ztx %))
+              (mapv (fn [sch-name]
+                      (let [sch (utils/get-symbol ztx sch-name)] ;; TODO get rid of type coercion
+                        [(if (= "zen" (namespace sch-name))
+                           (keyword (name sch-name))
+                           (keyword sch-name))
+                         (:for sch)]))))]
+    (fn key-schema-fn [vtx data opts]
+      (let [correct-keys
+            (into #{}
+                  (keep (fn [[sch-key for]]
+                          (when (or (nil? for)
+                                    (contains? for (get data key)))
+                            sch-key)))
+                  keys-schemas)
+
+            all-keys
+            (-> data keys set)
+
+            incorrect-keys
+            (set/difference all-keys correct-keys)]
+       (update vtx
+               :unknown-keys
+               into
+               (map #(conj (:path vtx) %))
+               incorrect-keys))))))