Skip to content

Commit cc95c58

Browse files
mattiuusitalomattiuusitalo
authored
Merge pull request #1234 from frenchy64/parser-info-cycle-detection
Correctly handle recursive schemas in -parser-info
2 parents 92a1504 + 2c1878b commit cc95c58

File tree

4 files changed

+181
-51
lines changed

4 files changed

+181
-51
lines changed

‎CHANGELOG.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ Malli is in well matured [alpha](README.md#alpha).
1717
## UNRELEASED
1818

1919
* Robust `:and` parser, add `:andn` [#1182](https://github.com/metosin/malli/pull/1182)
20+
* Correctly handle recursive schemas [#1234](https://github.com/metosin/malli/pull/1234)
2021

2122
## 0.19.2 (2025-10-06)
2223

‎src/malli/core.cljc‎

Lines changed: 77 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -97,7 +97,7 @@
9797
(-distribute-to-children [this f options]))
9898

9999
(defprotocol ParserInfo
100-
(-parser-info [this]))
100+
(-parser-info [this opts]))
101101

102102
(defn -ref-schema? [x] (#?(:clj instance?, :cljs implements?) malli.core.RefSchema x))
103103
(defn -entry-parser? [x] (#?(:clj instance?, :cljs implements?) malli.core.EntryParser x))
@@ -119,9 +119,9 @@
119119
(throw (ex-info "Not distributive" {:schema this})))
120120

121121
ParserInfo
122-
(-parser-info [this]
122+
(-parser-info [this opts]
123123
(when (-ref-schema? this)
124-
(-parser-info (-deref this))))
124+
(-parser-info (-deref this) opts)))
125125

126126
RegexSchema
127127
(-regex-op? [_] false)
@@ -344,10 +344,20 @@
344344

345345
(defn -create-cache [_options] (atom {}))
346346

347+
(defn -lookup-or-update-cache [c k f]
348+
(or (@c k)
349+
(let [r (f)]
350+
(swap! c assoc k r)
351+
r)))
352+
347353
(defn -cached [s k f]
348354
(if (-cached? s)
355+
;; inlined (-lookup-or-update-cache (-cache s) k #(f s)) to avoid extra thunk
349356
(let [c (-cache s)]
350-
(or (@c k) ((swap! c assoc k (f s)) k)))
357+
(or (@c k)
358+
(let [r (f s)]
359+
(swap! c assoc k r)
360+
r)))
351361
(f s)))
352362

353363
;;
@@ -787,7 +797,7 @@
787797
(-get [_ _ default] default)
788798
(-set [this key _] (-fail! ::non-associative-schema {:schema this, :key key}))
789799
ParserInfo
790-
(-parser-info [_] {:simple-parser true})
800+
(-parser-info [_ _] {:simple-parser true})
791801
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))])))))
792802
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))])))))
793803

