[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Add a way to disable serialization support to (guix services configu
|
From: |
Maxim Cournoyer |
|
Subject: |
Re: Add a way to disable serialization support to (guix services configuration) |
|
Date: |
Fri, 07 May 2021 01:42:56 -0400 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/27.2 (gnu/linux) |
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 <public@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