Skip to content

Commit

Permalink
Merge pull request #1086 from frenchy64/distributive
Browse files Browse the repository at this point in the history
Distributive schemas
  • Loading branch information
ikitommi authored Aug 27, 2024
2 parents b4ab6d1 + be2c2be commit bd1a08e
Show file tree
Hide file tree
Showing 6 changed files with 264 additions and 3 deletions.
5 changes: 3 additions & 2 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -14,14 +14,15 @@ We use [Break Versioning][breakver]. The version numbers follow a `<major>.<mino

Malli is in well matured [alpha](README.md#alpha).

## Next
## NEXT

* Fix ClojureScript [arithmetic warning](https://github.com/metosin/malli/issues/1093)
* Distribute `:merge` over `:multi` [#1086](https://github.com/metosin/malli/pull/1086), see [documentation](README.md#distributive-schemas)

## 0.16.3 (2024-08-05)

* `:->` added to default registry, see [documentation](https://github.com/metosin/malli/blob/master/docs/function-schemas.md#flat-arrow-function-schemas).
* New `:sequable` and `:every` schemas [#1041](https://github.com/metosin/malli/pull/1041), see [docs](https://github.com/metosin/malli#seqable-schemas)
* New `:seqable` and `:every` schemas [#1041](https://github.com/metosin/malli/pull/1041), see [docs](https://github.com/metosin/malli#seqable-schemas)
* Fix OOM error with infinitely expanding schema [#1069](https://github.com/metosin/malli/pull/1069)
* Correctly form prop-less schemas that have map/nil as first child [#1071](https://github.com/metosin/malli/pull/1071)
* Support min/max on uncountables like eductions [#1075](https://github.com/metosin/malli/pull/1075)
Expand Down
65 changes: 65 additions & 0 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -1767,6 +1767,71 @@ is equivalent to `[:map [:x [:or :string :int]]]`.
; => true
```

### Distributive schemas