@@ -817,22 +827,30 @@
817827
(let [children (-vmap #(schema % options) children)
818828
form (delay (-simple-form parent properties children -form options))
819829
cache (-create-cache options)
820-
transforming-parser (delay
821-
(let [transforming-parsers (or (when-some [[_ i] (find properties :parse/transforming-child)]
822-
(cond
823-
(= :none i) []
824-
(and (nat-int? i) (< i (count children))) [i]
825-
:else (-fail! ::and-schema-invalid-parse-property {:schema @form})))
826-
(into []
827-
(keep-indexed
828-
(fn [i c]
829-
(when-not (-> c -parser-info :simple-parser)
830-
i)))
831-
children))]
832-
(when (next transforming-parsers)
833-
(-fail! ::and-schema-multiple-transforming-parsers {:schema @form}))
834-
(peek transforming-parsers)))
835-
->parsers (fn [f] (into [] (map-indexed (fn [i c] (if (= @transforming-parser i) (f c) (-simple-parser c)))) children))]
830+
->transforming-parser-idx (fn [opts]
831+
(let [transforming-parsers (or (when-some [[_ i] (find properties :parse/transforming-child)]
832+
(cond
833+
(= :none i) []
834+
(and (nat-int? i) (< i (count children))) [i]
835+
:else (-fail! ::and-schema-invalid-parse-property {:schema @form})))
836+
(into []
837+
(keep-indexed
838+
(fn [i c]
839+
(when-not (-> c (-parser-info opts) :simple-parser)
840+
i)))
841+
children))]
842+
(when (next transforming-parsers)
843+
(-fail! ::and-schema-multiple-transforming-parsers {:schema @form}))
844+
(peek transforming-parsers)))
845+
cached-transforming-parser-idx (delay (-lookup-or-update-cache cache ::transforming-parser-idx #(->transforming-parser-idx nil)))
846+
->parsers (fn [f]
847+
(let [transforming-parser-idx @cached-transforming-parser-idx]
848+
(into [] (map-indexed
849+
(fn [i c]
850+
(if (= i transforming-parser-idx)
851+
(f c)
852+
(-simple-parser c))))
853+
children)))]
836854
^{:type ::schema}
837855
(reify
838856
Schema
@@ -843,7 +861,7 @@
843861
(fn explain [x in acc] (reduce (fn [acc' explainer] (explainer x in acc')) acc explainers))))
844862
(-parser [this]
845863
;; non-iteratively parse x left-to-right. return result of transforming parser, or x.
846-
(let [pi @transforming-parser
864+
(let [pi @cached-transforming-parser-idx
847865
parsers (->parsers -parser)
848866
nchildren (count children)]
849867
(fn [x]
@@ -858,7 +876,7 @@
858876
(-unparser [this]
859877
;; unparse x' with transforming parser (if any), then non-iteratively unparse x with remaining parsers, left-to-right
860878
;; return x if all results are equal.
861-
(let [pi @transforming-parser
879+
(let [pi @cached-transforming-parser-idx
862880
unparsers (->parsers -unparser)
863881
unparser (get unparsers pi identity)
864882
nchildren (count children)]
@@ -887,9 +905,9 @@
887905
(-get [_ key default] (get children key default))
888906
(-set [this key value] (-set-assoc-children this key value))
889907
ParserInfo
890-
(-parser-info [_] (if-some [i @transforming-parser]
891-
(-parser-info (nth children i))
892-
{:simple-parser true}))
908+
(-parser-info [_ opts] (if-some [i (->transforming-parser-idx opts)]
909+
(-parser-info (nth children i) opts)
910+
{:simple-parser true}))
893911
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
894912
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))])))
895913

@@ -1012,7 +1030,7 @@
10121030
(-get [_ key default] (get children key default))
10131031
(-set [this key value] (-set-assoc-children this key value))
10141032
ParserInfo
1015-
(-parser-info [_] {:simple-parser (every? (-comp :simple-parser -parser-info) children)})
1033+
(-parser-info [_ opts] {:simple-parser (every? (-comp :simple-parser #(-parser-info % opts)) children)})
10161034
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
10171035
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))])))
10181036

@@ -1121,7 +1139,7 @@
11211139
(-get [_ key default] (get children key default))
11221140
(-set [this key value] (-set-assoc-children this key value))
11231141
ParserInfo
1124-
(-parser-info [_] {:simple-parser true})
1142+
(-parser-info [_ _] {:simple-parser true})
11251143
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
11261144
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))])))
11271145

