Skip to content

Commit

Permalink
Merge branch 'master' into unreachable-gen-idiom
Browse files Browse the repository at this point in the history
  • Loading branch information
@ikitommi
ikitommi authored Dec 8, 2024
2 parents d5feb08 + 0b69456 commit f4b2b6a
Show file tree
Hide file tree
Showing 8 changed files with 324 additions and 61 deletions.
2 changes: 2 additions & 0 deletions CHANGELOG.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,9 @@ Malli is in well matured [alpha](README.md#alpha).
* **BREAKING**: `:gen/fmap` property requires its schema to create a generator.
* previous behavior defaulted to a `nil`-returning generator, even if the schema doesn't accept `nil`
* use `:gen/return nil` property to restore this behavior
* Support decoding map keys into keywords for `[:map` schemas in `json-transformer` [#1135](https://github.com/metosin/malli/issues/1135)
* FIX: `malli.registry/{mode,type}` not respected in Babashka [#1124](https://github.com/metosin/malli/issues/1124)
* FIX: `:float` missing humanizer [#1122](https://github.com/metosin/malli/issues/1122)
* Updated dependencies:

```
Expand Down
45 changes: 44 additions & 1 deletion README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -817,7 +817,50 @@ Or if you already have a malli validation exception (e.g. in a catch form):

## Custom error messages

Error messages can be customized with `:error/message` and `:error/fn` properties:
Error messages can be customized with `:error/message` and `:error/fn` properties.

If `:error/message` is of a predictable structure, it will automatically support custom `[:not schema]` failures for the following locales:
- `:en` if message starts with `should` or `should not` then they will be swapped automatically. Otherwise, message is ignored.
```clojure
;; e.g.,
(me/humanize
(m/explain
[:not
[:fn {:error/message {:en "should be a multiple of 3"}}
#(= 0 (mod % 3))]]
3))
; => ["should not be a multiple of 3"]
```

The first argument to `:error/fn` is a map with keys:
- `:schema`, the schema to explain
- `:value` (optional), the value to explain
- `:negated` (optional), a function returning the explanation of `(m/explain [:not schema] value)`.
If provided, then we are explaining the failure of negating this schema via `(m/explain [:not schema] value)`.
Note in this scenario, `(m/validate schema value)` is true.
If returning a string,
the resulting error message will be negated by the `:error/fn` caller in the same way as `:error/message`.
Returning `(negated string)` disables this behavior and `string` is used as the negated error message.
```clojure
;; automatic negation
(me/humanize
(m/explain
[:not [:fn {:error/fn {:en (fn [_ _] "should not be a multiple of 3")}}
#(not= 0 (mod % 3))]]
1))
; => ["should be a multiple of 3"]

;; manual negation
(me/humanize
(m/explain [:not [:fn {:error/fn {:en (fn [{:keys [negated]} _]
(if negated
(negated "should not avoid being a multiple of 3")
"should not be a multiple of 3"))}}
#(not= 0 (mod % 3))]] 1))
; => ["should not avoid being a multiple of 3"]
```

Here are some basic examples of `:error/message` and `:error/fn`:

```clojure
(-> [:map
Expand Down
97 changes: 68 additions & 29 deletions src/malli/error.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,16 +3,43 @@
[malli.core :as m]
[malli.util :as mu]))

(declare default-errors error-message)

(defn -pr-str [v] #?(:clj (pr-str v), :cljs (str v)))

(defn -pred-min-max-error-fn [{:keys [pred message]}]
(fn [{:keys [schema value]} _]
(fn [{:keys [schema value negated]} _]
(let [{:keys [min max]} (m/properties schema)]
(cond
(not (pred value)) message
(and min (= min max)) (str "should be " min)
(and min (< value min)) (str "should be at least " min)
max (str "should be at most " max)))))
(and min ((if negated >= <) value min)) (str "should be at least " min)
max (str "should be at most " max)
negated message))))

(let [prefix (str "-en-humanize-negation-" (random-uuid))]
(defn- -en-humanize-negation [{:keys [schema negated] :as error} options]
(if negated
(negated (error-message (dissoc error :negated) options))
(let [remove-prefix #(str/replace-first % prefix "")
negated? #(str/starts-with? % prefix)]
(loop [schema schema]
(or (when-some [s (error-message (assoc error :negated #(some->> % (str prefix))) options)]
(if (negated? s)
(remove-prefix s)
(or (when (and (string? s)
(str/starts-with? s "should not "))
(str/replace-first s "should not" "should"))
(when (and (string? s)
(str/starts-with? s "should "))
(str/replace-first s "should" "should not")))))
(let [dschema (m/deref schema)]
(when-not (identical? schema dschema)
(recur dschema)))))))))

(defn- -forward-negation [?schema {:keys [negated] :as error} options]
(let [schema (m/schema ?schema options)]
(negated (error-message (-> error (dissoc :negated) (assoc :schema schema)) options))))

(def default-errors
{::unknown {:error/message {:en "unknown error"}}
Expand Down Expand Up @@ -64,8 +91,8 @@
'uri? {:error/message {:en "should be a uri"}}
#?@(:clj ['decimal? {:error/message {:en "should be a decimal"}}])
'inst? {:error/message {:en "should be an inst"}}
'seqable? {:error/message {:en "should be a seqable"}}
'indexed? {:error/message {:en "should be an indexed"}}
'seqable? {:error/message {:en "should be seqable"}}
'indexed? {:error/message {:en "should be indexed"}}
'map? {:error/message {:en "should be a map"}}
'vector? {:error/message {:en "should be a vector"}}
'list? {:error/message {:en "should be a list"}}
Expand All @@ -79,54 +106,66 @@
#?@(:clj ['rational? {:error/message {:en "should be a rational"}}])
'coll? {:error/message {:en "should be a coll"}}
'empty? {:error/message {:en "should be empty"}}
'associative? {:error/message {:en "should be an associative"}}
'sequential? {:error/message {:en "should be a sequential"}}
'associative? {:error/message {:en "should be associative"}}
'sequential? {:error/message {:en "should be sequential"}}
#?@(:clj ['ratio? {:error/message {:en "should be a ratio"}}])
#?@(:clj ['bytes? {:error/message {:en "should be bytes"}}])
:re {:error/message {:en "should match regex"}}
:=> {:error/message {:en "invalid function"}}
:=> {:error/message {:en "should be a valid function"}}
'ifn? {:error/message {:en "should be an ifn"}}
'fn? {:error/message {:en "should be an fn"}}
'fn? {:error/message {:en "should be a fn"}}
:enum {:error/fn {:en (fn [{:keys [schema]} _]
(str "should be "
(if (= 1 (count (m/children schema)))
(-pr-str (first (m/children schema)))
(str "either " (->> (m/children schema) butlast (map -pr-str) (str/join ", "))
" or " (-pr-str (last (m/children schema)))))))}}
:not {:error/fn {:en (fn [{:keys [schema] :as error} options]
(-en-humanize-negation (assoc error :schema (-> schema m/children first)) options))}}
:any {:error/message {:en "should be any"}}
:nil {:error/message {:en "should be nil"}}
:string {:error/fn {:en (fn [{:keys [schema value]} _]
:string {:error/fn {:en (fn [{:keys [schema value negated]} _]
(let [{:keys [min max]} (m/properties schema)]
(cond
(not (string? value)) "should be a string"
(and min (= min max)) (str "should be " min " character" (when (not= 1 min) "s"))
(and min (< (count value) min)) (str "should be at least " min " character"
(when (not= 1 min) "s"))
max (str "should be at most " max " character" (when (not= 1 max) "s")))))}}
(and min ((if negated >= <) (count value) min)) (str "should be at least " min " character"
(when (not= 1 min) "s"))
max (str "should be at most " max " character" (when (not= 1 max) "s"))
negated "should be a string")))}}
:int {:error/fn {:en (-pred-min-max-error-fn {:pred int?, :message "should be an integer"})}}
:double {:error/fn {:en (-pred-min-max-error-fn {:pred double?, :message "should be a double"})}}
:float {:error/fn {:en (-pred-min-max-error-fn {:pred float?, :message "should be a float"})}}
:boolean {:error/message {:en "should be a boolean"}}
:keyword {:error/message {:en "should be a keyword"}}
:symbol {:error/message {:en "should be a symbol"}}
:qualified-keyword {:error/message {:en "should be a qualified keyword"}}
:qualified-symbol {:error/message {:en "should be a qualified symbol"}}
:uuid {:error/message {:en "should be a uuid"}}
:> {:error/fn {:en (fn [{:keys [schema value]} _]
(if (number? value)
(str "should be larger than " (first (m/children schema)))
"should be a number"))}}
:>= {:error/fn {:en (fn [{:keys [schema value]} _]
(if (number? value)
(str "should be at least " (first (m/children schema)))
"should be a number"))}}
:< {:error/fn {:en (fn [{:keys [schema value]} _]
(if (number? value)
(str "should be smaller than " (first (m/children schema)))
"should be a number"))}}
:<= {:error/fn {:en (fn [{:keys [schema value]} _]
(if (number? value)
(str "should be at most " (first (m/children schema)))
"should be a number"))}}
:> {:error/fn {:en (fn [{:keys [schema value negated] :as error} options]
(if negated
(-forward-negation [:<= (first (m/children schema))] error options)
(if (number? value)
(str "should be larger than " (first (m/children schema)))
"should be a number")))}}
:>= {:error/fn {:en (fn [{:keys [schema value negated] :as error} options]
(if negated
(-forward-negation [:< (first (m/children schema))] error options)
(if (number? value)
(str "should be at least " (first (m/children schema)))
"should be a number")))}}
:< {:error/fn {:en (fn [{:keys [schema value negated] :as error} options]
(if negated
(-forward-negation [:>= (first (m/children schema))] error options)
(if (number? value)
(str "should be smaller than " (first (m/children schema)))
"should be a number")))}}
:<= {:error/fn {:en (fn [{:keys [schema value negated] :as error} options]
(if negated
(-forward-negation [:> (first (m/children schema))] error options)
(if (number? value)
(str "should be at most " (first (m/children schema)))
"should be a number")))}}
:= {:error/fn {:en (fn [{:keys [schema]} _]
(str "should be " (-pr-str (first (m/children schema)))))}}
:not= {:error/fn {:en (fn [{:keys [schema]} _]
Expand Down
10 changes: 7 additions & 3 deletions src/malli/generator.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -137,9 +137,13 @@
(-never-gen options)))

(defn- -seqable-gen [schema options]
(let [el (-child schema options)]
(gen-one-of options
(-> [nil-gen]
(let [{:keys [min]} (-min-max schema options)
el (-child schema options)]
(gen-one-of
(-> []
(cond->
(or (nil? min) (zero? min))
(conj nil-gen))
(into (map #(-coll-gen schema % options))
[identity vec eduction #(into-array #?(:clj Object) %)])
(conj (-coll-distinct-gen schema set options))
Expand Down
19 changes: 16 additions & 3 deletions src/malli/transform.cljc
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
(ns malli.transform
#?(:cljs (:refer-clojure :exclude [Inst Keyword UUID]))
(:require [malli.core :as m]
[malli.util :as mu]
[clojure.math :as math]
#?(:cljs [goog.date.UtcDateTime])
#?(:cljs [goog.date.Date]))
Expand Down Expand Up @@ -191,8 +192,11 @@
(catch #?(:clj Exception, :cljs js/Error) _ x))
x))

(defn -transform-map-keys [f]
#(cond->> % (map? %) (into {} (map (fn [[k v]] [(f k) v])))))
(defn -transform-map-keys
([f]
#(cond->> % (map? %) (into {} (map (fn [[k v]] [(f k) v])))))
([ks f]
#(cond->> % (map? %) (into {} (map (fn [[k v]] [(cond-> k (contains? ks k) f) v]))))))

(defn -transform-if-valid [f schema]
(let [validator (m/-validator schema)]
Expand Down Expand Up @@ -403,7 +407,9 @@

(defn json-transformer
([] (json-transformer nil))
([{::keys [json-vectors map-of-key-decoders] :or {map-of-key-decoders (-string-decoders)}}]
([{::keys [json-vectors
keywordize-map-keys
map-of-key-decoders] :or {map-of-key-decoders (-string-decoders)}}]
(transformer
{:name :json
:decoders (-> (-json-decoders)
Expand All @@ -415,6 +421,13 @@
(-transform-if-valid key-schema)
(-transform-map-keys))
(-transform-map-keys m/-keyword->string))))})
(cond-> keywordize-map-keys
(assoc :map {:compile (fn [schema _]
(let [keyword-keys (->> (mu/keys schema)
(filter keyword?)
(map name)
set)]
(-transform-map-keys keyword-keys -string->keyword)))}))
(cond-> json-vectors (assoc :vector -sequential->vector)))
:encoders (-json-encoders)})))

Expand Down
18 changes: 18 additions & 0 deletions test/malli/core_test.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -997,6 +997,24 @@
(mt/key-transformer
{:decode #(-> % name (str "_key") keyword)}))))

(testing "JSON transformer can decode map schema keys"
(let [schema
[:map
[:a :uuid]
[:b [:enum :x :y :z]]
["s" :boolean [:enum :f1 :f2]]]
value
{"a" "b699671c-d34d-b33f-1337-dbdbfd337e73"
"b" "x"
"s" "f1"}
expected-decoded-value
{:a #uuid "b699671c-d34d-b33f-1337-dbdbfd337e73"
:b :x
"s" :f1}
decoded-value (m/decode schema value (mt/json-transformer {::mt/keywordize-map-keys true}))]
(is (= expected-decoded-value decoded-value))
(is (m/validate schema decoded-value))))

(is (= {:x 32}
(m/decode
[:map {:decode/string '{:enter #(update % :x inc), :leave #(update % :x (partial * 2))}}
Expand Down
Loading

0 comments on commit f4b2b6a

Please sign in to comment.