Skip to content

Inspectable interceptors #1160

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 14 commits into
base: master
Choose a base branch
from
Draft

Inspectable interceptors #1160

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
14 commits
Select commit Hold shift + click to select a range
1b5f4c4
.
ikitommi Jan 11, 2025
ca5f18b
.
ikitommi Jan 11, 2025
e4b977f
.
ikitommi Jan 11, 2025
8c61b7f
.
ikitommi Jan 11, 2025
f2db311
.
ikitommi Jan 11, 2025
ac1e56d
.
ikitommi Jan 11, 2025
efa5d59
.
ikitommi Jan 11, 2025
67d3f25
.
ikitommi Jan 11, 2025
2a48bab
.
ikitommi Jan 11, 2025
11f23ff
.
ikitommi Jan 11, 2025
550b60f
fix bb
ikitommi Jan 12, 2025
f215011
.
ikitommi Jan 12, 2025
c5ad281
.
ikitommi Jan 12, 2025
7ccc5af
.
ikitommi Jan 12, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions src/malli/core.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -96,6 +96,10 @@
(-distributive-schema? [this])
(-distribute-to-children [this f options]))

(defrecord ^:private Interceptor [enter leave schema name transformer])
(defn -interceptor? [x] (instance? Interceptor x))
(defn -interceptor [m] (map->Interceptor m))