@@ -1197,6 +1215,7 @@
11971215
cache (-create-cache options)
11981216
default-schema (delay (some-> entry-parser (-entry-children) (-default-entry-schema) (schema options)))
11991217
explicit-children (delay (cond->> (-entry-children entry-parser) @default-schema (remove -default-entry)))
1218+
simple-default-parser? (fn [opts] (-> @default-schema (-parser-info opts) :simple-parser boolean))
12001219
->parser (fn [this f]
12011220
(let [keyset (-entry-keyset (-entry-parser this))
12021221
default-parser (some-> @default-schema (f))
@@ -1215,7 +1234,7 @@
12151234
(if optional m (reduced ::invalid))))))
12161235
@explicit-children)
12171236
default-parser
1218-
(cons (let [simple (-> @default-schema -parser-info :simple-parser boolean)]
1237+
(cons (let [simple (-lookup-or-update-cache cache ::simple-default-parser? #(simple-default-parser? nil))]
12191238
(fn [m]
12201239
(let [m' (default-parser
12211240
(reduce (fn [acc k] (dissoc acc k)) m (keys keyset)))]
@@ -1319,7 +1338,7 @@
13191338
(-get [this key default] (-get-entries this key default))
13201339
(-set [this key value] (-set-entries this key value))
13211340
ParserInfo
1322-
(-parser-info [_] {:simple-parser (every? (-comp :simple-parser -parser-info peek) (-entry-children entry-parser))})
1341+
(-parser-info [_ opts] {:simple-parser (every? #(-> % peek (-parser-info opts) :simple-parser) (-entry-children entry-parser))})
13231342
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
13241343
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))]))))
13251344

@@ -1343,10 +1362,10 @@
13431362
form (delay (-simple-form parent properties children -form options))
13441363
cache (-create-cache options)
13451364
validate-limits (-validate-limits min max)
1346-
simple-parser (delay (every? (-comp :simple-parser -parser-info) children))
1365+
simple-parser? (fn [opts] (every? (-comp :simple-parser #(-parser-info % opts)) children))
13471366
->parser (fn [f] (let [key-parser (f key-schema)
13481367
value-parser (f value-schema)
1349-
simple @simple-parser]
1368+
simple (-lookup-or-update-cache cache ::simple-parser? #(simple-parser? nil))]
13501369
(fn [x]
13511370
(if (map? x)
13521371
(reduce-kv (fn [acc k v]
@@ -1415,7 +1434,7 @@
14151434
(-get [_ key default] (get children key default))
14161435
(-set [this key value] (-set-assoc-children this key value))
14171436
ParserInfo
1418-
(-parser-info [_] {:simple-parser @simple-parser})
1437+
(-parser-info [_ opts] {:simple-parser (simple-parser? opts)})
14191438
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
14201439
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))]))))
14211440

@@ -1464,8 +1483,11 @@
14641483
validate-limits (if bounded
14651484
(-validate-bounded-limits (c/min bounded (or max bounded)) min max)
14661485
(-validate-limits min max))
1486+
simple-parser? (fn [opts]
1487+
(or (boolean bounded)
1488+
(-> schema (-parser-info opts) :simple-parser boolean)))
14671489
->parser (fn [f g] (let [child-parser (f schema)
1468-
simple (-> schema -parser-info :simple-parser boolean)]
1490+
simple (-lookup-or-update-cache cache ::simple-parser? #(simple-parser? nil))]
14691491
(fn [x]
14701492
(cond
14711493
(not (fpred x)) ::invalid
@@ -1544,8 +1566,7 @@
15441566
(-get [_ _ _] schema)
15451567
(-set [this _ value] (-set-children this [value]))
15461568
ParserInfo
1547-
(-parser-info [_] (cond-> (-parser-info schema)
1548-
bounded (assoc :simple-parser true)))
1569+
(-parser-info [_ opts] {:simple-parser (simple-parser? opts)})
15491570
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))))
15501571
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))]))))
15511572

@@ -1621,7 +1642,7 @@
16211642
(-get [_ key default] (get children key default))
16221643
(-set [this key value] (-set-assoc-children this key value))
16231644
ParserInfo
1624-
(-parser-info [_] {:simple-parser (every? (-comp :simple-parser -parser-info) children)})
1645+
(-parser-info [_ opts] {:simple-parser (every? #(-> % (-parser-info opts) :simple-parser) children)})
16251646
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
16261647
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))]))))
16271648

@@ -1668,7 +1689,7 @@
16681689
(-get [_ key default] (get children key default))
16691690
(-set [this key value] (-set-assoc-children this key value))
16701691
ParserInfo
1671-
(-parser-info [_] {:simple-parser true})
1692+
(-parser-info [_ _] {:simple-parser true})
16721693
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
16731694
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))])))
16741695

