kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

services: configuration: Support (field1 maybe-number "") format.

Browse Source 
As opposed to explicitly using 'disabled as value, or using the
(field1 (maybe-number) "") format.

It's mostly the work of Maxime Devos shared under #54674, with some
modifications by Attila Lendvai.

* gnu/services/configuration.scm (normalize-field-type+def): New function.
(define-configuration-helper) (define-configuration): Support new field
format.
* tests/services/configuration.scm (config-with-maybe-number->string): New
function.
("maybe value serialization of the instance"): New test.
("maybe value serialization of the instance, unspecified"): New test.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Attila Lendvai 2022-05-17 13:39:26 +02:00 committed by Ludovic Courtès
parent 3d0749b4e3
commit e11517052b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 114 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
gnu/services/configuration.scm
View File

@ -5,6 +5,7 @@
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@ -162,10 +163,26 @@ does not have a default value" field kind)))
(define-syntax-rule (define-maybe/no-serialization stem)
(define-maybe stem (no-serialization)))
(define (normalize-field-type+def s)
(syntax-case s ()
((field-type def)
(identifier? #'field-type)
(values #'(field-type def)))
((field-type)
(identifier? #'field-type)
(values #'(field-type 'disabled)))
(field-type
(identifier? #'field-type)
(values #'(field-type 'disabled)))))
(define (define-configuration-helper serialize? serializer-prefix syn)
(syntax-case syn ()
((_ stem (field (field-type def ...) doc custom-serializer ...) ...)
(with-syntax (((field-getter ...)
((_ stem (field field-type+def doc custom-serializer ...) ...)
(with-syntax
((((field-type def) ...)
(map normalize-field-type+def #'(field-type+def ...))))
(with-syntax
(((field-getter ...)
(map (lambda (field)
(id #'stem #'stem #'- field))
#'(field ...)))
@ -176,12 +193,8 @@ does not have a default value" field kind)))
((field-default ...)
(map (match-lambda
((field-type default-value)
default-value)
((field-type)
;; Quote `undefined' to prevent a possibly
;; unbound warning.
(syntax 'undefined)))
#'((field-type def ...) ...)))
default-value))
#'((field-type def) ...)))
((field-serializer ...)
(map (lambda (type custom-serializer)
(and serialize?
@ -233,7 +246,7 @@ does not have a default value" field kind)))
(let ((conf (#,(id #'stem #'% #'stem) arg (... ...))))
(validate-configuration conf
#,(id #'stem #'stem #'-fields))
conf)))))))
conf))))))))
(define no-serialization ;syntactic keyword for 'define-configuration'
'(no serialization))
@ -241,26 +254,26 @@ does not have a default value" field kind)))
(define-syntax define-configuration
(lambda (s)
(syntax-case s (no-serialization prefix)
((_ stem (field (field-type def ...) doc custom-serializer ...) ...
((_ stem (field field-type+def doc custom-serializer ...) ...
(no-serialization))
(define-configuration-helper
#f #f #'(_ stem (field (field-type def ...) doc custom-serializer ...)
#f #f #'(_ stem (field field-type+def doc custom-serializer ...)
...)))
((_ stem (field (field-type def ...) doc custom-serializer ...) ...
((_ stem (field field-type+def doc custom-serializer ...) ...
(prefix serializer-prefix))
(define-configuration-helper
#t #'serializer-prefix #'(_ stem (field (field-type def ...)
#t #'serializer-prefix #'(_ stem (field field-type+def
doc custom-serializer ...)
...)))
((_ stem (field (field-type def ...) doc custom-serializer ...) ...)
((_ stem (field field-type+def doc custom-serializer ...) ...)
(define-configuration-helper
#t #f #'(_ stem (field (field-type def ...) doc custom-serializer ...)
#t #f #'(_ stem (field field-type+def doc custom-serializer ...)
...))))))
(define-syntax-rule (define-configuration/no-serialization
stem (field (field-type def ...)
stem (field field-type+def
doc custom-serializer ...) ...)
(define-configuration stem (field (field-type def ...)
(define-configuration stem (field field-type+def
doc custom-serializer ...) ...
(no-serialization)))

28
tests/services/configuration.scm
View File

@ -27,6 +27,9 @@
(test-begin "services-configuration")
(define (serialize-number field value)
(format #f "~a=~a" field value))
;;;
;;; define-configuration macro.
@ -47,7 +50,6 @@
80
(port-configuration-cs-port (port-configuration-cs)))
(define serialize-number "")
(define-configuration port-configuration-ndv
(port (number) "The port number."))
@ -101,15 +103,31 @@
(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))
(port (maybe-number 80) "")
(count maybe-number ""))
(test-equal "maybe value serialization"
"port=80"
(serialize-maybe-number "port" 80))
(define (config-with-maybe-number->string x)
(eval (gexp->approximate-sexp
(serialize-configuration x config-with-maybe-number-fields))
(current-module)))
(test-equal "maybe value serialization of the instance"
"port=42count=43"
(config-with-maybe-number->string
(config-with-maybe-number
(port 42)
(count 43))))
(test-equal "maybe value serialization of the instance, unspecified"
"port=42"
(config-with-maybe-number->string
(config-with-maybe-number
(port 42))))
(define-maybe/no-serialization string)
(define-configuration config-with-maybe-string/no-serialization