| Message ID | 3ff11bf98a7658400615305609654432a4f30bb0.1687816734.git.mirai@makinata.eu |
|---|---|
| State | New |
| Headers | show |
| Series | Service subsystem improvements | expand |
Hi Bruno, Bruno Victal <mirai@makinata.eu> writes: > 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. Interesting! > --- > 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))))) Could you offer some of your perspective as to why you preferred that approach compared to generating multiple, tailored for use, serializers, possibly created via a procedure? Was there a problem with doing so, or what is less readable, etc.?
Hi Maxim, On 2023-10-02 20:12, Maxim Cournoyer wrote: > Could you offer some of your perspective as to why you preferred that > approach compared to generating multiple, tailored for use, serializers, > possibly created via a procedure? Was there a problem with doing so, or > what is less readable, etc.? Right, as already pointed out by Liliana in [1]. As for the perspective I'm afraid the reason is a rather unexciting one: I completely overlooked that it was another¹ approach that could have been done instead! (and a much simpler one at that) I'm dropping this one as well since it's clear now that there's a cleaner approach for passing these kinds of additional data. [1]: Message-ID: <6445e508cbc8a9f92d3a54263193936d168cd7cf.camel@gmail.com> Link: <https://lists.gnu.org/archive/html/guix-patches/2023-09/msg01205.html> ¹PS: Example attached for any future readers interested in the topic.
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))))) + ;;; ;;; define-maybe macro.