(chapter-start ‘validations “utilities to record and run validation routines”)
(let validations {}
(def validate/reset () (= validations {})) (def validate/fns (thing context) (hash-get validations (list (type-of thing) context))) (def validate/fn+ (type context f) (hash-cons validations (list type context) f)))
;; returns a hash of error-name to list of error messages ;; ;; An empty return value signifies an error-free ‘thing ;; ;; @thing@ the thing to validate ;; @context@ an identifier to select the subset of validations to apply ;; (def validate (thing context)
(returnlet msgs {} (let msgf λem(hash-cons msgs e m) (eachl λv(v thing context msgf) (validate/fns thing context)))))
;; declare a validation routine for type ‘type in context ’context ;; ;; @type@ must be a symbol ;; @context@ must be a symbol ;; @body@ is one or more nydp expressions. ;; ;; @body@ will be embedded in a function with access to the following variables : ;; ;; * the value of the ‘type argument ;; * ctx ;; * mf ;; ;; @mf@ (“message function”) is a function that takes two arguments and is used to store ;; the validation error message ;; example: (mf “Last name” “Last name must not be empty”) ;; ;; example usage: ;; ;; <pre> ;; (validate/def invoice issue ;; (if (no invoice.account) ;; (mf "Account" "Account must be a client account")) ;; (if (!> invoice.total 0) ;; (mf "Amount" "Amount must be greater than zero")) ;; (if (any? !&group invoice.invoice-items) ;; (mf "Group" "Each line must be assigned to a group"))) ;;
</pre> ;; ;;
;; ;; if your routine makes no call to ’mf then ‘validate will return an empty hash, which should be ;; interpreted as signifying that the object in question is error free in the given context. ;; ;; run your validations thus: ;; ;; <pre> ;; (let validations (validate invoice 'issue) ;; (if (empty? validations) ;; (invoice.issue))) ;;
</pre> ;; (mac validate/def (type context . body)
`(validate/fn+ ',type ',context (fn (,type ctx mf) ,@body)))