Skip to content

Commit

Permalink
Merge commit '02d5cc3' into separate-traverse-and-validation
Browse files Browse the repository at this point in the history
  • Loading branch information
@katibov
katibov committed Jan 20, 2023
2 parents 54dc3a8 + 02d5cc3 commit a9b2b87
Show file tree
Hide file tree
Showing 2 changed files with 266 additions and 256 deletions.
205 changes: 205 additions & 0 deletions src/zen/schema.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -150,8 +150,13 @@


(defmethod compile-key :keys [_ _ _] {:when map?})
(defmethod compile-key :key [_ _ _] {:when map?})
(defmethod compile-key :exclusive-keys [_ _ _] {:when map?})
(defmethod compile-key :validation-type [_ _ _] {:when map?})
(defmethod compile-key :require [_ _ _] {:when map?})
(defmethod compile-key :values [_ _ _] {:when map?})
(defmethod compile-key :schema-key [_ _ _] {:when map?})
(defmethod compile-key :keyname-schemas [_ _ _] {:when map?})

(defmethod compile-key :scale [_ _ _] {:when number?})
(defmethod compile-key :precision [_ _ _] {:when number?})
Expand All @@ -162,12 +167,19 @@
(defmethod compile-key :maxLength [_ _ _] {:when string?})
(defmethod compile-key :regex [_ _ _] {:when string?})

(defmethod compile-key :every [_ _ _] {:when #(or (sequential? %) (set? %))})
(defmethod compile-key :minItems [_ _ _] {:when #(or (sequential? %) (set? %))})
(defmethod compile-key :maxItems [_ _ _] {:when #(or (sequential? %) (set? %))})

(defmethod compile-key :nth [_ _ _] {:when sequential?})
(defmethod compile-key :schema-index [_ _ _] {:when sequential?})
(defmethod compile-key :slicing [_ _ _] {:when sequential?})

(defmethod compile-key :subset-of [_ _ _] {:when set?})
(defmethod compile-key :superset-of [_ _ _] {:when set?})

(defmethod compile-key :tags [_ _ _] {:when #(or (symbol? %) (list? %) (string? %))})


(register-compile-key-interpreter!
[:keys ::navigate]
Expand All @@ -188,3 +200,196 @@
(key-rule v opts)
(validation.utils/merge-vtx vtx*)))
(recur (rest data) vtx*)))))))))


(register-compile-key-interpreter!
[:values ::navigate]
(fn [_ ztx sch]
(let [v (get-cached ztx sch false)]
(fn [vtx data opts]
(reduce-kv (fn [vtx* key value]
(let [node-visited?
(when-let [pth (get (:visited vtx*) (validation.utils/cur-path vtx* [key]))]
(:keys (get (:visited-by vtx*) pth)))

strict?
(= (:valmode opts) :strict)]
(if (and (not strict?) node-visited?)
vtx*
(-> (validation.utils/node-vtx&log vtx* [:values] [key])
(v value opts)
(validation.utils/merge-vtx vtx*)))))
vtx
data)))))


(register-compile-key-interpreter!
[:every ::navigate]
(fn [_ ztx sch]
(let [v (get-cached ztx sch false)]
(fn [vtx data opts]
(let [data*
(cond
(seq (:indices opts))
(map vector (:indices opts) data)

(set? data)
(map (fn [set-el] [set-el set-el]) data)

:else
(map-indexed vector data))]
(reduce (fn [vtx [idx item]]
(-> (validation.utils/node-vtx vtx [:every idx] [idx])
(v item (dissoc opts :indices))
(validation.utils/merge-vtx vtx)))
vtx
data*))))))


(register-compile-key-interpreter!
[:confirms ::navigate]
(fn [_ ztx ks]
(let [compile-confirms
(fn [sym]
(if-let [sch (utils/get-symbol ztx sym)]
[sym (:zen/name sch) (get-cached ztx sch false)]
[sym]))

comp-fns
(->> ks
(map compile-confirms)
doall)]
(fn confirms-sch [vtx data opts]
(loop [comp-fns comp-fns
vtx* vtx]
(if (empty? comp-fns)
vtx*
(let [[sym sch-nm v] (first comp-fns)]
(cond
(true? (get-in vtx* [:zen.v2-validation/confirmed (:path vtx*) sch-nm]))
(recur (rest comp-fns) vtx*)

(fn? v)
(recur (rest comp-fns)
(-> (assoc-in vtx* [:zen.v2-validation/confirmed (:path vtx*) sch-nm] true)
(validation.utils/node-vtx [:confirms sch-nm])
(v data opts)
(validation.utils/merge-vtx vtx*)))

:else
(recur (rest comp-fns)
#_"NOTE: This errors mechanism comes from ::validate interpreter. Maybe we should untie it from here."
(validation.utils/add-err vtx* :confirms {:message (str "Could not resolve schema '" sym)}))))))))))


