Hello Xinglu! Thank you for working on it! I spent the evening trying things but none worked, so your kudos for finding how to make it work! :-). Some comments follow (and a patch implementing them):
Xinglu Chen <pub...@yoctocell.xyz> writes: [...] > @@ -63,6 +64,9 @@ > (define (configuration-missing-field kind field) > (configuration-error > (format #f "~a configuration missing required field ~a" kind field))) > +(define (configuration-no-default-value kind field) > + (configuration-error > + (format #f "`~a' in `~a' does not have a default value" kind field))) The kind and field should be inverted. > (define-record-type* <configuration-field> > configuration-field make-configuration-field configuration-field? > @@ -112,7 +116,7 @@ > (define-syntax define-configuration > (lambda (stx) > (syntax-case stx () > - ((_ stem (field (field-type def) doc) ...) > + ((_ stem (field (field-type properties ...) doc) ...) I'd rather keep the 'def' binding for the default value; properties is too vague and implies many of them, which is not a supported syntax. > (with-syntax (((field-getter ...) > (map (lambda (field) > (id #'stem #'stem #'- field)) > @@ -121,36 +125,56 @@ > (map (lambda (type) > (id #'stem type #'?)) > #'(field-type ...))) > + ((field-default ...) > + (map (match-lambda > + ((field-type default _ ...) default) > + ;; We get warnings about `disabled' being an > + ;; unbound variable unless we quote it. > + (_ (syntax 'disabled))) Here I think it'd be better to have the pattern more strict (e.g, (field-type default-value) or (field-type); so as to not accept invalid syntax. I also think it'd be clearer to use another symbol than 'disabled, as this already has a meaning for the validator and could confuse readers. > + #'((field-type properties ...) ...))) > ((field-serializer ...) > (map (lambda (type) > (id #'stem #'serialize- type)) > #'(field-type ...)))) > - #`(begin > - (define-record-type* #,(id #'stem #'< #'stem #'>) > - #,(id #'stem #'% #'stem) > - #,(id #'stem #'make- #'stem) > - #,(id #'stem #'stem #'?) > - (%location #,(id #'stem #'-location) > - (default (and=> (current-source-location) > - source-properties->location)) > - (innate)) > - (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-syntax-rule (stem arg (... ...)) > - (let ((conf (#,(id #'stem #'% #'stem) arg (... ...)))) > - (validate-configuration conf > - #,(id #'stem #'stem #'-fields)) > - conf)))))))) > + #`(begin > + (define-record-type* #,(id #'stem #'< #'stem #'>) > + #,(id #'stem #'% #'stem) > + #,(id #'stem #'make- #'stem) > + #,(id #'stem #'stem #'?) > + (%location #,(id #'stem #'-location) > + (default (and=> (current-source-location) > + source-properties->location)) > + (innate)) > + #,@(map (lambda (name getter def) > + (if (equal? (syntax->datum def) (quote 'disabled)) nitpick: eq? suffices to check for symbols. > + #`(#,name #,getter) > + #`(#,name #,getter (default #,def)))) > + #'(field ...) > + #'(field-getter ...) > + #'(field-default ...))) > + (define #,(id #'stem #'stem #'-fields) > + (list (configuration-field > + (name 'field) > + (type 'field-type) > + (getter field-getter) > + (predicate field-predicate) > + (serializer field-serializer) > + ;; TODO: What if there is no default value? Seems this TODO was taken care of already :-). > + (default-value-thunk > + (lambda () > + (display '#,(id #'stem #'% #'stem)) > + (if (equal? (syntax->datum field-default) > + (quote 'disabled)) Like above (eq? would do). More importantly (and confusingly), here the 'disabled expected value must *not* be quoted. I haven't investigated why but it seems one level of quote got striped at that point. > + (configuration-no-default-value > + '#,(id #'stem #'% #'stem) 'field) > + field-default))) > + (documentation doc)) > + ...)) > + (define-syntax-rule (stem arg (... ...)) > + (let ((conf (#,(id #'stem #'% #'stem) arg (... ...)))) > + (validate-configuration conf > + #,(id #'stem #'stem #'-fields)) > + conf)))))))) The following patch implements the above comments; modified gnu/services/configuration.scm @@ -66,7 +66,8 @@ (format #f "~a configuration missing required field ~a" kind field))) (define (configuration-no-default-value kind field) (configuration-error - (format #f "`~a' in `~a' does not have a default value" kind field))) + (format #f "The field `~a' of the `~a' configuration record \ +does not have a default value" field kind))) (define-record-type* <configuration-field> configuration-field make-configuration-field configuration-field? @@ -116,7 +117,7 @@ (define-syntax define-configuration (lambda (stx) (syntax-case stx () - ((_ stem (field (field-type properties ...) doc) ...) + ((_ stem (field (field-type def ...) doc) ...) (with-syntax (((field-getter ...) (map (lambda (field) (id #'stem #'stem #'- field)) @@ -127,11 +128,13 @@ #'(field-type ...))) ((field-default ...) (map (match-lambda - ((field-type default _ ...) default) - ;; We get warnings about `disabled' being an - ;; unbound variable unless we quote it. - (_ (syntax 'disabled))) - #'((field-type properties ...) ...))) + ((field-type default-value) + default-value) + ((field-type) + ;; Quote `undefined' to prevent a possibly + ;; unbound warning. + (syntax 'undefined))) + #'((field-type def ...) ...))) ((field-serializer ...) (map (lambda (type) (id #'stem #'serialize- type)) @@ -146,7 +149,7 @@ source-properties->location)) (innate)) #,@(map (lambda (name getter def) - (if (equal? (syntax->datum def) (quote 'disabled)) + (if (eq? (syntax->datum def) (quote 'undefined)) #`(#,name #,getter) #`(#,name #,getter (default #,def)))) #'(field ...) @@ -159,12 +162,11 @@ (getter field-getter) (predicate field-predicate) (serializer field-serializer) - ;; TODO: What if there is no default value? (default-value-thunk (lambda () (display '#,(id #'stem #'% #'stem)) - (if (equal? (syntax->datum field-default) - (quote 'disabled)) + (if (eq? (syntax->datum field-default) + 'undefined) (configuration-no-default-value '#,(id #'stem #'% #'stem) 'field) field-default))) I'll attempt to review patch 2/2 shortly! Thanks a lot for this neat improvement! Maxim