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.master
parent
e7e2b1c10b
commit
b7297d66c5
|
@ -48,6 +48,7 @@
|
||||||
|
|
||||||
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 @@ does not have a default value" field kind)))
|
||||||
"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 ()
|
||||||
|
|
|
@ -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 @@
|
||||||
(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 @@
|
||||||
(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)))
|
||||||
|
|
Reference in New Issue