[bug#78546,1/3] services: configuration: Add define-enumerated-field-type helper.
Commit Message
* 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
---
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(-)
base-commit: 60025c2425dbac99df1219ed907c7c55e454b932
@@ -75,6 +75,7 @@ (define-module (gnu services configuration)
configuration->documentation
empty-serializer
serialize-package
+ define-enumerated-field-type
filter-configuration-fields
@@ -508,6 +509,19 @@ (define* (interpose ls #:optional (delimiter "\n") (grammar 'infix))
(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
@@ -137,18 +137,6 @@ (define (non-negative-integer? val)
(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
@@ -204,23 +204,6 @@ (define-configuration/no-serialization apcupsd-event-handlers
#~(#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 @@ (define mangle-field-name
('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.")
@@ -141,18 +141,6 @@ (define (ip-mask? val)
#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