From: Attila Lendvai <attila@lendvai.name>
To: 54674@debbugs.gnu.org
Cc: Attila Lendvai <attila@lendvai.name>
Subject: [bug#54674] [PATCH v4 1/2] services: configuration: Support (field1 maybe-number "") format.
Date: Wed, 20 Apr 2022 11:15:53 +0200 [thread overview]
Message-ID: <20220420091553.26732-1-attila@lendvai.name> (raw)
In-Reply-To: <20220401191957.16624-1-attila@lendvai.name>
As opposed to explicitly using 'disabled as value, or using the
(field1 (maybe-number) "") format.
It's mostly the work of Maxime Devos shared under #54674, with some
modifications by Attila Lendvai.
* gnu/services/configuration.scm (normalize-field-type+def): New function.
(define-configuration-helper) (define-configuration): Support new field
format.
* tests/services/configuration.scm (config-with-maybe-number->string): New
function.
("maybe value serialization of the instance"): New test.
("maybe value serialization of the instance, unspecified"): New test.
---
v4: the only change is to drop the extra parens around the type in
all the (field1 (maybe-foo) "") forms.
gnu/services/configuration.scm | 169 +++++++++++++++++--------------
tests/services/configuration.scm | 28 ++++-
2 files changed, 114 insertions(+), 83 deletions(-)
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 0de350a4df..bdca33ed68 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -162,78 +163,90 @@ (define-maybe-helper #t #f #'(_ stem))))))
(define-syntax-rule (define-maybe/no-serialization stem)
(define-maybe stem (no-serialization)))
+(define (normalize-field-type+def s)
+ (syntax-case s ()
+ ((field-type def)
+ (identifier? #'field-type)
+ (values #'(field-type def)))
+ ((field-type)
+ (identifier? #'field-type)
+ (values #'(field-type 'disabled)))
+ (field-type
+ (identifier? #'field-type)
+ (values #'(field-type 'disabled)))))
+
(define (define-configuration-helper serialize? serializer-prefix syn)
(syntax-case syn ()
- ((_ stem (field (field-type def ...) doc custom-serializer ...) ...)
- (with-syntax (((field-getter ...)
- (map (lambda (field)
- (id #'stem #'stem #'- field))
- #'(field ...)))
- ((field-predicate ...)
- (map (lambda (type)
- (id #'stem type #'?))
- #'(field-type ...)))
- ((field-default ...)
- (map (match-lambda
- ((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 custom-serializer)
- (and serialize?
- (match custom-serializer
- ((serializer)
- serializer)
- (()
- (if serializer-prefix
- (id #'stem
- serializer-prefix
- #'serialize- type)
- (id #'stem #'serialize- type))))))
- #'(field-type ...)
- #'((custom-serializer ...) ...))))
- #`(begin
- (define-record-type* #,(id #'stem #'< #'stem #'>)
- #,(id #'stem #'% #'stem)
- #,(id #'stem #'make- #'stem)
- #,(id #'stem #'stem #'?)
- (%location #,(id #'stem #'stem #'-location)
- (default (and=> (current-source-location)
- source-properties->location))
- (innate))
- #,@(map (lambda (name getter def)
- (if (eq? (syntax->datum def) (quote 'undefined))
- #`(#,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)
- (default-value-thunk
- (lambda ()
- (display '#,(id #'stem #'% #'stem))
- (if (eq? (syntax->datum field-default)
- 'undefined)
- (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)))))))
+ ((_ stem (field field-type+def doc custom-serializer ...) ...)
+ (with-syntax
+ ((((field-type def) ...)
+ (map normalize-field-type+def #'(field-type+def ...))))
+ (with-syntax
+ (((field-getter ...)
+ (map (lambda (field)
+ (id #'stem #'stem #'- field))
+ #'(field ...)))
+ ((field-predicate ...)
+ (map (lambda (type)
+ (id #'stem type #'?))
+ #'(field-type ...)))
+ ((field-default ...)
+ (map (match-lambda
+ ((field-type default-value)
+ default-value))
+ #'((field-type def) ...)))
+ ((field-serializer ...)
+ (map (lambda (type custom-serializer)
+ (and serialize?
+ (match custom-serializer
+ ((serializer)
+ serializer)
+ (()
+ (if serializer-prefix
+ (id #'stem
+ serializer-prefix
+ #'serialize- type)
+ (id #'stem #'serialize- type))))))
+ #'(field-type ...)
+ #'((custom-serializer ...) ...))))
+ #`(begin
+ (define-record-type* #,(id #'stem #'< #'stem #'>)
+ #,(id #'stem #'% #'stem)
+ #,(id #'stem #'make- #'stem)
+ #,(id #'stem #'stem #'?)
+ (%location #,(id #'stem #'stem #'-location)
+ (default (and=> (current-source-location)
+ source-properties->location))
+ (innate))
+ #,@(map (lambda (name getter def)
+ (if (eq? (syntax->datum def) (quote 'undefined))
+ #`(#,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)
+ (default-value-thunk
+ (lambda ()
+ (display '#,(id #'stem #'% #'stem))
+ (if (eq? (syntax->datum field-default)
+ 'undefined)
+ (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))))))))
(define no-serialization ;syntactic keyword for 'define-configuration'
'(no serialization))
@@ -241,26 +254,26 @@ (define no-serialization ;syntactic keyword for 'define-configuration'
(define-syntax define-configuration
(lambda (s)
(syntax-case s (no-serialization prefix)
- ((_ stem (field (field-type def ...) doc custom-serializer ...) ...
+ ((_ stem (field field-type+def doc custom-serializer ...) ...
(no-serialization))
(define-configuration-helper
- #f #f #'(_ stem (field (field-type def ...) doc custom-serializer ...)
+ #f #f #'(_ stem (field field-type+def doc custom-serializer ...)
...)))
- ((_ stem (field (field-type def ...) doc custom-serializer ...) ...
+ ((_ stem (field field-type+def doc custom-serializer ...) ...
(prefix serializer-prefix))
(define-configuration-helper
- #t #'serializer-prefix #'(_ stem (field (field-type def ...)
+ #t #'serializer-prefix #'(_ stem (field field-type+def
doc custom-serializer ...)
...)))
- ((_ stem (field (field-type def ...) doc custom-serializer ...) ...)
+ ((_ stem (field field-type+def doc custom-serializer ...) ...)
(define-configuration-helper
- #t #f #'(_ stem (field (field-type def ...) doc custom-serializer ...)
+ #t #f #'(_ stem (field field-type+def doc custom-serializer ...)
...))))))
(define-syntax-rule (define-configuration/no-serialization
- stem (field (field-type def ...)
+ stem (field field-type+def
doc custom-serializer ...) ...)
- (define-configuration stem (field (field-type def ...)
+ (define-configuration stem (field field-type+def
doc custom-serializer ...) ...
(no-serialization)))
diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm
index 86a36a388d..0debf8095b 100644
--- a/tests/services/configuration.scm
+++ b/tests/services/configuration.scm
@@ -27,6 +27,9 @@ (define-module (tests services configuration)
(test-begin "services-configuration")
+(define (serialize-number field value)
+ (format #f "~a=~a" field value))
+
\f
;;;
;;; define-configuration macro.
@@ -47,7 +50,6 @@ (define-configuration port-configuration-cs
80
(port-configuration-cs-port (port-configuration-cs)))
-(define serialize-number "")
(define-configuration port-configuration-ndv
(port (number) "The port number."))
@@ -101,15 +103,31 @@ (define-configuration configuration-with-prefix
(define-maybe number)
(define-configuration config-with-maybe-number
- (port (maybe-number 80) "The port number."))
-
-(define (serialize-number field value)
- (format #f "~a=~a" field value))
+ (port (maybe-number 80) "")
+ (count maybe-number ""))
(test-equal "maybe value serialization"
"port=80"
(serialize-maybe-number "port" 80))
+(define (config-with-maybe-number->string x)
+ (eval (gexp->approximate-sexp
+ (serialize-configuration x config-with-maybe-number-fields))
+ (current-module)))
+
+(test-equal "maybe value serialization of the instance"
+ "port=42count=43"
+ (config-with-maybe-number->string
+ (config-with-maybe-number
+ (port 42)
+ (count 43))))
+
+(test-equal "maybe value serialization of the instance, unspecified"
+ "port=42"
+ (config-with-maybe-number->string
+ (config-with-maybe-number
+ (port 42))))
+
(define-maybe/no-serialization string)
(define-configuration config-with-maybe-string/no-serialization
--
2.35.1
next prev parent reply other threads:[~2022-04-20 9:18 UTC|newest]
Thread overview: 23+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-04-01 19:19 [bug#54674] [PATCH] services: configuration: Use *unspecified* instead of 'disabled Attila Lendvai
2022-04-01 19:46 ` Maxime Devos
2022-04-01 19:56 ` Maxime Devos
2022-04-01 19:58 ` Maxime Devos
2022-04-04 7:46 ` Attila Lendvai
2022-04-04 11:25 ` Maxime Devos
2022-04-18 9:26 ` Attila Lendvai
2022-04-07 13:52 ` [bug#54674] [PATCH v2 1/2] services: configuration: Support (field1 maybe-number "") format Attila Lendvai
2022-04-07 13:52 ` [bug#54674] [PATCH v2 2/2] services: configuration: Use *unspecified* instead of 'disabled Attila Lendvai
2022-04-07 15:01 ` [bug#54674] [PATCH v3 1/2] services: configuration: Support (field1 maybe-number "") format Attila Lendvai
2022-04-07 15:01 ` [bug#54674] [PATCH v3 2/2] services: configuration: Use *unspecified* instead of 'disabled Attila Lendvai
2022-04-20 9:15 ` Attila Lendvai [this message]
2022-04-20 9:15 ` [bug#54674] [PATCH v4 " Attila Lendvai
2022-04-23 14:55 ` [bug#54674] [PATCH v4 1/2] services: configuration: Support (field1 maybe-number "") format Maxime Devos
2022-05-17 11:38 ` Attila Lendvai
2022-05-17 16:15 ` Maxime Devos
2022-05-19 14:21 ` Attila Lendvai
2022-05-19 20:41 ` Attila Lendvai
2022-04-24 22:41 ` [bug#54674] [PATCH] doc: Follow the 'disabled -> *unspecified* configuration refactor Attila Lendvai
2022-05-17 11:39 ` [bug#54674] [PATCH v5 1/3] services: configuration: Support (field1 maybe-number "") format Attila Lendvai
2022-05-17 11:39 ` [bug#54674] [PATCH v5 2/3] services: configuration: Use *unspecified* instead of 'disabled Attila Lendvai
2022-05-17 11:39 ` [bug#54674] [PATCH v5 3/3] doc: Follow the 'disabled -> *unspecified* configuration refactor Attila Lendvai
2022-06-14 22:31 ` bug#54674: [PATCH] services: configuration: Use *unspecified* instead of 'disabled Ludovic Courtès
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20220420091553.26732-1-attila@lendvai.name \
--to=attila@lendvai.name \
--cc=54674@debbugs.gnu.org \
/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 external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.