From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
To: Xinglu Chen <public@yoctocell.xyz>
Cc: guix-devel <guix-devel@gnu.org>
Subject: Re: Add a way to disable serialization support to (guix services configuration)
Date: Fri, 07 May 2021 01:42:56 -0400 [thread overview]
Message-ID: <87wnsbgkv3.fsf@gmail.com> (raw)
In-Reply-To: <87k0oik6sy.fsf@yoctocell.xyz> (Xinglu Chen's message of "Sat, 01 May 2021 13:54:53 +0200")
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
next prev parent reply other threads:[~2021-05-07 5:43 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-04-12 20:57 Add a way to disable serialization support to (guix services configuration) Maxim Cournoyer
2021-04-17 16:29 ` Ludovic Courtès
2021-04-21 15:43 ` Maxim Cournoyer
2021-04-22 22:28 ` Ludovic Courtès
2021-04-23 6:09 ` Xinglu Chen
2021-05-01 11:54 ` Xinglu Chen
2021-05-07 5:42 ` Maxim Cournoyer [this message]
2021-05-07 14:03 ` Xinglu Chen
2021-05-08 5:08 ` Maxim Cournoyer
2021-04-21 17:14 ` Maxim Cournoyer
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87wnsbgkv3.fsf@gmail.com \
--to=maxim.cournoyer@gmail.com \
--cc=guix-devel@gnu.org \
--cc=public@yoctocell.xyz \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).