From b7297d66c58b4fe2c153dce4f1069235269cd005 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sun, 16 May 2021 01:09:39 -0400 Subject: services: configuration: Add a define-maybe/no-serialization syntax. Before this change, using define-maybe along define-configuration with the no-serialization syntactic keyword would result in the following warning: warning: possibly unbound variable `VARIABLE-NAME' This change introduces the define-maybe/no-serialization variant that does away with defining a serialization helper procedure, which makes it possible to avoid the above warning. * gnu/services/configuration.scm (define-maybe/no-serialization): New syntax. (define-maybe-helper): New procedure. (define-maybe): Define syntax using the above procedure. * tests/services/configuration.scm (tests): Fix module name. (custom-number-serializer): Do not print to standard output. (maybe-number?, serialize-maybe-number): New procedures defined via the define-maybe macro. (config-with-maybe-number): New configuration. (serialize-number): New procedure. ("maybe value serialization"): New test. (maybe-string?): New procedure defined via the define-maybe/no-serialization macro. (config-with-maybe-string/no-serialization): New configuration. ("maybe value without serialization no procedure bound"): New test. --- gnu/services/configuration.scm | 37 ++++++++++++++++++++++++++----------- 1 file changed, 26 insertions(+), 11 deletions(-) (limited to 'gnu/services/configuration.scm') diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index 21cb829382..72b1d1cec6 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -48,6 +48,7 @@ (define-module (gnu services configuration) serialize-configuration define-maybe + define-maybe/no-serialization validate-configuration generate-documentation configuration->documentation @@ -107,20 +108,34 @@ (define-syntax-rule (id ctx parts ...) "Assemble PARTS into a raw (unhygienic) identifier." (datum->syntax ctx (symbol-append (syntax->datum parts) ...))) +(define (define-maybe-helper serialize? syn) + (syntax-case syn () + ((_ stem) + (with-syntax + ((stem? (id #'stem #'stem #'?)) + (maybe-stem? (id #'stem #'maybe- #'stem #'?)) + (serialize-stem (id #'stem #'serialize- #'stem)) + (serialize-maybe-stem (id #'stem #'serialize-maybe- #'stem))) + #`(begin + (define (maybe-stem? val) + (or (eq? val 'disabled) (stem? val))) + #,@(if serialize? + (list #'(define (serialize-maybe-stem field-name val) + (if (stem? val) + (serialize-stem field-name val) + ""))) + '())))))) + (define-syntax define-maybe (lambda (x) - (syntax-case x () + (syntax-case x (no-serialization) + ((_ stem (no-serialization)) + (define-maybe-helper #f #'(_ stem))) ((_ stem) - (with-syntax - ((stem? (id #'stem #'stem #'?)) - (maybe-stem? (id #'stem #'maybe- #'stem #'?)) - (serialize-stem (id #'stem #'serialize- #'stem)) - (serialize-maybe-stem (id #'stem #'serialize-maybe- #'stem))) - #'(begin - (define (maybe-stem? val) - (or (eq? val 'disabled) (stem? val))) - (define (serialize-maybe-stem field-name val) - (if (stem? val) (serialize-stem field-name val) "")))))))) + (define-maybe-helper #t #'(_ stem)))))) + +(define-syntax-rule (define-maybe/no-serialization stem) + (define-maybe stem (no-serialization))) (define (define-configuration-helper serialize? syn) (syntax-case syn () -- cgit v1.2.3