(defn -ref-schema? [x] (#?(:clj instance?, :cljs implements?) malli.core.RefSchema x))
(defn -entry-parser? [x] (#?(:clj instance?, :cljs implements?) malli.core.EntryParser x))
(defn -entry-schema? [x] (#?(:clj instance?, :cljs implements?) malli.core.EntrySchema x))
Expand Down
24 changes: 24 additions & 0 deletions src/malli/dev.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,30 @@
(defn -uncapture-fail! []
(alter-var-root #'m/-fail! (fn [f] (-> f meta ::original (or f)))))

(defn -capture-interceptor
([] (-capture-interceptor nil))
([{:keys [tap] :or {tap tap>}}]
(alter-var-root
#'m/-interceptor
(fn [original] (-> (fn -interceptor [{:keys [schema name transformer] :as interceptor}]
(let [f (fn [f phase]
(fn [input]
(let [output (f input)]
(tap {:schema schema
:name name
:phase phase
:input input
:output output
:transformer transformer})
output)))]
(cond-> (m/map->Interceptor interceptor)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

interesting: Interceptor is private, but map->Interceptor is not

(:enter interceptor) (update :enter f :enter)
(:leave interceptor) (update :leave f :leave))))
(with-meta {::original original}))))))

(defn -uncapture-interceptor []
(alter-var-root #'m/-interceptor (fn [f] (-> f meta ::original (or f)))))

;;
;; Public API
;;
Expand Down
83 changes: 44 additions & 39 deletions src/malli/transform.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,38 +16,39 @@
(defn -interceptor
"Utility function to convert input into an interceptor. Works with functions,
map and sequence of those."
[?interceptor schema options]
[?interceptor schema name transformer options]
(cond

(m/-interceptor? ?interceptor)
?interceptor

(fn? ?interceptor)
{:enter ?interceptor}
(recur {:enter ?interceptor} schema name transformer options)

(and (map? ?interceptor) (contains? ?interceptor :compile))
(let [compiled (::compiled options 0)
options (assoc options ::compiled (inc ^long compiled))]
(when (>= ^long compiled ^long *max-compile-depth*)
(m/-fail! ::too-deep-compilation {:this ?interceptor, :schema schema, :options options}))
(when-let [interceptor (-interceptor ((:compile ?interceptor) schema options) schema options)]
(merge
(dissoc ?interceptor :compile)
interceptor)))
(when-let [interceptor (-interceptor ((:compile ?interceptor) schema options) schema name transformer options)]
(recur (merge (dissoc ?interceptor :compile) interceptor) schema name transformer options)))

(and (map? ?interceptor)
(or (contains? ?interceptor :enter)
(contains? ?interceptor :leave))) ?interceptor
(contains? ?interceptor :leave)))
(-> ?interceptor (assoc :schema schema) (assoc :transformer transformer) (assoc :name name) (m/-interceptor))

(coll? ?interceptor)
(reduce
(fn [{:keys [enter leave]} {new-enter :enter new-leave :leave}]
(let [enter (if (and enter new-enter) #(new-enter (enter %)) (or enter new-enter))
leave (if (and leave new-leave) #(leave (new-leave %)) (or leave new-leave))]
{:enter enter :leave leave}))
(keep #(-interceptor % schema options) ?interceptor))
(-interceptor {:enter enter :leave leave} schema name transformer options)))
(keep #(-interceptor % schema name transformer options) ?interceptor))

(nil? ?interceptor) nil

(ifn? ?interceptor)
{:enter ?interceptor}
(ifn? ?interceptor) (recur {:enter ?interceptor} schema name transformer options)

:else (m/-fail! ::invalid-transformer {:value ?interceptor})))

Expand Down Expand Up @@ -380,56 +381,60 @@
(defn transformer [& ?transformers]
(let [->data (fn [ts default name key] {:transformers ts
:default default
:name name
:keys (when name
(cond-> [[(keyword key) name]]
(not (qualified-keyword? name))
(conj [(keyword key (clojure.core/name name))])))})
->eval (fn [x options] (if (map? x) (reduce-kv (fn [x k v] (assoc x k (m/eval v options))) x x) (m/eval x)))
->chain (m/-comp m/-transformer-chain m/-into-transformer)
chain (->> ?transformers (keep identity) (mapcat #(if (map? %) [%] (->chain %))) (vec))
chain' (->> chain (mapv #(let [name (:name %)]
{:decode (->data (:decoders %) (:default-decoder %) name "decode")
:encode (->data (:encoders %) (:default-encoder %) name "encode")})))]
(when (seq chain)
chain' (->> chain (mapv (fn [{:keys [name decoders encoders default-decoder default-encoder]}]
{:name name
:decode (->data decoders default-decoder name "decode")
:encode (->data encoders default-encoder name "encode")})))]
(when (seq chain')
(reify
m/Transformer
(-transformer-chain [_] chain)
(-value-transformer [_ schema method options]
(-value-transformer [this schema method options]
(reduce
(fn [acc {{:keys [keys default transformers]} method}]
(fn [acc {{:keys [keys name default transformers]} method}]
(let [options (or options (m/options schema))
from (fn [f] #(some-> (get-in (f schema) %) (->eval options)))
from-properties (some-fn (from m/properties) (from m/type-properties))]
(if-let [?interceptor (or (some from-properties keys) (get transformers (m/type schema)) default)]
(let [interceptor (-interceptor ?interceptor schema options)]
(if (nil? acc) interceptor (-interceptor [acc interceptor] schema options)))
(let [interceptor (-interceptor ?interceptor schema name this options)]
(if (nil? acc) interceptor (-interceptor [acc interceptor] schema [(:name acc) name] this options)))
acc))) nil chain'))))))

(defn json-transformer
([] (json-transformer nil))
([{::keys [json-vectors
keywordize-map-keys
map-of-key-decoders] :or {map-of-key-decoders (-string-decoders)}}]
(transformer
{:name :json
:decoders (-> (-json-decoders)
(assoc :map-of {:compile (fn [schema _]
(let [key-schema (some-> schema (m/children) (first))]
(or (some-> key-schema (m/type) map-of-key-decoders
(-interceptor schema {}) (m/-intercepting)
(m/-comp m/-keyword->string)
(-transform-if-valid key-schema)
(-transform-map-keys))
(-transform-map-keys m/-keyword->string))))})
(cond-> keywordize-map-keys
(assoc :map {:compile (fn [schema _]
(let [keyword-keys (->> (mu/keys schema)
(filter keyword?)
(map name)
set)]
(-transform-map-keys keyword-keys -string->keyword)))}))
(cond-> json-vectors (assoc :vector -sequential->vector)))
:encoders (-json-encoders)})))
(let [!this (atom nil)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

what's this hack?

this (transformer
{:name :json
:decoders (-> (-json-decoders)
(assoc :map-of {:compile (fn [schema _]
(let [key-schema (some-> schema (m/children) (first))]
(or (some-> key-schema (m/type) map-of-key-decoders
(-interceptor schema @!this :json nil) (m/-intercepting)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

some sort of recursion trick?

(m/-comp m/-keyword->string)
(-transform-if-valid key-schema)
(-transform-map-keys))
(-transform-map-keys m/-keyword->string))))})
(cond-> keywordize-map-keys
(assoc :map {:compile (fn [schema _]
(let [keyword-keys (->> (mu/keys schema)
(filter keyword?)
(map name)
set)]
(-transform-map-keys keyword-keys -string->keyword)))}))
(cond-> json-vectors (assoc :vector -sequential->vector)))
:encoders (-json-encoders)})]
(reset! !this this))))

(defn string-transformer []
(transformer
Expand Down
8 changes: 4 additions & 4 deletions test/malli/core_test.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3535,10 +3535,10 @@

(deftest catch-infinitely-expanding-schema
(is (thrown-with-msg?
#?(:clj Exception, :cljs js/Error)
#?(:clj #":malli\.core/infinitely-expanding-schema"
:cljs #":malli\.core/invalid-schema")
(m/schema [(m/schema :any)]))))
#?(:clj Exception, :cljs js/Error)
#?(:clj #":malli\.core/infinitely-expanding-schema"
:cljs #":malli\.core/invalid-schema")
(m/schema [(m/schema :any)]))))

(deftest eduction-test
(is (m/validate [:sequential {:min 0} :int] (eduction identity (range 10))))
Expand Down
14 changes: 11 additions & 3 deletions test/malli/transform_test.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,9 +7,16 @@
[malli.transform :as mt])
#?(:clj (:import (java.net URI))))

(defn without-nils [x]
(reduce-kv (fn [acc k v] (cond-> acc v (assoc k v))) {} x))

;; in BB, record don't get all fields populated
(deftest ->interceptor-test
(are [?interceptor expected]
(= expected (is (#'mt/-interceptor ?interceptor {} {})))
(let [i (mt/-interceptor ?interceptor nil nil nil nil)]
(and (= (m/-interceptor? i))
(= (without-nils expected)
(without-nils i))))

inc {:enter inc}
{:enter inc} {:enter inc}
Expand All @@ -21,10 +28,11 @@
(let [?interceptor {:compile (constantly {:compile (constantly inc)})}]
(testing "shallow compilation succeeds"
(binding [mt/*max-compile-depth* 2]
(is (= {:enter inc} (#'mt/-interceptor ?interceptor {} {})))))
(is (= (without-nils (m/-interceptor {:enter inc}))
(without-nils (mt/-interceptor ?interceptor nil nil nil nil))))))
(testing "too deep compilation fails"
(binding [mt/*max-compile-depth* 1]
(is (thrown? #?(:clj Exception, :cljs js/Error) (#'mt/-interceptor ?interceptor {} {})))))))
(is (thrown? #?(:clj Exception, :cljs js/Error) (mt/-interceptor ?interceptor nil nil nil nil)))))))

(deftest string->long
(is (= 1 (mt/-string->long "1")))
Expand Down
Loading