diff mbox series

[bug#78546,1/3] services: configuration: Add define-enumerated-field-type helper.

Message ID abc454a968ed987ce41af66c632965579e856c81.1747912984.git.sarg@sarg.org.ru
State New
Headers
Series Add iwd-service-type. |

Commit Message

Sergey Trofimov May 22, 2025, 11:32 a.m. UTC 
  * 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 | 13 ++++++++++
 gnu/services/cups.scm          | 12 ---------
 gnu/services/power.scm         | 45 +++++++++++-----------------------
 gnu/services/vpn.scm           | 12 ---------
 4 files changed, 27 insertions(+), 55 deletions(-)


base-commit: ed83953921cd3a2abb09c1709399053c092215a2
prerequisite-patch-id: f9cc903b8048c8c6fde576fbf38ab110263020e3
prerequisite-patch-id: b6d30068ce4971d4d8e67517229916df4e76c529
prerequisite-patch-id: c99e71b3eaa726b8ecf2d9b782d5a6a51476e702
prerequisite-patch-id: 08fa3e98a432063db118aa1502c6bd0166415bdd
prerequisite-patch-id: 95bb686bc7dc0961b89a2900a368f270de065d94
prerequisite-patch-id: f56033bf148a2fdfb5d9321315bdff877ebdb7ba
prerequisite-patch-id: 6d43f84387c6ec611389d6f16c1809cc28a29365
prerequisite-patch-id: 73fabf1570be45886923df86ca4c66e4330c3752
prerequisite-patch-id: 2ed8951b99f17bac7694d7e2c3ed0440e650b0c1
prerequisite-patch-id: 09df1d4083ee7abc4f2f346f8576be31db4d193d
prerequisite-patch-id: bace844ae66e50873074acf659ea8fc33796ac73
prerequisite-patch-id: 58f741d217a355489de150faf91cfa5e111d21b5
prerequisite-patch-id: f7817220252740d4dd3433fa2f689f261b82ae6c
prerequisite-patch-id: 8d312fa060e7f6a2b1d58d40c4ff6dc9f1a529a1
prerequisite-patch-id: 38a9fa9641ee1ec252c7068e1b5f9c1ac3a3281c
prerequisite-patch-id: 500be64418ed5e4994de42cfd99b6c8f15498f9d
diff mbox series

Patch

diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 15eddd7665..659a25f352 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -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,18 @@  (define* (interpose ls  #:optional (delimiter "\n") (grammar 'infix))
                           (cons delimiter acc))))
               '() ls))
 
+(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)))))))
+
 
 ;;;
 ;;; 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 (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
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 @@  (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.")
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 @@  (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