guix_mirror_bot pushed a commit to branch master
in repository guix.
commit 38756ac03de9c2c70935c2d32a8398117c687ca2
Author: Sergey Trofimov <[email protected]>
AuthorDate: Thu May 22 12:53:01 2025 +0200
services: configuration: Add define-enumerated-field-type helper.
* gnu/services/cups.scm (define-enumerated-field-type): Move...
* gnu/services/configuration.scm (define-enumerated-field-type): ...here.
* gnu/services/vpn.scm (define-enumerated-field-type): Remove.
* gnu/services/power.scm
(define-enum): Replace with define-enumerated-field-type.
Change-Id: I89ec40f479e3f800268e714f1f88d638be017c7e
Signed-off-by: Ludovic Courtès <[email protected]>
---
gnu/services/configuration.scm | 14 +++++++++++++
gnu/services/cups.scm | 12 -----------
gnu/services/power.scm | 45 +++++++++++++-----------------------------
gnu/services/vpn.scm | 12 -----------
4 files changed, 28 insertions(+), 55 deletions(-)
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 15eddd7665..6d9fd1feae 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -75,6 +75,7 @@
configuration->documentation
empty-serializer
serialize-package
+ define-enumerated-field-type
filter-configuration-fields
@@ -508,6 +509,19 @@ DELIMITER interposed LS. Support 'infix and 'suffix
GRAMMAR values."
(cons delimiter acc))))
'() ls))
+(define-syntax define-enumerated-field-type
+ (lambda (x)
+ (syntax-case x (prefix)
+ ((_ name (option ...) (prefix serializer-prefix))
+ #`(begin
+ (define (#,(id #'name #'name #'?) x)
+ (memq x '(option ...)))
+ (define (#,(id #'name #'serializer-prefix #'serialize- #'name)
field-name val)
+ (#,(id #'name #'serializer-prefix #'serialize-field) field-name
val))))
+
+ ((_ name (option ...))
+ #`(define-enumerated-field-type name (option ...) (prefix #{}#))))))
+
;;;
;;; Commonly used predicates
diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm
index 738bb7f5cc..27aac7a16a 100644
--- a/gnu/services/cups.scm
+++ b/gnu/services/cups.scm
@@ -137,18 +137,6 @@
(define (serialize-non-negative-integer field-name val)
(serialize-field field-name val))
-(define-syntax define-enumerated-field-type
- (lambda (x)
- (define (id-append ctx . parts)
- (datum->syntax ctx (apply symbol-append (map syntax->datum parts))))
- (syntax-case x ()
- ((_ name (option ...))
- #`(begin
- (define (#,(id-append #'name #'name #'?) x)
- (memq x '(option ...)))
- (define (#,(id-append #'name #'serialize- #'name) field-name val)
- (serialize-field field-name val)))))))
-
(define-enumerated-field-type access-log-level
(config actions all))
(define-enumerated-field-type browse-local-protocols
diff --git a/gnu/services/power.scm b/gnu/services/power.scm
index ec8ae555d4..ad386549cd 100644
--- a/gnu/services/power.scm
+++ b/gnu/services/power.scm
@@ -204,23 +204,6 @@
#~(#t))
"The handler for the battattach event."))
-(define-syntax define-enum
- (lambda (x)
- (syntax-case x ()
- ((_ name values)
- (let* ((datum/name (syntax->datum #'name))
- (datum/predicate (string->symbol
- (format #f "enum-~a?" datum/name)))
- (datum/serialize (string->symbol
- (format #f "serialize-enum-~a" datum/name))))
- (with-syntax
- ((predicate (datum->syntax x datum/predicate))
- (serialize (datum->syntax x datum/serialize)))
- #'(begin
- (define (predicate value)
- (memq value values))
- (define serialize serialize-symbol))))))))
-
(define mangle-field-name
(match-lambda
('name "UPSNAME")
@@ -252,25 +235,25 @@
('data-time "DATATIME")
('facility "FACILITY")))
-(define (serialize-string field-name value)
+(define (serialize-field field-name value)
#~(format #f "~a ~a\n" #$(mangle-field-name field-name) '#$value))
-(define serialize-symbol serialize-string)
-(define serialize-integer serialize-string)
+(define serialize-string serialize-field)
+(define serialize-symbol serialize-field)
+(define serialize-integer serialize-field)
(define (serialize-boolean field-name value)
- #~(format #f "~a ~a\n"
- #$(mangle-field-name field-name)
- #$(if value "on" "off")))
+ (serialize-field field-name (if value "on" "off")))
(define-maybe string)
-(define-enum cable '( simple smart ether usb
- 940-0119A 940-0127A 940-0128A 940-0020B 940-0020C
- 940-0023A 940-0024B 940-0024C 940-1524C 940-0024G
- 940-0095A 940-0095B 940-0095C 940-0625A MAM-04-02-2000))
-(define-enum type '(apcsmart usb net snmp netsnmp dumb pcnet modbus test))
-(define-enum no-logon '(disable timeout percent minutes always))
-(define-enum class '(standalone shareslave sharemaster))
-(define-enum mode '(disable share))
+(define-enumerated-field-type enum-cable
+ ( simple smart ether usb
+ 940-0119A 940-0127A 940-0128A 940-0020B 940-0020C
+ 940-0023A 940-0024B 940-0024C 940-1524C 940-0024G
+ 940-0095A 940-0095B 940-0095C 940-0625A MAM-04-02-2000))
+(define-enumerated-field-type enum-type (apcsmart usb net snmp netsnmp dumb
pcnet modbus test))
+(define-enumerated-field-type enum-no-logon (disable timeout percent minutes
always))
+(define-enumerated-field-type enum-class (standalone shareslave sharemaster))
+(define-enumerated-field-type enum-mode (disable share))
(define-configuration apcupsd-configuration
(apcupsd (package apcupsd) "The @code{apcupsd} package to use.")
diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index f97cbac7bb..56022ac27a 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -141,18 +141,6 @@
#f)))
(define serialize-ip-mask serialize-string)
-(define-syntax define-enumerated-field-type
- (lambda (x)
- (define (id-append ctx . parts)
- (datum->syntax ctx (apply symbol-append (map syntax->datum parts))))
- (syntax-case x ()
- ((_ name (option ...))
- #`(begin
- (define (#,(id-append #'name #'name #'?) x)
- (memq x '(option ...)))
- (define (#,(id-append #'name #'serialize- #'name) field-name val)
- (serialize-field field-name val)))))))
-
(define-enumerated-field-type proto
(udp tcp udp6 tcp6))
(define-enumerated-field-type dev
