From: Bruno Victal <mirai@makinata.eu>
To: 63985@debbugs.gnu.org
Cc: Bruno Victal <mirai@makinata.eu>
Subject: [bug#63985] [PATCH v3 05/11] services: configuration: Add serializer-options field.
Date: Mon, 26 Jun 2023 22:59:31 +0100 [thread overview]
Message-ID: <3ff11bf98a7658400615305609654432a4f30bb0.1687816734.git.mirai@makinata.eu> (raw)
In-Reply-To: <cover.1687816304.git.mirai@makinata.eu>
Allow relaying additional arguments to a serialize-<type> procedure.
* gnu/services/configuration.scm (configuration-field)
<serializer-options>: New field.
(base-transducer, define-maybe-helper): Adjust to relay additional arguments.
(normalize-extra-args): Implement serializer-options literal.
* tests/services/configuration.scm: Add tests for serializer-options.
* doc/guix.texi (Complex Configurations): Document serializer-options.
---
doc/guix.texi | 11 +++++
gnu/services/configuration.scm | 49 ++++++++++++-------
tests/services/configuration.scm | 82 ++++++++++++++++++++++++++++++++
3 files changed, 126 insertions(+), 16 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 8355260378..14802e9366 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -42032,6 +42032,17 @@ Complex Configurations
((symbol? value) (symbol->string value))
(else (error "bad value"))))
@end lisp
+
+@item @code{(serializer-options @var{arglst})}
+@var{arglst} is a list of extra arguments that are relayed to the
+serializing procedure. This allows for writing serialization
+procedures that take more than two arguments.
+
+An example of a serializer procedure that requires additional data:
+@lisp
+(define* (serialize-port field value #:key context)
+ #~(format #f "section=~a,port=~d" #$context #$value))
+@end lisp
@end table
In some cases multiple different configuration records might be defined
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index cd2cb8318b..4eee5a26c2 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -50,6 +50,7 @@ (define-module (gnu services configuration)
configuration-field-error
configuration-field-sanitizer
configuration-field-serializer
+ configuration-field-serializer-options
configuration-field-getter
configuration-field-default-value-thunk
configuration-field-documentation
@@ -127,6 +128,7 @@ (define-record-type* <configuration-field>
(predicate configuration-field-predicate)
(sanitizer configuration-field-sanitizer)
(serializer configuration-field-serializer)
+ (serializer-options configuration-field-serializer-options)
(default-value-thunk configuration-field-default-value-thunk)
(documentation configuration-field-documentation))
@@ -144,9 +146,13 @@ (define (base-transducer config)
;; Only serialize fields whose value isn't '%unset-marker%.
(tfilter-maybe-value config)
(tmap (lambda (field)
- ((configuration-field-serializer field)
- (configuration-field-name field)
- ((configuration-field-getter field) config))))))
+ (let ((serializer (configuration-field-serializer field))
+ (field-name (configuration-field-name field))
+ (value
+ ((configuration-field-getter field) config))
+ (serializer-options
+ (configuration-field-serializer-options field)))
+ (apply serializer field-name value serializer-options))))))
(define (serialize-configuration config fields)
#~(string-append
@@ -173,10 +179,9 @@ (define (define-maybe-helper serialize? prefix syn)
(or (not (maybe-value-set? val))
(stem? val)))
#,@(if serialize?
- (list #'(define (serialize-maybe-stem field-name val)
- (if (stem? val)
- (serialize-stem field-name val)
- "")))
+ (list #'(define (serialize-maybe-stem field-name val . rest)
+ (when (maybe-value-set? val)
+ (apply serialize-stem field-name val rest))))
'()))))))
(define-syntax define-maybe
@@ -210,38 +215,49 @@ (define (define-configuration-helper serialize? serializer-prefix syn)
"Extract and normalize arguments following @var{doc}."
(let loop ((s s)
(sanitizer* #f)
- (serializer* #f))
- (syntax-case s (sanitizer serializer empty-serializer)
+ (serializer* #f)
+ (serializer-options* #f))
+ (syntax-case s (sanitizer serializer empty-serializer serializer-options)
(((sanitizer proc) tail ...)
(if sanitizer*
(syntax-violation 'sanitizer
"duplicate entry" #'proc)
- (loop #'(tail ...) #'proc serializer*)))
+ (loop #'(tail ...)
+ #'proc serializer* serializer-options*)))
(((serializer proc) tail ...)
(if serializer*
(syntax-violation 'serializer
"duplicate or conflicting entry" #'proc)
- (loop #'(tail ...) sanitizer* #'proc)))
+ (loop #'(tail ...)
+ sanitizer* #'proc serializer-options*)))
((empty-serializer tail ...)
(if serializer*
(syntax-violation 'empty-serializer
"duplicate or conflicting entry" #f)
- (loop #'(tail ...) sanitizer* #'empty-serializer)))
+ (loop #'(tail ...)
+ sanitizer* #'empty-serializer #f)))
+ (((serializer-options args) tail ...)
+ (if serializer-options*
+ (syntax-violation 'serializer-options
+ "duplicate or conflicting entry" #f)
+ (loop #'(tail ...)
+ sanitizer* serializer* #'args)))
(() ; stop condition
- (values (list sanitizer* serializer*)))
+ (values (list sanitizer* serializer*
+ (or serializer-options* #'(quote ())))))
((proc) ; TODO: deprecated, to be removed.
- (every not (list sanitizer* serializer*))
+ (every not (list sanitizer* serializer* serializer-options*))
(begin
(warning #f (G_ "specifying serializers after documentation is \
deprecated, use (serializer ~a) instead~%") (syntax->datum #'proc))
- (values (list #f #'proc)))))))
+ (values (list #f #'proc #'(quote ()))))))))
(syntax-case syn ()
((_ stem (field field-type+def doc extra-args ...) ...)
(with-syntax
((((field-type def) ...)
(map normalize-field-type+def #'(field-type+def ...)))
- (((sanitizer* serializer*) ...)
+ (((sanitizer* serializer* serializer-options*) ...)
(map normalize-extra-args #'((extra-args ...) ...))))
(with-syntax
(((field-getter ...)
@@ -327,6 +343,7 @@ (define (define-configuration-helper serialize? serializer-prefix syn)
(or field-sanitizer
(id #'stem #'validate- #'stem #'- #'field)))
(serializer field-serializer)
+ (serializer-options serializer-options*)
(default-value-thunk
(lambda ()
(if (maybe-value-set? (syntax->datum field-default))
diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm
index 40a4e74b4d..8b1d1e4749 100644
--- a/tests/services/configuration.scm
+++ b/tests/services/configuration.scm
@@ -297,6 +297,88 @@ (define (sanitize-port value)
(lambda _ "lorem")
(sanitizer (lambda () #t)))))))
+(test-group "Serializer options"
+ (test-group "Serialize keyword arguments"
+ (define* (serialize-port field value #:key host)
+ (format #f "host=~a,port=~d" host value))
+
+ (define-configuration kwarg-config
+ (port
+ (port 80)
+ "Lorem Ipsum."
+ (serializer-options '(#:host "[2001:db8::1]"))))
+
+ (define-maybe port)
+ (define-configuration kwarg-maybe-config
+ (port
+ (maybe-port 80)
+ "Lorem Ipsum."
+ (serializer-options '(#:host "[2001:db8::1]"))))
+
+ (test-equal "keyword argument provided"
+ "host=[2001:db8::1],port=80"
+ (eval-gexp
+ (serialize-configuration (kwarg-config)
+ kwarg-config-fields)))
+
+ (test-equal "keyword argument provided, maybe type"
+ "host=[2001:db8::1],port=80"
+ (eval-gexp
+ (serialize-configuration (kwarg-maybe-config)
+ kwarg-maybe-config-fields))))
+
+ (test-group "Serialize optional arguments"
+ (define* (serialize-port field-name value #:optional override-name)
+ (format #f "~a=~d" (or override-name field-name) value))
+
+ (define-configuration with-optarg
+ (port
+ (port 80)
+ "Lorem Ipsum."
+ (serializer-options '(service-port))))
+
+ (define-configuration without-optarg
+ (port
+ (port 80)
+ "Lorem Ipsum."))
+
+ (test-equal "optional argument, provided"
+ "service-port=80"
+ (eval-gexp (serialize-configuration (with-optarg)
+ with-optarg-fields)))
+
+ (test-equal "optional argument, absent"
+ "port=80"
+ (eval-gexp (serialize-configuration (without-optarg)
+ without-optarg-fields))))
+
+ (test-group "Serialize optional & keyword arguments"
+ (define* (serialize-port field-name value #:optional override-name
+ #:key host)
+ (format #f "host=~a,~a=~d" host (or override-name field-name) value))
+
+ (define-configuration mixed-args
+ (port
+ (port 80)
+ "Lorem Ipsum."
+ (serializer-options '(service-port #:host "example.com"))))
+
+ (define-configuration mixed-no-optarg
+ (port
+ (port 80)
+ "Lorem Ipsum."
+ (serializer-options '(#:host "example.com"))))
+
+ (test-equal "mixed arguments, optional provided"
+ "host=example.com,service-port=80"
+ (eval-gexp (serialize-configuration (mixed-args)
+ mixed-args-fields)))
+
+ (test-equal "mixed arguments, optional absent"
+ "host=example.com,port=80"
+ (eval-gexp (serialize-configuration (mixed-no-optarg)
+ mixed-no-optarg-fields)))))
+
\f
;;;
;;; define-maybe macro.
--
2.39.2
next prev parent reply other threads:[~2023-06-26 22:01 UTC|newest]
Thread overview: 50+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-06-09 21:18 [bug#63985] [PATCH RFC 0/5] Generic INI serializer & SRFI-171 for define-configuration Bruno Victal
2023-06-09 21:20 ` [bug#63985] [PATCH RFC 1/5] services: configuration: Simplify normalize-extra-args Bruno Victal
2023-06-09 21:20 ` [bug#63985] [PATCH RFC 2/5] services: configuration: Use transducers within serialize-configuration Bruno Victal
2023-06-09 21:20 ` [bug#63985] [PATCH RFC 3/5] services: fstrim-service-type: Serialize with SRFI-171 transducers Bruno Victal
2023-06-09 21:20 ` [bug#63985] [PATCH RFC 4/5] services: configuration: Add serializer-kwargs field Bruno Victal
2023-06-09 21:21 ` [bug#63985] [PATCH RFC 5/5] services: configuration: New generic-ini module Bruno Victal
2023-06-10 20:10 ` [bug#63985] [PATCH RFC v2 1/5] services: configuration: Simplify normalize-extra-args Bruno Victal
2023-06-10 20:10 ` [bug#63985] [PATCH RFC v2 2/5] services: configuration: Use transducers within serialize-configuration Bruno Victal
2023-06-10 20:10 ` [bug#63985] [PATCH RFC v2 3/5] services: fstrim-service-type: Serialize with SRFI-171 transducers Bruno Victal
2023-06-10 20:10 ` [bug#63985] [PATCH RFC v2 4/5] services: configuration: Add serializer-options field Bruno Victal
2023-06-10 20:10 ` [bug#63985] [PATCH RFC v2 5/5] services: configuration: New generic-ini module Bruno Victal
2023-06-26 21:57 ` [bug#63985] [PATCH v3 00/11] Service subsystem improvements Bruno Victal
2023-06-26 21:59 ` [bug#63985] [PATCH v3 01/11] services: configuration: Simplify normalize-extra-args Bruno Victal
2023-10-02 17:00 ` [bug#63985] [PATCH RFC 0/5] Generic INI serializer & SRFI-171 for define-configuration Maxim Cournoyer
2023-10-07 12:36 ` [bug#63985] [PATCH v3 01/11] services: configuration: Simplify normalize-extra-args. (was: bug#63985: [PATCH RFC 0/5] Generic INI serializer & SRFI-171 for define-configuration) Bruno Victal
2023-06-26 21:59 ` [bug#63985] [PATCH v3 02/11] services: configuration: Use transducers within serialize-configuration Bruno Victal
2023-10-02 17:25 ` [bug#63985] [PATCH RFC 0/5] Generic INI serializer & SRFI-171 for define-configuration Maxim Cournoyer
2023-10-07 13:39 ` [bug#63985] [PATCH v3 02/11] services: configuration: Use transducers within serialize-configuration. (was : bug#63985: [PATCH RFC 0/5] Generic INI serializer & SRFI-171 for define-configuration) Bruno Victal
2023-10-07 14:37 ` Maxim Cournoyer
2023-06-26 21:59 ` [bug#63985] [PATCH v3 03/11] services: fstrim-service-type: Serialize with SRFI-171 transducers Bruno Victal
2023-06-26 21:59 ` [bug#63985] [PATCH v3 04/11] doc: Rewrite define-configuration Bruno Victal
2023-10-02 18:28 ` [bug#63985] [PATCH RFC 0/5] Generic INI serializer & SRFI-171 for define-configuration Maxim Cournoyer
2023-10-07 14:21 ` Bruno Victal
2023-10-07 16:35 ` Maxim Cournoyer
2023-06-26 21:59 ` Bruno Victal [this message]
2023-10-02 19:12 ` Maxim Cournoyer
2023-10-06 18:29 ` Bruno Victal
2023-06-26 21:59 ` [bug#63985] [PATCH v3 06/11] services: configuration: New generic-ini module Bruno Victal
2023-10-02 19:15 ` [bug#63985] [PATCH RFC 0/5] Generic INI serializer & SRFI-171 for define-configuration Maxim Cournoyer
2023-06-26 21:59 ` [bug#63985] [PATCH v3 07/11] services: configuration: Add some commonly used predicates Bruno Victal
2023-06-26 21:59 ` [bug#63985] [PATCH v3 08/11] services: NetworkManager: Use define-configuration and generic-ini Bruno Victal
2023-06-26 21:59 ` [bug#63985] [PATCH v3 09/11] services: NetworkManager: Prefer package over network-manager Bruno Victal
2023-10-02 16:52 ` [bug#63985] [PATCH RFC 0/5] Generic INI serializer & SRFI-171 for define-configuration Maxim Cournoyer
2023-06-26 21:59 ` [bug#63985] [PATCH v3 10/11] services: NetworkManager: add log-configuration field Bruno Victal
2023-10-05 16:57 ` Maxim Cournoyer
2023-06-26 21:59 ` [bug#63985] [PATCH v3 11/11] services: NetworkManager: Add extra-options field Bruno Victal
2023-10-05 16:59 ` Maxim Cournoyer
2023-06-27 4:20 ` [bug#63985] [PATCH v3 00/11] Service subsystem improvements Liliana Marie Prikler
2023-09-16 21:22 ` Bruno Victal
2023-09-16 21:55 ` Liliana Marie Prikler
2023-09-23 13:35 ` Bruno Victal
2023-09-23 15:22 ` Liliana Marie Prikler
2023-09-25 14:06 ` Ludovic Courtès
2023-10-07 15:57 ` [bug#63985] [PATCH v4 0/5] SRFI-171 based improvements for define-configuration Bruno Victal
2023-10-07 15:57 ` [bug#63985] [PATCH v4 2/5] services: configuration: Use transducers within serialize-configuration Bruno Victal
2023-10-07 15:59 ` [bug#63985] [PATCH v4 1/5] services: configuration: Simplify normalize-extra-args Bruno Victal
2023-10-07 15:59 ` [bug#63985] [PATCH v4 3/5] services: fstrim-service-type: Serialize with SRFI-171 transducers Bruno Victal
2023-10-07 15:59 ` [bug#63985] [PATCH v4 4/5] doc: Rewrite define-configuration Bruno Victal
2023-10-07 15:59 ` [bug#63985] [PATCH v4 5/5] services: configuration: Add some commonly used predicates Bruno Victal
2023-10-07 16:57 ` bug#63985: SRFI-171 based improvements for define-configuration 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=3ff11bf98a7658400615305609654432a4f30bb0.1687816734.git.mirai@makinata.eu \
--to=mirai@makinata.eu \
--cc=63985@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 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).