spec-alpha2/select for Malli

malli_select.clj

(ns malli-select
  (:require
   [malli.core :as m]
   [malli.util :as mu]))

(defn select
  "Takes a malli schema and a vector of selection patterns and returns a schema
  with keys that don't match any selection patterns set as optional.

  A selection pattern either a keyword or a map. If a map, the keys must be
  keywords and the values must be vectors of selection patterns."
  [schema keyseq]
  (let [schema (m/schema schema)
        plain-keys (filter keyword? keyseq)
        map-keys (->> keyseq
                      (filter map?)
                      (apply merge)
                      (not-empty))
        req-keys (vec (concat plain-keys (keys map-keys)))
        changed-schema (-> (mu/optional-keys schema)
                           (mu/required-keys req-keys))]
    (if-let [paths map-keys]
      (reduce (fn [schema [path v]]
                (assert (vector? v) "Nested map vals must be vectors")
                (mu/update schema path select v))
              changed-schema
              paths)
      changed-schema)))

(def Example
  (m/schema
   [:map
    [:name string?]
    [:title [:enum "boss" "not-boss"]]
    [:skills [:set [:enum "clj" "cljs"]]]
    [:claim [:tuple string? keyword?]]
    [:base
     [:map
      [:this-one
       [:map
        [:one uuid?]
        [:two int?]]]
      [:not-this-one string?]]]]))

(def SelectExample (select Example [:name :skills {:base [{:this-one [:two]}]}]))

(m/validate SelectExample {:name "Noah"
                           :skills #{"clj"}
                           :claim ["one" :two]
                           :base {:this-one {:two 12345}}}) ; => true

(m/validate SelectExample {:name "Noah"}) ; => false

(m/validate SelectExample {:name "Noah"
                           :skills #{"clj"}
                           :base {:not-this-one "heck"}}) ; => false

;; below example taken from https://gist.github.com/bortexz/a9e253ab7b7ba3815409bb869f91c846
(def Nested
  (mu/optional-keys
   [:map {:registry {::nested-a string?
                     ::nested-b int?}}
    ::nested-a
    ::nested-b]))

(def Map
  (mu/optional-keys
   [:map [::top-level Nested]]))

(def Selection (select Map [::top-level {::top-level [::nested-a]}]))

(m/validate Selection {::top-level {}}) ; => false
(m/validate Selection {::top-level {::nested-a "a"}}) ; => true