Distributive schemas

CHANGELOG.md

@@ -14,10 +14,14 @@ We use [Break Versioning][breakver]. The version numbers follow a `<major>.<mino
 
 Malli is in well matured [alpha](README.md#alpha).
 
+## NEXT
+
+* 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)

README.md

@@ -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
 

bin/install

@@ -0,0 +1,5 @@
+#!/bin/bash
+
+set -xe
+
+clojure -M:jar && clojure -M:install 

src/malli/core.cljc

@@ -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))
@@ -106,6 +110,11 @@
  (-function-schema-arities [_])
  (-instrument-f [_ _ _ _])
 
+ DistributiveSchema
+ (-distributive-schema? [_] false)
+ (-distribute-to-children [this f options']
+ (throw (ex-info "Not distributive" {:schema this})))
+
  RegexSchema
  (-regex-op? [_] false)
 
@@ -1613,6 +1622,18 @@
  (reify
  AST
  (-to-ast [this _] (-entry-ast this (-entry-keyset entry-parser)))
+ DistributiveSchema
+ (-distributive-schema? [_] true)
+ (-distribute-to-children [this f options']
+ (-into-schema parent
+ properties
+ (mapv (fn [c]
+ (when-not (and (vector? c)
+ (= 2 (count c)))
+ (throw (ex-info "TODO" {})))
+ (update c 1 f options))
+ children)
+ options))
  Schema
  (-validator [_]
  (let [find (finder (reduce-kv (fn [acc k s] (assoc acc k (-validator s))) {} @dispatch-map))]
@@ -2016,6 +2037,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))

src/malli/util.cljc

@@ -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
@@ -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))

test/malli/distributive_test.cljc

@@ -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)))))