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.
This commit is contained in:
Maxim Cournoyer 2021-05-16 01:09:39 -04:00
parent e7e2b1c10b
commit b7297d66c5
No known key found for this signature in database
GPG key ID: 1260E46482E63562
2 changed files with 53 additions and 13 deletions

View file

@ -48,6 +48,7 @@ (define-module (gnu services configuration)
serialize-configuration serialize-configuration
define-maybe define-maybe
define-maybe/no-serialization
validate-configuration validate-configuration
generate-documentation generate-documentation
configuration->documentation configuration->documentation
@ -107,20 +108,34 @@ (define-syntax-rule (id ctx parts ...)
"Assemble PARTS into a raw (unhygienic) identifier." "Assemble PARTS into a raw (unhygienic) identifier."
(datum->syntax ctx (symbol-append (syntax->datum parts) ...))) (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 (define-syntax define-maybe
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x (no-serialization)
((_ stem (no-serialization))
(define-maybe-helper #f #'(_ stem)))
((_ stem) ((_ stem)
(with-syntax (define-maybe-helper #t #'(_ stem))))))
((stem? (id #'stem #'stem #'?))
(maybe-stem? (id #'stem #'maybe- #'stem #'?)) (define-syntax-rule (define-maybe/no-serialization stem)
(serialize-stem (id #'stem #'serialize- #'stem)) (define-maybe stem (no-serialization)))
(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 (define-configuration-helper serialize? syn) (define (define-configuration-helper serialize? syn)
(syntax-case syn () (syntax-case syn ()

View file

@ -16,7 +16,7 @@
;;; You should have received a copy of the GNU General Public License ;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (tests services linux) (define-module (tests services configuration)
#:use-module (gnu services configuration) #:use-module (gnu services configuration)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
@ -61,7 +61,7 @@ (define-configuration port-configuration-ndv
(port-configuration-ndv-port (port-configuration-ndv)))) (port-configuration-ndv-port (port-configuration-ndv))))
(define (custom-number-serializer name value) (define (custom-number-serializer name value)
(format #t "~a = ~a;" name value)) (format #f "~a = ~a;" name value))
(define-configuration serializable-configuration (define-configuration serializable-configuration
(port (number 80) "The port number." custom-number-serializer)) (port (number 80) "The port number." custom-number-serializer))
@ -81,3 +81,28 @@ (define-configuration serializable-configuration
(not (false-if-exception (not (false-if-exception
(let ((config (serializable-configuration))) (let ((config (serializable-configuration)))
(serialize-configuration config serializable-configuration-fields))))) (serialize-configuration config serializable-configuration-fields)))))
;;;
;;; define-maybe macro.
;;;
(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))
(test-equal "maybe value serialization"
"port=80"
(serialize-maybe-number "port" 80))
(define-maybe/no-serialization string)
(define-configuration config-with-maybe-string/no-serialization
(name (maybe-string) "The name of the item.")
(no-serialization))
(test-assert "maybe value without serialization no procedure bound"
(not (defined? 'serialize-maybe-string)))