diff --git a/.clj-kondo/config.edn b/.clj-kondo/config.edn new file mode 100644 index 0000000..24226ab --- /dev/null +++ b/.clj-kondo/config.edn @@ -0,0 +1,2 @@ +{:skip-comments true + :output {:exclude-files ["cljs-test-runner-out"]}} diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index c1e0cb1..a742b96 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -39,6 +39,17 @@ jobs: clojure -X:test:malli-${{ matrix.malli }} ;; esac + Lint: + runs-on: ubuntu-latest + steps: + - name: Check out repository code + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + - name: Install clj-kondo + uses: DeLaGuardo/setup-clojure@4c7a6f613e5089821bb3bb2a33a3ee115578580d # 13.6.1 + with: + clj-kondo: latest + - name: Run clj-kondo + run: clj-kondo --lint . Test-cljs: runs-on: ubuntu-latest steps: diff --git a/CHANGELOG.md b/CHANGELOG.md index 6f86f1a..fa38857 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,11 @@ ### Added +- `prune-optionals`: standalone pruning of any schema — removes every optional subtree + that contains no required attribute. Takes an optional keep-selection + (positional, selection notation): mentioned entries are kept but stay + optional. For `:multi` schemas, mentioning branches keeps only those + branches. See the README's "Pruning" section. - `select-only`: explicit alternative to `^:only` metadata / `{:prune-optionals true}`; forces pruning (also when the caller passes `:prune-optionals false`). diff --git a/README.md b/README.md index f963fa5..2ff7283 100644 --- a/README.md +++ b/README.md @@ -162,6 +162,54 @@ Limitations: - A function-valued `:dispatch` disables the dispatch-key auto-require. +## Pruning + +`select-only` needs schema and selection at hand. When a schema already *is* +a selection — or is hand-written with optional keys — use `prune-optionals`: it removes +every optional subtree that contains no required attribute. + +``` clojure +user=> (def Selected + (ms/select [:map + [:name string?] + [:age pos-int?] + [:addresses [:vector [:map + [:street string?] + [:zip string?]]]]] + [:name])) + +user=> (p (ms/prune-optionals Selected)) +[:map [:name string?]] + +;; the second argument is a *keep*-selection: it reuses the selection +;; notation, but mentioned entries are KEPT, not required - they stay optional: +user=> (p (ms/prune-optionals Selected [{:addresses []}])) +[:map + [:name string?] + [:addresses {:optional true} [:vector :map]]] + +user=> (p (ms/prune-optionals Selected [{:addresses [:street]}])) +[:map + [:name string?] + [:addresses {:optional true} + [:vector [:map [:street {:optional true} string?]]]]] + +;; multi-schemas: mentioning one or more branches keeps only those branches, +;; mentioning none keeps all. (Without this rule a pruned Animal would keep +;; generating bare `{:type :sized}` samples.) +user=> (p (ms/prune-optionals Animal {:human []})) +[:multi {:dispatch :type} + [:human [:map [:type :keyword] [:name string?] [:age pos-int?]]]] +``` + +Optional entries whose subtree contains a required attribute survive a prune — +e.g. hand-written `[:addresses {:optional true} [:map [:street :string]]]` +keeps `:addresses` (and its required `:street`). + +Related: `(ms/select-only S sel)` ≡ `(ms/prune-optionals (ms/select S sel) sel)` — the +same selection acts as require-spec, then keep-spec. + + ## LICENSE Copyright (c) 2026 Gert Goet, ThinkCreate. diff --git a/src/malli_select/core.cljc b/src/malli_select/core.cljc index 8d363cd..8578286 100644 --- a/src/malli_select/core.cljc +++ b/src/malli_select/core.cljc @@ -65,6 +65,21 @@ {::m/walk-schema-refs true ::m/walk-refs true}) @!acc)) +(defn- multi-dispatch-paths + "Map of raw path → dispatch key, for every `:multi` in `schema` with a + keyword `:dispatch`." + [schema] + (let [!acc (atom {})] + (m/walk schema + (fn [s path _ _] + (when (= :multi (m/type s)) + (let [dispatch (:dispatch (m/properties s))] + (when (keyword? dispatch) + (swap! !acc assoc path dispatch)))) + s) + {::m/walk-schema-refs true ::m/walk-refs true}) + @!acc)) + (defn- schema-path-walker "Walker that fires `map-f` at `:map` nodes and `multi-f` at `:multi` nodes. `multi-f` also receives the original (pre-walk) schema." @@ -217,7 +232,7 @@ (defn- -select [schema selection {:as options - ::keys [optionalized] + ::keys [optionalized keep-only] :keys [verify-selection prune-optionals] :or {verify-selection *verify-selection*}}] @@ -255,6 +270,8 @@ (when prune-optionals (let [self&parent-paths (take (inc (count path)) (iterate pop path))] (swap! !prune-exclusions into self&parent-paths)))) + multi-dispatches (when keep-only (multi-dispatch-paths schema)) + !required-below (atom #{}) walker (let [optionalize-step (fn optionalize-step [v] (update v 0 mu/optional-keys)) @@ -266,24 +283,48 @@ (let [star? (some #{'*} to-require)] (record-seen! schema cleaned-path to-require) (record-prune-exclusions! path) - (update v 0 - #(if star? - (mu/required-keys %) - (mu/required-keys % to-require))))))) + (if keep-only + ;; keep, don't require: protect the mentioned + ;; keys themselves (they stay optional). + (let [ks (if star? + (map first (m/entries schema)) + (remove #{'?} to-require))] + (swap! !prune-exclusions into (map (partial conj path) ks)) + v) + (update v 0 + #(if star? + (mu/required-keys %) + (mu/required-keys % to-require)))))))) prune-step (fn prune-step [[schema path :as v]] - (let [prunable? (every-pred (comp :optional second) - (comp not @!prune-exclusions #(conj path %) first)) + (let [prunable? (cond-> (every-pred (comp :optional second) + (comp not @!prune-exclusions #(conj path %) first)) + ;; standalone prune: keep optional entries + ;; whose subtree has a required attribute. + keep-only + (every-pred (comp not @!required-below #(conj path %) first))) children (remove prunable? (m/children schema))] (update v 0 #(m/into-schema (m/type %) (m/-properties %) children (m/-options %))))) + ;; bottom-up: mark this map (and its ancestors) when it has a + ;; required entry. The dispatch key of a `:multi` branch doesn't + ;; count: it is required in any well-formed branch. + required-record-step + (fn required-record-step [[schema path :as v]] + (let [dispatch (when (seq path) (get multi-dispatches (pop path)))] + (when (some (fn [[k props _]] + (and (not (:optional props)) (not= k dispatch))) + (m/children schema)) + (swap! !required-below into (take (inc (count path)) (iterate pop path))))) + v) wrap (fn [stack step] #(step (stack %))) middlewares (cond-> identity - (not optionalized) (wrap optionalize-step) - (not all-optional?) (wrap require-step) - prune-optionals (wrap prune-step) - :finally (wrap first)) + (not (or optionalized keep-only)) (wrap optionalize-step) + (not all-optional?) (wrap require-step) + prune-optionals (wrap prune-step) + keep-only (wrap required-record-step) + :finally (wrap first)) ;; a `'?` selection at a :multi ({:pet {}}, [{:pet []}]) mentions ;; the multi: mark it seen and protect it from pruning. @@ -389,7 +430,7 @@ - `:log` - print a warning (stderr on Clojure, `console.warn` on ClojureScript) and continue. - a function - called with `{:paths ... :available ...}`, result ignored, selection continues. - `:skip`, `false`, `nil` - don't verify. - - `prune-optionals` (`false` (default), `true`) - whether all fully optional subtrees should be removed from the resulting schema. Alternatively via metadata of selection: `^:only [:name]` (flag takes precedence over metadata). See also `select-only`, which forces this option. + - `prune-optionals` (`false` (default), `true`) - whether all fully optional subtrees should be removed from the resulting schema. Alternatively via metadata of selection: `^:only [:name]` (flag takes precedence over metadata). See also `select-only`, which forces this option, and `prune-optionals`, for pruning an existing schema without selecting. Typically used when the selected schema is used for data generation. Examples: @@ -432,6 +473,45 @@ (select schema selection (assoc options :prune-optionals true)))) +(defn prune-optionals + "Remove every optional subtree of `schema` that contains no required + attribute. Required entries, and optional entries whose subtree contains + a required attribute, always stay. Typically used to generate samples + without optional noise from a schema that already is a selection. + + NOTE: `keep-selection` uses the selection notation of `select`, but it + means KEEP, not require: `(prune-optionals S [:a])` does *not* prune `:a`, + and kept entries stay optional. + + For `:multi` schemas the branch rule *subtracts*: mentioning one or more + branches keeps only those branches; mentioning none keeps all. (A keyword + `:dispatch` key stays required in every kept explicit map-branch.) + + `options` are those of `select`: `:verify-selection` applies to the + keep-selection; `:prune-optionals` is implied. + + Examples: + ``` + (prune-optionals Selected) ;; only the required spine stays + (prune-optionals Selected [{:addresses []}]) ;; also keep :addresses as empty optional map + (prune-optionals Selected [{:addresses [:street]}]) ;; keep :addresses with an OPTIONAL :street + (prune-optionals Animal {:human []}) ;; keep only branch :human + ``` + Related: `(select-only S sel)` ≡ `(prune-optionals (select S sel) sel)` — + the same selection acts as require-spec, then keep-spec." + ([schema] + (prune-optionals schema [] nil)) + ([schema keep-selection] + (prune-optionals schema keep-selection nil)) + ([schema keep-selection {:as options + :keys [verify-selection] + :or {verify-selection *verify-selection*}}] + (-select schema keep-selection (assoc options + :verify-selection verify-selection + :prune-optionals true + ::keep-only true)))) + + (defn selector "Yields a function similar to `(partial ms/select schema)`. A selector is faster when doing multiple selections from a schema as the schema is optionalized once. diff --git a/test/malli_select/core_test.cljc b/test/malli_select/core_test.cljc index ce3193e..a786c33 100644 --- a/test/malli_select/core_test.cljc +++ b/test/malli_select/core_test.cljc @@ -5,7 +5,7 @@ (:require [clojure.pprint :refer [pprint]] [clojure.test :as t :refer [deftest is testing]] - [malli-select.core :as sut :refer [select select-only selector]] + [malli-select.core :as sut :refer [prune-optionals select select-only selector]] [malli.core :as m] [malli.generator :as mg])) @@ -248,38 +248,42 @@ "All but :name optional"))) (deftest multi-select-test - (testing "branch selections" - (binding [*schema* [:multi {:dispatch :type} - [:foo [:map [:f :string] [:fo :string]]] - [:bar [:map [:b :string] [:ba :string]]] - [::m/default [:map [:d :string] [:de :string]]]]] - (expect-selection-to-validate {} - {} - "everything (in default-branch) is optional") - (expect-selection-to-validate [] - {} - "everything (in default-branch) is optional") - (expect-selection-to-validate {:foo [:f]} - {} - "only the foo-branch has required atts") - (expect-selection-to-invalidate {:foo [:f]} - {:type :foo} - "foo-branch requires :f") - (expect-selection-to-validate {:foo [:f]} - {:type :foo :f ""} - "foo-branch requires only f") - (expect-selection-to-validate {:foo ['*]} - {:type :foo :f "" :fo ""} - "whole foo-branch required") - (expect-selection-to-invalidate {:foo ['*]} + (let [S [:multi {:dispatch :type} + [:foo [:map [:f :string] [:fo :string]]] + [:bar [:map [:b :string] [:ba :string]]] + [::m/default [:map [:d :string] [:de :string]]]]] + (testing "branch selections" + (binding [*schema* S] + (expect-selection-to-validate {} + {} + "everything (in default-branch) is optional") + (expect-selection-to-validate [] + {} + "everything (in default-branch) is optional") + (expect-selection-to-validate {:foo [:f]} + {} + "only the foo-branch has required atts") + (expect-selection-to-invalidate {:foo [:f]} + {:type :foo} + "foo-branch requires :f") + (expect-selection-to-validate {:foo [:f]} {:type :foo :f ""} + "foo-branch requires only f") + (expect-selection-to-validate {:foo ['*]} + {:type :foo :f "" :fo ""} "whole foo-branch required") - (expect-selection-to-invalidate {::m/default [:d]} - {} - "default-branch requires :d") - (expect-selection-to-validate {::m/default [:d]} - {:d ""} - "default-branch requires :d"))) + (expect-selection-to-invalidate {:foo ['*]} + {:type :foo :f ""} + "whole foo-branch required") + (expect-selection-to-invalidate {::m/default [:d]} + {} + "default-branch requires :d") + (expect-selection-to-validate {::m/default [:d]} + {:d ""} + "default-branch requires :d")) + (testing "wrapped" + (binding [*schema* [:maybe S]] + (expect-selection-to-validate {:foo [:f]}))))) (testing "dispatch key stays required" (binding [*schema* [:multi {:dispatch :type} @@ -313,7 +317,6 @@ ":name required where it exists") (is (true? (m/validate s {:type :sized})) ":name is a no-op for branches lacking it"))) - (testing "selection shape must mirror schema shape" (let [ex-data (try (select *schema* [:name]) @@ -407,6 +410,102 @@ (let [s (select-only Person [:name {:addresses [:street]}])] (is (every? (partial m/validate s) (mg/sample s))))))) +(defn- normalized-form + "`m/form` with the entries of every `:map` sorted by key. + `select-only` re-appends a pruned dispatch key while `prune-optionals` leaves it in + place, so equivalence of the two holds up to map-entry order." + [schema] + (letfn [(norm [form] + (if (vector? form) + (let [form (mapv norm form)] + (if (= :map (first form)) + (let [[head entries] (split-with (complement vector?) form)] + (into (vec head) (sort-by first (vec entries)))) + form)) + form))] + (norm (m/form schema)))) + +(deftest prune-optionals-test + (let [Person [:map + [:name :string] + [:age {:optional true} :int] + [:addresses {:optional true} + [:vector [:map + [:street :string] + [:zip {:optional true} :int]]]]] + Loose [:map + [:name :string] + [:addresses {:optional true} + [:vector [:map + [:street {:optional true} :string] + [:zip {:optional true} :int]]]]] + Animal [:multi {:dispatch :type} + [:human [:map [:type :keyword] [:name {:optional true} :string]]] + [:sized [:map [:type :keyword] [:size {:optional true} :int]]]]] + (testing "bare" + (is (= [:map [:name :string] + [:addresses {:optional true} [:vector [:map [:street :string]]]]] + (m/form (prune-optionals Person))) + "optional leaves are dropped; optional entries with a required descendant stay") + (is (= [:map [:name :string]] + (m/form (prune-optionals Loose))) + "fully-optional subtrees are dropped") + (is (= (m/form (prune-optionals Person)) + (m/form (prune-optionals (prune-optionals Person)))) + "prune-optionals is idempotent")) + + (testing "keep-selection" + (is (= [:map [:name :string] + [:addresses {:optional true} [:vector :map]]] + (m/form (prune-optionals Loose [{:addresses []}]))) + "keep :addresses as an empty optional map") + (is (= [:map [:name :string] + [:addresses {:optional true} [:vector [:map [:street {:optional true} :string]]]]] + (m/form (prune-optionals Loose [{:addresses [:street]}]))) + "kept entries stay optional")) + + (testing "multi" + (is (= [:multi {:dispatch :type} + [:human [:map [:type :keyword]]] + [:sized [:map [:type :keyword]]]] + (m/form (prune-optionals Animal))) + "no branch mentioned: all branches stay, dispatch key survives") + (is (= [:multi {:dispatch :type} + [:human [:map [:type :keyword]]]] + (m/form (prune-optionals Animal {:human []}))) + "mentioning a branch drops the unmentioned ones")) + + (testing "verification" + (let [ex-data (try + (prune-optionals Person [:nope]) + (catch #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) e (ex-data e)))] + (is (= ::sut/unknown-paths (:type ex-data)) + "unknown keep-paths throw")) + (is (some? (prune-optionals Person [:nope] {:verify-selection false})))) + + (testing "equivalence with select-only" + (doseq [sel [[:name] + [:name {:addresses []}] + [{:addresses [:street]}]]] + (is (= (m/form (select-only Person sel)) + (m/form (prune-optionals (select Person sel) sel))) + (str "sel: " (pr-str sel)))) + ;; select-only re-appends the pruned dispatch key at the end, + ;; prune-optionals never prunes it: compare with map-entries sorted. + (is (= (normalized-form (select-only Animal {:human [:name]})) + (normalized-form (prune-optionals (select Animal {:human [:name]}) {:human [:name]}))))) + + (testing "generation" + (let [s (prune-optionals (select Person [:name {:addresses [:street]}]))] + (is (every? (partial m/validate s) (mg/sample s)))) + (let [HumanOrSized [:multi {:dispatch :type} + [:human [:map [:type [:= :human]] [:name {:optional true} :string]]] + [:sized [:map [:type [:= :sized]] [:size {:optional true} :int]]]] + s (prune-optionals HumanOrSized {:human []})] + (is (every? (partial m/validate s) (mg/sample s))) + (is (every? #(= :human (:type %)) (mg/sample s)) + "no samples from dropped branches"))))) + (comment (select [:map [:address [:map [:street string?]]]] [{:address [:street]}] {:prune-optionals true})