Skip to content

Commit

Permalink
Add ms/selector to speedup selections
Browse files Browse the repository at this point in the history 
Fixes #3
  • Loading branch information
@eval
eval committed Oct 11, 2023
1 parent b99a1cf commit 2bbf6ad
Show file tree
Hide file tree
Showing 2 changed files with 153 additions and 87 deletions.
195 changes: 122 additions & 73 deletions src/dk/thinkcreate/malli_select.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,6 @@
[malli.core :as m]
[malli.util :as mu]))


(defn- clean-path [path]
(loop [p path
r (transient [])]
Expand Down Expand Up @@ -76,6 +75,79 @@
set))


(defn- -select
[schema selection
{:as _options
::keys [optionalized]
:keys [verify-selection prune-optionals]
:or
{verify-selection :assert}}]
(letfn [(in? [coll elm]
(some #(= % elm) coll))]
(let [all-optional? (empty? selection)
verify-selection? (and (not (in? #{nil false :skip} verify-selection))
(not all-optional?))
prune-optionals (if (not (nil? prune-optionals))
prune-optionals
(-> selection meta :only))
selection-paths (parse-selection selection)
sel-map (paths->tree selection-paths)
!available-paths (atom #{})
!seen (atom #{})
record-seen! (fn [schema path to-require]
(when verify-selection?
(let [available-keys (map first (m/entries schema))
valid-keys (into ['? '*] available-keys)
seen-keys (filter to-require valid-keys)]
(swap! !available-paths into
(map (partial conj path) available-keys))
(swap! !seen into
(map (partial conj path) seen-keys)))))
!prune-exclusions (atom #{})
record-prune-exclusions! (fn [path]
(when prune-optionals
(let [self&parent-paths (take (inc (count path)) (iterate pop path))]
(swap! !prune-exclusions into self&parent-paths))))

walker (let [optionalize-step (fn optionalize-step [v]
(update v 0 mu/optional-keys))
require-step (fn require-step [[schema path :as v]]
(let [cleaned-path (clean-path path)
to-require (sel-map cleaned-path)]
(if-not (seq to-require)
v
(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)))))))

prune-step (fn prune-step [[schema path :as v]]
(let [prunable? (every-pred (comp :optional second)
(comp not @!prune-exclusions #(conj path %) first))
children (remove prunable? (m/children schema))]
(update v 0 #(m/into-schema (m/type %) (m/-properties %)
children (m/-options %)))))
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))]
(map-schema-path-walker (comp middlewares vector)))
walked (m/walk schema walker
{::m/walk-schema-refs true ::m/walk-refs true})]
(when verify-selection?
(let [invalid-selection-paths (remove @!seen selection-paths)]
(assert (empty? invalid-selection-paths)
(str "Selection contains unknown paths: " (prn-str invalid-selection-paths)
"\nAvailable: \n" (with-out-str (pprint (sort (selectable-paths schema))))))))

walked)))


(defn select
"`selection` examples:
Expand All @@ -91,7 +163,7 @@
`options`:
- `verify-selection` (`:assert` (default), `:skip`, `false`, `nil`) - what to do when `selection` contains paths not in `schema`.
- `prune-optionals` (`false` (default), `true`) - whether all fully optional subtrees should be removed from the resulting schema.
- `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).
Typically used when the selected schema is used for data generation.
Examples:
Expand All @@ -109,76 +181,30 @@
(select schema [] nil))
([schema selection]
(select schema selection nil))
([schema selection
{:as _options
:keys [verify-selection prune-optionals]
:or
{verify-selection :assert
prune-optionals false}}]
(letfn [(in? [coll elm]
(some #(= % elm) coll))]
(let [all-optional? (empty? selection)
verify-selection? (and (not (in? #{nil false :skip} verify-selection))
(not all-optional?))
prune-optionals (or (true? prune-optionals)
(-> selection meta :only))
selection-paths (parse-selection selection)
sel-map (paths->tree selection-paths)
!available-paths (atom #{})
!seen (atom #{})
record-seen! (fn [schema path to-require]
(when verify-selection?
(let [available-keys (map first (m/entries schema))
valid-keys (into ['? '*] available-keys)
seen-keys (filter to-require valid-keys)]
(swap! !available-paths into
(map (partial conj path) available-keys))
(swap! !seen into
(map (partial conj path) seen-keys)))))
!prune-exclusions (atom #{})
record-prune-exclusions! (fn [path]
(when prune-optionals
(let [self&parent-paths (take (inc (count path)) (iterate pop path))]
(swap! !prune-exclusions into self&parent-paths))))

walker (let [optionalize-step (fn optionalize-step [v]
(update v 0 mu/optional-keys))
require-step (fn require-step [[schema path :as v]]
(let [cleaned-path (clean-path path)
to-require (sel-map cleaned-path)]
(if-not (seq to-require)
v
(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)))))))

prune-step (fn prune-step [[schema path :as v]]
(let [prunable? (every-pred (comp :optional second)
(comp not @!prune-exclusions #(conj path %) first))
children (remove prunable? (m/children schema))]
(update v 0 #(m/into-schema (m/type %) (m/-properties %)
children (m/-options %)))))
wrap (fn [stack step]
#(step (stack %)))
middlewares (cond-> identity
:always (wrap optionalize-step)
(not all-optional?) (wrap require-step)
prune-optionals (wrap prune-step)
:finally (wrap first))]
(map-schema-path-walker (comp middlewares vector)))
walked (m/walk schema walker
{::m/walk-schema-refs true ::m/walk-refs true})]
(when verify-selection?
(let [invalid-selection-paths (remove @!seen selection-paths)]
(assert (empty? invalid-selection-paths)
(str "Selection contains unknown paths: " (prn-str invalid-selection-paths)
"\nAvailable: \n" (with-out-str (pprint (sort (selectable-paths schema))))))))

walked))))
([schema selection {:as options
:keys [verify-selection prune-optionals]
:or {verify-selection :assert}}]
(-select schema selection (assoc options
:verify-selection verify-selection
:prune-optionals prune-optionals))))


(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.
Examples:
```
(let [person-selector (selector Person)]
(person-selector ^:only [:name]))
```
"
[schema]
(let [optionalized-schema (select schema)]
(fn selector-select
([selection] (selector-select selection nil))
([selection options]
(-select optionalized-schema selection (merge {::optionalized true} options))))))

(comment
(def Person
Expand All @@ -189,9 +215,32 @@
[:addresses [:vector [:map
[:street string?]
[:country string?]]]]])

(let [person-selector (selector Person)]
(m/form (person-selector [:name] {:prune-optionals true})))

(let [schema [:schema {:registry {"More" [:map
[:more boolean?]]
"Other" [:map
[:other boolean?]
[:more "More"]]}}
[:map
[:this boolean?]
[:that "Other"]]]
selector (selector schema)]
(cc/quick-bench (selector ^:only [:this {:that ['*]}]))
#_(cc/quick-bench (selector schema)))

(require '[criterium.core :as cc])

(cc/quick-bench (select Person ^:only [:name {:addresses [:street]}]))

(cc/quick-bench (select Person ^:only [:name]))

(def person-selector (selector Person))
(cc/quick-bench (selector Person)) ;; 10us
(cc/quick-bench (select Person ^:only [:name {:addresses [:street]}])) ;; 23us
(cc/quick-bench (person-selector ^:only [:name {:addresses [:street]}])) ;; 13us

(m/form (select [:maybe Person] ^:only [:name {:friends [:name]}]))


Expand Down
45 changes: 31 additions & 14 deletions test/dk/thinkcreate/malli_select_test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,34 +2,37 @@
(:require
[clojure.pprint :refer [pprint]]
[clojure.test :as t :refer [deftest is testing]]
[dk.thinkcreate.malli-select :refer [select]]
[dk.thinkcreate.malli-select :as sut :refer [select selector]]
[malli.core :as m]
[malli.util :as mu]))

(defonce ^:private ^:dynamic
*schema* nil)

(defonce ^:private ^:dynamic
*selector* nil)

(defn pps [o]
(with-out-str (pprint o)))

(defmacro expect-selection-to-validate [sel & data+maybe-reason]
`(if ~sel
(let [data# ~(first data+maybe-reason)
sel-schema# (select *schema* ~sel (meta ~sel))
result# (or (m/validate sel-schema# data#) (m/explain sel-schema# data#))]
(is (true? result#)
(cond-> (str "Expected data:\n" (pps data#) "to be valid given schema:\n" (pps (m/form sel-schema#)))
~(second data+maybe-reason) (str "because:\n" ~(second data+maybe-reason))
:always (str "\nvalidate errors:\n" (pps (:errors result#))))))
sel-schema# (if *selector* (*selector* ~sel) (select *schema* ~sel (meta ~sel)))
result# (or (m/validate sel-schema# data#) (m/explain sel-schema# data#))]
(is (true? result#)
(cond-> (str "Expected data:\n" (pps data#) "to be valid given schema:\n" (pps (m/form sel-schema#)))
~(second data+maybe-reason) (str "because:\n" ~(second data+maybe-reason))
:always (str "\nvalidate errors:\n" (pps (:errors result#))))))
*schema*))

(defmacro expect-selection-to-invalidate [sel & data+maybe-reason]
`(if ~sel
(let [data# ~(first data+maybe-reason)
sel-schema# (select *schema* ~sel (meta ~sel))]
(is (false? (m/validate sel-schema# data#))
(cond-> (str "Expected data:\n" (pps data#) "to be *invalid* given schema:\n" (pps (m/form sel-schema#)))
~(second data+maybe-reason) (str "because:\n" ~(second data+maybe-reason)))))
sel-schema# (if *selector* (*selector* ~sel) (select *schema* ~sel (meta ~sel)))]
(is (false? (m/validate sel-schema# data#))
(cond-> (str "Expected data:\n" (pps data#) "to be *invalid* given schema:\n" (pps (m/form sel-schema#)))
~(second data+maybe-reason) (str "because:\n" ~(second data+maybe-reason)))))
*schema*))


Expand Down Expand Up @@ -185,16 +188,30 @@
[:map
[:this boolean?]
[:that "Other"]]]]
(expect-selection-to-validate ^{:prune-optionals true} []
{:that {:other "?"}}
":other can be a string as it should no longer be part of the schema"))))
(expect-selection-to-validate ^:only []
{:that {:other "?"}}
":other can be a string as it should no longer be part of the schema"))))
(testing "verify-selection"
(is (thrown-with-msg? AssertionError #"unknown paths: \(\[:a\]\)"
(select int? [:a])))
(testing "disabling it"
(is (some? (select int? [:a] {:verify-selection :skip})))
(is (some? (select int? [:a] {:verify-selection nil})))))))

(deftest selector-test
(binding [*selector* (selector [:map
[:name string?]
[:age int?]
[:addresses [:maybe [:vector [:map
[:street string?]
[:zip int?]]]]]])]
(expect-selection-to-validate [:name]
{:name "Foo"}
"All but :name optional")
(expect-selection-to-invalidate [:name]
{:name "Foo" :age "NaN"}
"All but :name optional")))

(comment
(select [:map [:address [:map [:street string?]]]] [{:address [:street]}] {:prune-optionals true})

Expand Down

0 comments on commit 2bbf6ad

Please sign in to comment.