/
validation.clj
275 lines (228 loc) · 8.07 KB
/
validation.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
(ns dgknght.app-lib.validation
(:refer-clojure :exclude [format])
(:require [clojure.core :as c]
[clojure.spec.alpha :as s]
[dgknght.app-lib.web :refer [email-pattern] ]
[dgknght.app-lib.inflection :refer [humanize
conjoin]])
(:import [org.joda.time LocalDate DateTime LocalTime]))
(def email?
(every-pred string?
(partial re-matches email-pattern)))
(def local-date?
(partial instance? LocalDate))
(def nilable-local-date?
(some-fn nil? local-date?))
(def local-time?
(partial instance? LocalTime))
(def date-time?
(partial instance? DateTime))
(def nilable-date-time?
(some-fn nil? date-time?))
(def non-empty-string?
(every-pred string? seq))
(def positive-integer?
(every-pred integer? pos?))
(def nilable-positive-integer?
(some-fn nil? positive-integer?))
(def positive-number?
(every-pred number? pos?))
(def nilable-positive-number?
(some-fn nil? positive-number?))
(def positive-big-dec?
(every-pred decimal? pos?))
(def big-dec-not-less-than-zero?
(every-pred decimal?
(some-fn pos? zero?)))
(defn min-length?
[minimum value]
(>= (count value) minimum))
(defn not-longer-than?
[max-length value]
(<= (count value) max-length))
(defn length-between?
[min-length max-length value]
(let [actual (count value)]
(and (<= actual max-length)
(>= actual min-length))))
(defn- req-pred?
"Returns a boolean value if this predicate is the one the framework
uses to satisfy a :req or :req-un specification"
[pred]
(and (sequential? pred)
(= 'clojure.core/fn (nth pred 0))
(= 'clojure.core/contains? (first (nth pred 2)))))
(defn- resolve-<=
[pred]
(when (= 'clojure.core/<= (nth pred 0))
(str "%s must contain at least "
(nth pred 1)
" item(s)")))
(defn- resolve-contains?
[pred]
(when (and (= 'clojure.core/fn (nth pred 0))
(= 'clojure.core/contains? (nth (nth pred 2) 0)))
"%s is required"))
(declare spec-data)
(defn- simple-resolve-path
[pred]
(when (symbol? pred)
(get-in @spec-data [::paths pred])))
(def spec-data (atom {::path-resolvers [simple-resolve-path]
::message-resolvers [resolve-<=
resolve-contains?]
::paths {}
::messages {'clojure.core/identity "%s is required"
'clojure.core/string? "%s must be a string"
'clojure.core/integer? "%s must be an integer"
'clojure.core/decimal? "%s must be a number"
'clojure.core/vector? "%s must be a list of values"
'clojure.core/coll? "%s must be a list of values"
'decimal? "%s must be a number"
'dgknght.app-lib.core/present? "%s is required"
'dgknght.app-lib.validation/non-empty-string? "%s is required"
'dgknght.app-lib.validation/positive-integer? "%s must be greater than zero"
'dgknght.app-lib.validation/positive-big-dec? "%s must be greater than zero"
'dgknght.app-lib.validation/local-date? "%s must be a date"
'dgknght.app-lib.validation/nilable-local-date? "%s must be a date"
'dgknght.app-lib.validation/big-dec-not-less-than-zero? "%s cannot be less than zero"
'dgknght.app-lib.validation/email? "%s must be a valid email address"
'dgknght.app-lib.validation/min-length? "%s must be at least %s characters"
'dgknght.app-lib.validation/length-between? "%s must be between %s and %s characters"
'dgknght.app-lib.validation/not-longer-than? "%s cannot be more than %s characters"}}))
(defmacro reg-spec
[pred {:keys [message path]}]
`(let [sym# (symbol (resolve '~pred))]
(swap! spec-data (fn [d#]
(cond-> d#
~message (assoc-in [::messages sym#] ~message)
~path (assoc-in [::paths sym#] ~path))))))
(defmacro reg-msg
[pred msg]
`(swap! spec-data assoc (symbol (resolve '~pred)) ~msg))
(defn reg-path-resolver
[resolver]
(swap! spec-data update-in [::path-resolvers] conj resolver))
(defn- default-pred-msg
[pred]
(if (req-pred? pred)
"%s is required"
(get-in @spec-data [pred] "%s is invalid")))
(defn- unwrap-partial
[pred]
(if (and (sequential? pred)
(= 'clojure.core/partial
(nth pred 0)))
[(nth pred 1)
(drop 2 pred)]
[pred []]))
(defmulti ^:private pred-msg type)
(defmethod pred-msg clojure.lang.PersistentHashSet
[pred]
(str "%s must be "
(conjoin "or" pred)))
(defn- resolve-msg
[pred]
(let [f (apply some-fn (::message-resolvers @spec-data))]
(f pred)))
(defn- seq-pred-msg
[pred]
(or
(get-in @spec-data [::messages (nth pred 0)])
(resolve-msg pred)
(default-pred-msg (nth pred 0))))
(defmethod pred-msg clojure.lang.PersistentList
[pred]
(seq-pred-msg pred))
(defmethod pred-msg clojure.lang.LazySeq
[pred]
(seq-pred-msg pred))
(defmethod pred-msg clojure.lang.Cons
[pred]
(seq-pred-msg pred))
(defmethod pred-msg clojure.lang.Symbol
[pred]
(or (get-in @spec-data [::messages pred])
(default-pred-msg pred)))
(defmethod pred-msg :default
[pred]
(throw (ex-info (str "Unknown predicate type: " (type pred))
{:pred pred})))
(defn- resolve-path
[path pred]
(cond
(req-pred? pred) (conj path (nth (nth pred 2) 2))
(seq path) path
:else (let [f (apply some-fn (::path-resolvers @spec-data))]
(f pred))))
(defn- fieldize
[attr-key]
(if (integer? attr-key)
"Value"
(humanize attr-key)))
(defn- append-error
[errors {:keys [pred in]}]
(let [[unwrapped args] (unwrap-partial pred)
msg (pred-msg unwrapped)
path (resolve-path in pred)]
(update-in errors path (fnil conj [])
(apply c/format
msg
(fieldize (last path))
args))))
(defn- ->errors
[{::s/keys [problems]}]
(reduce append-error
{}
problems))
(defn validate
"Validates the specified model using the specified spec"
[model spec]
(if-let [result (s/explain-data spec model)]
(assoc model ::valid? false ::errors (->errors result))
(assoc model ::valid? true ::errors {})))
(defn has-error?
"Returns true if the specified model contains validation errors"
([model]
(-> model ::errors seq))
([model path]
(let [path (if (keyword? path)
[path]
path)]
(get-in model (cons ::errors path)))))
(defn valid?
"Returns false if the model has any validation errors"
[model]
(-> model ::errors seq not))
(defn error-messages
"Returns the errors from the specified model. If given only a model,
returns a map of all errors. If given a model and a key, returns the
errors for the specified key from wihin the model."
([model]
(::errors model))
([model path]
(let [path (if (keyword? path)
[path]
path)]
(get-in (error-messages model) path))))
(defn flat-error-messages
"Returns a flat list of strings describing the error messages for the
model instead of the map returned by error-messages"
[model]
(-> model
::errors
vals
flatten))
(defmacro with-validation
"Accepts a model and validation rules. If the model
passes the rules, the specified body is executed
and the result returned. If not, the invalid model,
with validation errors, is returned.
Note that this rebinds the validated user object
to the same binding used to call the macro."
[model spec & body]
`(let [validated# (validate ~model ~spec)
f# (fn* [~model] ~@body)]
(if (valid? validated#)
(f# validated#)
validated#)))