[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#63985] [PATCH RFC 4/5] services: configuration: Add serializer-kwar
From: |
Bruno Victal |
Subject: |
[bug#63985] [PATCH RFC 4/5] services: configuration: Add serializer-kwargs field. |
Date: |
Fri, 9 Jun 2023 22:20:59 +0100 |
Allow relaying additional arguments to a serialize-<type> procedure.
* gnu/services/configuration.scm (configuration-field)
<serializer-kwargs>: New field.
(base-transducer, define-maybe-helper): Adjust to relay additional arguments.
(normalize-extra-args): Implement serializer-kwargs literal.
* tests/services/configuration.scm: Add tests for serializer-kwargs.
---
gnu/services/configuration.scm | 48 +++++++++++++++++++++-----------
tests/services/configuration.scm | 34 ++++++++++++++++++++++
2 files changed, 66 insertions(+), 16 deletions(-)
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 0818b48bb5..b32a5a85ba 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -124,6 +124,7 @@ (define-record-type* <configuration-field>
(predicate configuration-field-predicate)
(sanitizer configuration-field-sanitizer)
(serializer configuration-field-serializer)
+ (serializer-kwargs configuration-field-serializer-kwargs)
(default-value-thunk configuration-field-default-value-thunk)
(documentation configuration-field-documentation))
@@ -139,9 +140,13 @@ (define (base-transducer config)
config)))
(maybe-value-set? field-value))))
(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-kwargs
+ (configuration-field-serializer-kwargs field)))
+ (apply serializer field-name value serializer-kwargs))))))
(define (serialize-configuration config fields)
#~(string-append
@@ -168,10 +173,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
@@ -205,38 +209,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-kwargs* #f))
+ (syntax-case s (sanitizer serializer empty-serializer serializer-kwargs)
(((sanitizer proc) tail ...)
(if sanitizer*
(syntax-violation 'sanitizer
"duplicate entry" #'proc)
- (loop #'(tail ...) #'proc serializer*)))
+ (loop #'(tail ...)
+ #'proc serializer* serializer-kwargs*)))
(((serializer proc) tail ...)
(if serializer*
(syntax-violation 'serializer
"duplicate or conflicting entry" #'proc)
- (loop #'(tail ...) sanitizer* #'proc)))
+ (loop #'(tail ...)
+ sanitizer* #'proc serializer-kwargs*)))
((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-kwargs args) tail ...)
+ (if serializer-kwargs*
+ (syntax-violation 'serializer-kwargs
+ "duplicate or conflicting entry" #f)
+ (loop #'(tail ...)
+ sanitizer* serializer* #'args)))
(() ; stop condition
- (values (list sanitizer* serializer*)))
+ (values (list sanitizer* serializer*
+ (or serializer-kwargs* #'(quote ())))))
((proc) ; TODO: deprecated, to be removed.
- (every not (list sanitizer* serializer*))
+ (every not (list sanitizer* serializer* serializer-kwargs*))
(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-kwargs*) ...)
(map normalize-extra-args #'((extra-args ...) ...))))
(with-syntax
(((field-getter ...)
@@ -322,6 +337,7 @@ (define (define-configuration-helper serialize?
serializer-prefix syn)
(or field-sanitizer
(id #'stem #'validate- #'stem #'- #'field)))
(serializer field-serializer)
+ (serializer-kwargs serializer-kwargs*)
(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 1db83bb273..ae1b194e81 100644
--- a/tests/services/configuration.scm
+++ b/tests/services/configuration.scm
@@ -297,6 +297,40 @@ (define (sanitize-port value)
(lambda _ "lorem")
(sanitizer (lambda () #t)))))))
+(test-group "Serializer 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-kwargs '(#: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-group "Serializer keyword arguments, define-maybe"
+ (define* (serialize-port field value #:key host)
+ (format #f "host=~a,port=~d" host value))
+
+ (define-maybe port)
+
+ (define-configuration kwarg-config
+ (port
+ (maybe-port 80)
+ "Lorem Ipsum."
+ (serializer-kwargs '(#:host "[2001:db8::1]"))))
+
+ (test-equal "keyword argument provided, maybe type"
+ "host=[2001:db8::1],port=80"
+ (eval-gexp
+ (serialize-configuration (kwarg-config)
+ kwarg-config-fields))))
+
;;;
;;; define-maybe macro.
--
2.39.2
- [bug#63985] [PATCH RFC 0/5] Generic INI serializer & SRFI-171 for define-configuration, Bruno Victal, 2023/06/09
- [bug#63985] [PATCH RFC 1/5] services: configuration: Simplify normalize-extra-args., Bruno Victal, 2023/06/09
- [bug#63985] [PATCH RFC 2/5] services: configuration: Use transducers within serialize-configuration., Bruno Victal, 2023/06/09
- [bug#63985] [PATCH RFC 3/5] services: fstrim-service-type: Serialize with SRFI-171 transducers., Bruno Victal, 2023/06/09
- [bug#63985] [PATCH RFC 5/5] services: configuration: New generic-ini module., Bruno Victal, 2023/06/09
- [bug#63985] [PATCH RFC 4/5] services: configuration: Add serializer-kwargs field.,
Bruno Victal <=
- [bug#63985] [PATCH RFC v2 1/5] services: configuration: Simplify normalize-extra-args., Bruno Victal, 2023/06/10
- [bug#63985] [PATCH RFC v2 3/5] services: fstrim-service-type: Serialize with SRFI-171 transducers., Bruno Victal, 2023/06/10
- [bug#63985] [PATCH RFC v2 2/5] services: configuration: Use transducers within serialize-configuration., Bruno Victal, 2023/06/10
- [bug#63985] [PATCH RFC v2 4/5] services: configuration: Add serializer-options field., Bruno Victal, 2023/06/10
- [bug#63985] [PATCH RFC v2 5/5] services: configuration: New generic-ini module., Bruno Victal, 2023/06/10
- [bug#63985] [PATCH v3 00/11] Service subsystem improvements, Bruno Victal, 2023/06/26