`:merge` also distributes over `:multi` in a [similar way](https://en.wikipedia.org/wiki/Distributive_property) to how multiplication
distributes over addition in arithmetic. There are two transformation rules, applied in the following order:

```clojure
;; right-distributive
[:merge [:multi M1 M2 ...] M3]
=>
[:multi [:merge M1 M3] [:merge M2 M3] ...]

;; left-distributive
[:merge M1 [:multi M2 M3 ...]]
=>
[:multi [:merge M1 M2] [:merge M1 M3] ...]
```

For `:merge` with more than two arguments, the rules are applied iteratively left-to-right
as if the following transformation was applied:

```clojure
[:merge M1 M2 M3 M4 ...]
=>
[:merge
[:merge
[:merge M1 M2]
M3]
M4]
...
```

The distributive property of `:multi` is useful combined with `:merge`
if you want all clauses of a `:multi` to share extra entries.

Here are concrete examples of applying the rules:

```clojure
;; left-distributive
(m/deref
[:merge
[:map [:x :int]]
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]]
{:registry registry})
; => [:multi {:dispatch :y}
; [1 [:map [:x :int] [:y [:= 1]]]]
; [2 [:map [:x :int] [:y [:= 2]]]]]

;; right-distributive
(m/deref
[:merge
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]
[:map [:x :int]]]
{:registry registry})
; => [:multi {:dispatch :y}
; [1 [:map [:y [:= 1]] [:x :int]]]
; [2 [:map [:y [:= 2]] [:x :int]]]]
```

It is not recommended to use local registries in schemas that are transformed.
Also be aware that merging non-maps via the distributive property inherits
the same semantics as `:merge`, which is based on [meta-merge](https://github.com/weavejester/meta-merge).

## Persisting schemas

Expand Down
5 changes: 5 additions & 0 deletions bin/install
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
#!/bin/bash

set -xe

clojure -M:jar && clojure -M:install
21 changes: 20 additions & 1 deletion src/malli/core.cljc
Original file line number Diff line number Diff line change
Expand Up @@ -92,6 +92,10 @@
(-function-info [this])
(-instrument-f [schema props f options]))

(defprotocol DistributiveSchema
(-distributive-schema? [this])
(-distribute-to-children [this f options]))

(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 All @@ -106,6 +110,11 @@
(-function-schema-arities [_])
(-instrument-f [_ _ _ _])

DistributiveSchema
(-distributive-schema? [_] false)
(-distribute-to-children [this _ _]
(throw (ex-info "Not distributive" {:schema this})))

RegexSchema
(-regex-op? [_] false)

Expand Down Expand Up @@ -1297,7 +1306,7 @@
:else (let [size (when (and bounded (not (-safely-countable? x)))
bounded)]
(loop [acc acc, i 0, [x & xs :as ne] (seq x)]
(if (and ne (or (not size) (< i #?(:cljs ^number size
(if (and ne (or (not size) (< i #?(:cljs ^number size
:default size))))
(cond-> (or (explainer x (conj in (fin i x)) acc) acc) xs (recur (inc i) xs))
acc)))))))
Expand Down Expand Up @@ -1614,6 +1623,13 @@
(reify
AST
(-to-ast [this _] (-entry-ast this (-entry-keyset entry-parser)))
DistributiveSchema
(-distributive-schema? [_] true)
(-distribute-to-children [this f _]
(-into-schema parent
properties
(mapv (fn [c] (update c 2 f options)) (-children this))
options))
Schema
(-validator [_]
(let [find (finder (reduce-kv (fn [acc k s] (assoc acc k (-validator s))) {} @dispatch-map))]
Expand Down Expand Up @@ -2017,6 +2033,9 @@
(-keep [_])
(-get [_ key default] (if (= ::in key) schema (get children key default)))
(-set [_ key value] (into-schema type properties (assoc children key value)))
DistributiveSchema
(-distributive-schema? [_] (-distributive-schema? schema))
(-distribute-to-children [_ f options] (-distribute-to-children schema f options))
FunctionSchema
(-function-schema? [_] (-function-schema? schema))
(-function-info [_] (-function-info schema))
Expand Down
6 changes: 6 additions & 0 deletions src/malli/util.cljc
Original file line number Diff line number Diff line change
Expand Up @@ -70,6 +70,8 @@
s2 (when ?schema2 (m/deref-all (m/schema ?schema2 options)))
t1 (when s1 (m/type s1))
t2 (when s2 (m/type s2))
can-distribute? (and (not (contains? options :merge-default))
(not (contains? options :merge-required)))
{:keys [merge-default merge-required]
:or {merge-default (fn [_ s2 _] s2)
merge-required (fn [_ r2] r2)}} options
Expand All @@ -80,6 +82,10 @@
(cond
(nil? s1) s2
(nil? s2) s1
;; right-distributive: [:merge [:multi M1 M2 ...] M3] => [:multi [:merge M1 M3] [:merge M2 M3] ...]
(and can-distribute? (m/-distributive-schema? s1)) (m/-distribute-to-children s1 (fn [s _options] (merge s s2 options)) options)
;; left-distributive: [:merge M1 [:multi M2 M3 ...]] => [:multi [:merge M1 M2] [:merge M1 M3] ...]
(and can-distribute? (m/-distributive-schema? s2)) (m/-distribute-to-children s2 (fn [s _options] (merge s1 s options)) options)
(not (and (-> t1 #{:map :and}) (-> t2 #{:map :and}))) (merge-default s1 s2 options)
(not (and (-> t1 (= :map)) (-> t2 (= :map)))) (join (tear t1 s1) (tear t2 s2))
:else (let [p (bear (m/-properties s1) (m/-properties s2))
Expand Down
165 changes: 165 additions & 0 deletions test/malli/distributive_test.cljc
Original file line number Diff line number Diff line change
@@ -0,0 +1,165 @@
(ns malli.distributive-test
(:require [clojure.test :refer [are deftest is testing]]
[malli.core :as m]
[malli.impl.util :as miu]
[malli.generator :as mg]
[malli.registry :as mr]
[malli.transform :as mt]
[malli.util :as mu]))

(def options {:registry (merge (mu/schemas) (m/default-schemas))})

(defn dist [s]
(m/form (m/deref s options)))

(defn valid? [?schema value] (m/validate ?schema value options))

(deftest distributive-multi-test
(is (= (dist
[:merge
[:map [:x :int]]
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]])
[:multi {:dispatch :y}
[1 [:map [:x :int] [:y [:= 1]]]]
[2 [:map [:x :int] [:y [:= 2]]]]]))
(is (= (dist
[:merge
[:map [:x :int]]
[:schema
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]]])
[:multi {:dispatch :y}
[1 [:map [:x :int] [:y [:= 1]]]]
[2 [:map [:x :int] [:y [:= 2]]]]]))
(is (= (dist
[:merge
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]
[:map [:x :int]]])
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]] [:x :int]]]
[2 [:map [:y [:= 2]] [:x :int]]]]))
(is (= (dist
[:merge
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]
[:map [:x :int]]
[:map [:z :int]]])
(dist
[:merge
[:merge
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]
[:map [:x :int]]]
[:map [:z :int]]])
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]] [:x :int] [:z :int]]]
[2 [:map [:y [:= 2]] [:x :int] [:z :int]]]]))
(is (= (dist
[:merge
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]
[:map [:x :int]]
[:map [:z :int]]
[:multi {:dispatch :y}
[3 [:map [:y [:= 3]]]]
[4 [:map [:y [:= 4]]]]]])
(dist
[:merge
[:merge
[:merge
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]
[:map [:x :int]]]
[:map [:z :int]]]
[:multi {:dispatch :y}
[3 [:map [:y [:= 3]]]]
[4 [:map [:y [:= 4]]]]]])
[:multi {:dispatch :y}
[1 [:multi {:dispatch :y}
[3 [:map [:y [:= 3]] [:x :int] [:z :int]]]
[4 [:map [:y [:= 4]] [:x :int] [:z :int]]]]]
[2 [:multi {:dispatch :y}
[3 [:map [:y [:= 3]] [:x :int] [:z :int]]]
[4 [:map [:y [:= 4]] [:x :int] [:z :int]]]]]]))
(is (= (dist
[:merge
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]
[:map [:x :int]]
[:map [:z :int]]
[:multi {:dispatch :a}
[3 [:map [:a [:= 3]]]]
[4 [:map [:a [:= 4]]]]]])
[:multi {:dispatch :y}
[1 [:multi {:dispatch :a}
[3 [:map [:y [:= 1]] [:x :int] [:z :int] [:a [:= 3]]]]
[4 [:map [:y [:= 1]] [:x :int] [:z :int] [:a [:= 4]]]]]]
[2 [:multi {:dispatch :a}
[3 [:map [:y [:= 2]] [:x :int] [:z :int] [:a [:= 3]]]]
[4 [:map [:y [:= 2]] [:x :int] [:z :int] [:a [:= 4]]]]]]]))
(is (= (dist
[:merge
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]
[:multi {:dispatch :y}
[3 [:map [:y [:= 3]]]]
[4 [:map [:y [:= 4]]]]]])
[:multi {:dispatch :y}
[1 [:multi {:dispatch :y}
[3 [:map [:y [:= 3]]]]
[4 [:map [:y [:= 4]]]]]]
[2 [:multi {:dispatch :y}
[3 [:map [:y [:= 3]]]]
[4 [:map [:y [:= 4]]]]]]]))
(is (= (dist
[:merge
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]
[:multi {:dispatch :z}
[3 [:map [:z [:= 3]]]]
[4 [:map [:z [:= 4]]]]]])
[:multi {:dispatch :y}
[1 [:multi {:dispatch :z}
[3 [:map [:y [:= 1]] [:z [:= 3]]]]
[4 [:map [:y [:= 1]] [:z [:= 4]]]]]]
[2 [:multi {:dispatch :z}
[3 [:map [:y [:= 2]] [:z [:= 3]]]]
[4 [:map [:y [:= 2]] [:z [:= 4]]]]]]])))

(deftest parse-distributive-multi-test
(is (= [1 [3 {:y 1, :z 3}]]
(m/parse
[:merge
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]
[:multi {:dispatch :z}
[3 [:map [:z [:= 3]]]]
[4 [:map [:z [:= 4]]]]]]
{:y 1 :z 3}
options))))

(deftest gen-distributive-multi-test
(is (= [{:y 1, :z 3} {:y 2, :z 4} {:y 2, :z 3} {:y 2, :z 3} {:y 1, :z 4}
{:y 1, :z 3} {:y 1, :z 3} {:y 1, :z 3} {:y 1, :z 3} {:y 2, :z 4}]
(mg/sample
[:merge
[:multi {:dispatch :y}
[1 [:map [:y [:= 1]]]]
[2 [:map [:y [:= 2]]]]]
[:multi {:dispatch :z}
[3 [:map [:z [:= 3]]]]
[4 [:map [:z [:= 4]]]]]]
(assoc options :seed 0)))))

0 comments on commit bd1a08e

Please sign in to comment.