#_"NOTE: Errors mechanism used here comes from ::validate interpreter. Maybe we should untie it from here."
(register-compile-key-interpreter!
[:schema-key ::navigate]
(fn [_ ztx {sk :key sk-ns :ns sk-tags :tags}]
(fn [vtx data opts]
(if-let [sch-nm (get data sk)]
(let [sch-symbol (if sk-ns (symbol sk-ns (name sch-nm)) (symbol sch-nm))
{tags :zen/tags :as sch} (utils/get-symbol ztx sch-symbol)]
(cond
(nil? sch)
(validation.utils/add-err vtx :schema-key
{:message (str "Could not find schema " sch-symbol)
:type "schema"})

(not (contains? tags 'zen/schema))
(validation.utils/add-err vtx :schema-key
{:message (str "'" sch-symbol " should be tagged with zen/schema, but " tags)
:type "schema"})

(and sk-tags (not (clojure.set/subset? sk-tags tags)))
(validation.utils/add-err vtx :schema-key
{:message (str "'" sch-symbol " should be tagged with " sk-tags ", but " tags)
:type "schema"})

:else
(let [v (get-cached ztx sch false)]
(-> (validation.utils/node-vtx vtx [:schema-key sch-symbol])
(v data opts)
(validation.utils/merge-vtx vtx)))))
vtx))))


#_"NOTE: Errors mechanism used here comes from ::validate interpreter. Maybe we should untie it from here."
(register-compile-key-interpreter!
[:schema-index ::navigate]
(fn [_ ztx {si :index si-ns :ns}]
(fn [vtx data opts]
(if-let [sch-nm (or (get data si) (nth data si))]
(let [sch-symbol (if si-ns (symbol si-ns (name sch-nm)) sch-nm)
sch (utils/get-symbol ztx sch-symbol)]
(cond
(nil? sch)
(validation.utils/add-err vtx
:schema-index
{:message (format "Could not find schema %s" sch-symbol)
:type "schema"})

:else
(let [v (get-cached ztx sch false)]
(-> (validation.utils/node-vtx vtx [:schema-index sch-symbol])
(v data opts)
(validation.utils/merge-vtx vtx)))))
vtx))))


(register-compile-key-interpreter!
[:nth ::navigate]
(fn [_ ztx cfg]
(let [schemas (doall
(map (fn [[index v]] [index (get-cached ztx v false)])
cfg))]
(fn [vtx data opts]
(reduce (fn [vtx* [index v]]
(if-let [nth-el (and (< index (count data))
(nth data index))]
(-> (validation.utils/node-vtx vtx* [:nth index] [index])
(v nth-el opts)
(validation.utils/merge-vtx vtx*))
vtx*))
vtx
schemas)))))


(register-compile-key-interpreter!
[:keyname-schemas ::navigate]
(fn [_ ztx {:keys [tags]}]
(fn [vtx data opts]
(let [rule-fn
(fn [vtx* [schema-key data*]]
(if-let [sch (and (qualified-ident? schema-key) (utils/get-symbol ztx (symbol schema-key)))]
;; TODO add test on nil case
(if (or (nil? tags)
(clojure.set/subset? tags (:zen/tags sch)))
(-> (validation.utils/node-vtx&log vtx* [:keyname-schemas schema-key] [schema-key])
((get-cached ztx sch false) data* opts)
(validation.utils/merge-vtx vtx*))
vtx*)
vtx*))]
(reduce rule-fn vtx data)))))


(register-compile-key-interpreter!
[:key ::navigate]
(fn [_ ztx sch]
(let [v (get-cached ztx sch false)]
(fn [vtx data opts]
(reduce (fn [vtx* [k _]]
(let [node-visited?
(when-let [pth (get (:visited vtx*)
(validation.utils/cur-path vtx* [k]))]
(:keys (get (:visited-by vtx*) pth)))

strict?
(= (:valmode opts) :strict)]
(if (and (not strict?) node-visited?)
vtx*
(-> (validation.utils/node-vtx&log vtx* [:key] [k])
(v k opts)
(validation.utils/merge-vtx vtx*)))))
vtx
data)))))
Loading

0 comments on commit a9b2b87

Please sign in to comment.