On Mon 10 Oct 2016 10:32, Clément Lassieur <clem...@lassieur.org> writes:
>> +(define-record-type* <configuration-field> >> + configuration-field make-configuration-field configuration-field? >> + (name configuration-field-name) >> + (type configuration-field-type) >> + (getter configuration-field-getter) >> + (predicate configuration-field-predicate) >> + (serializer configuration-field-serializer) >> + (default-value-thunk configuration-field-default-value-thunk) >> + (documentation configuration-field-documentation)) >> + >> +(define-syntax define-configuration >> + (lambda (stx) >> + (define (id ctx part . parts) >> + (let ((part (syntax->datum part))) >> + (datum->syntax >> + ctx >> + (match parts >> + (() part) >> + (parts (symbol-append part >> + (syntax->datum (apply id ctx parts)))))))) >> + (syntax-case stx () >> + ((_ stem (field (field-type def) doc) ...) >> + (with-syntax (((field-getter ...) >> + (map (lambda (field) >> + (id #'stem #'stem #'- field)) >> + #'(field ...))) >> + ((field-predicate ...) >> + (map (lambda (type) >> + (id #'stem type #'?)) >> + #'(field-type ...))) >> + ((field-serializer ...) >> + (map (lambda (type) >> + (id #'stem #'serialize- type)) >> + #'(field-type ...)))) >> + #`(begin >> + (define-record-type* #,(id #'stem #'< #'stem #'>) >> + stem #,(id #'stem #'make- #'stem) #,(id #'stem #'stem #'?) >> + (field field-getter (default def)) >> + ...) >> + (define #,(id #'stem #'stem #'-fields) >> + (list (configuration-field >> + (name 'field) >> + (type 'field-type) >> + (getter field-getter) >> + (predicate field-predicate) >> + (serializer field-serializer) >> + (default-value-thunk (lambda () def)) >> + (documentation doc)) >> + ...)))))))) >> + >> +(define (serialize-configuration config fields) >> + (for-each (lambda (field) >> + ((configuration-field-serializer field) >> + (configuration-field-name field) >> + ((configuration-field-getter field) config))) >> + fields)) >> + >> +(define (validate-configuration config fields) >> + (for-each (lambda (field) >> + (let ((val ((configuration-field-getter field) config))) >> + (unless ((configuration-field-predicate field) val) >> + (cups-configuration-field-error >> + (configuration-field-name field) val)))) >> + fields)) > > These definitions are also in the Dovecot service. Would it make sense > to put them in a place where they could be accessible from other > services as well, thus avoiding code repetition? Yes, it's a good idea. I was holding off doing it until the third service that used them, though, just to avoid prematurely making an abstraction that might be the wrong thing; dunno. WDYT? Andy
