Find file
Fetching contributors…
Cannot retrieve contributors at this time
47 lines (41 sloc) 1.4 KB
#lang scheme/base
;; form validation
(require "util.scm"
(provide validate
;; field-validate (via contract)
;; constructs a fn suitable for passing in to the #:validate keyword of a form call
;; the fn : rec -> content
;; Usage ex: (validate (field-validate 'name string?)
;; (field-validate 'age (lambda (n) (and (integer? n) (>= n 13)))))
(define (validate . validation-fns)
(lambda (rec)
(let ((errors (filter-map (lambda (f) (f rec)) validation-fns)))
(if (empty? errors)
(string-join errors "\n")))))
;; field-validate
(provide/contract (field-validate (->* (symbol?)
((or/c #f (-> any/c any/c))
#:msg-fn (-> any/c string?))
(-> rec? (or/c #f string?)))))
(define (field-validate field-name
(pred #f)
#:msg-fn (msg-fn (lambda (bad-val)
(format "'~A' is an invalid value for field ~A."
field-name bad-val))))
(lambda (rec)
(aif (rec-prop rec field-name)
(if pred
(if (pred it)
(msg-fn it))
(format "Missing field '~A'." field-name))))