@@ -1722,7 +1743,7 @@
17221743
(-get [_ key default] (get children key default))
17231744
(-set [this key value] (-set-assoc-children this key value))
17241745
ParserInfo
1725-
(-parser-info [_] {:simple-parser true})
1746+
(-parser-info [_ _] {:simple-parser true})
17261747
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
17271748
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))])))
17281749

@@ -1771,7 +1792,7 @@
17711792
(-get [_ key default] (get children key default))
17721793
(-set [this key value] (-set-assoc-children this key value))
17731794
ParserInfo
1774-
(-parser-info [_] {:simple-parser true})
1795+
(-parser-info [_ _] {:simple-parser true})
17751796
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
17761797
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))])))
17771798

@@ -1822,7 +1843,7 @@
18221843
(-set-children this [value])
18231844
(-fail! ::index-out-of-bounds {:schema this, :key key})))
18241845
ParserInfo
1825-
(-parser-info [_] (-parser-info schema))
1846+
(-parser-info [_ opts] (-parser-info schema opts))
18261847
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
18271848
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))])))
18281849

@@ -1905,6 +1926,12 @@
19051926
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
19061927
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))]))))
19071928

1929+
;; returns an identifier for the :ref schema in the context of its dynamic scope.
1930+
;; useful for detecting cycles.
1931+
(defn -identify-ref-schema [schema]
1932+
{:scope (-> schema -options -registry mr/-schemas)
1933+
:name (-ref schema)})
1934+
19081935
(defn -ref-schema
19091936
([]
19101937
(-ref-schema nil))
@@ -1977,6 +2004,13 @@
19772004
(-regex-unparser [this] (-fail! ::potentially-recursive-seqex this))
19782005
(-regex-transformer [this _ _ _] (-fail! ::potentially-recursive-seqex this))
19792006
(-regex-min-max [this _] (-fail! ::potentially-recursive-seqex this))
2007+
ParserInfo
2008+
(-parser-info [this opts]
2009+
(let [cycles (::parser-info-cycles opts #{})
2010+
ref-id (-identify-ref-schema this)]
2011+
(if (cycles ref-id)
2012+
{:simple-parser true}
2013+
(-parser-info (-deref this) (assoc opts ::parser-info-cycles (conj cycles ref-id))))))
19802014
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
19812015
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))]))))
19822016

@@ -2159,7 +2193,7 @@
21592193
(-get [_ key default] (get children key default))
21602194
(-set [this key value] (-set-assoc-children this key value))
21612195
ParserInfo
2162-
(-parser-info [_] {:simple-parser true})
2196+
(-parser-info [_ _] {:simple-parser true})
21632197
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
21642198
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))])))
21652199

@@ -2233,7 +2267,7 @@
22332267
(-get [_ key default] (get children key default))
22342268
(-set [this key value] (-set-assoc-children this key value))
22352269
ParserInfo
2236-
(-parser-info [_] {:simple-parser true})
2270+
(-parser-info [_ _] {:simple-parser true})
22372271
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-schema this writer opts))]))))
22382272
#?@(:cljs [IPrintWithWriter (-pr-writer [this writer opts] (pr-writer-into-schema this writer opts))])))
22392273

‎src/malli/generator.cljc‎

Lines changed: 1 addition & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -295,12 +295,8 @@
295295
;; ;; (1)
296296
;; [:or [:ref ::a] [:ref ::b]]]]
297297

298-
(defn- -identify-ref-schema [schema]
299-
{:scope (-> schema m/-options m/-registry mr/-schemas)
300-
:name (m/-ref schema)})
301-
302298
(defn -ref-gen [schema options]
303-
(let [ref-id (-identify-ref-schema schema)]
299+
(let [ref-id (m/-identify-ref-schema schema)]
304300
(or (force (get-in options [::rec-gen ref-id]))
305301
(let [scalar-ref-gen (delay (-never-gen options))
306302
dschema (m/deref schema)]

0 commit comments

Comments
 (0)