2 files changed, 39 insertions, 11 deletions

diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index f23840ee6d1..fd07b6fa49e 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -109,14 +109,18 @@ does not have a default value" field kind)))
   "Assemble PARTS into a raw (unhygienic) identifier."
   (datum->syntax ctx (symbol-append (syntax->datum parts) ...)))
 
-(define (define-maybe-helper serialize? syn)
+(define (define-maybe-helper serialize? prefix 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)))
+          (serialize-stem   (if prefix
+                                (id #'stem prefix #'serialize- #'stem)
+                                (id #'stem #'serialize- #'stem)))
+          (serialize-maybe-stem (if prefix
+                                    (id #'stem prefix #'serialize-maybe- #'stem)
+                                    (id #'stem #'serialize-maybe- #'stem))))
        #`(begin
            (define (maybe-stem? val)
              (or (eq? val 'disabled) (stem? val)))
@@ -129,16 +133,18 @@ does not have a default value" field kind)))
 
 (define-syntax define-maybe
   (lambda (x)
-    (syntax-case x (no-serialization)
+    (syntax-case x (no-serialization prefix)
       ((_ stem (no-serialization))
-       (define-maybe-helper #f #'(_ stem)))
+       (define-maybe-helper #f #f #'(_ stem)))
+      ((_ stem (prefix serializer-prefix))
+       (define-maybe-helper #t #'serializer-prefix #'(_ stem)))
       ((_ stem)
-       (define-maybe-helper #t #'(_ stem))))))
+       (define-maybe-helper #t #f #'(_ stem))))))
 
 (define-syntax-rule (define-maybe/no-serialization stem)
   (define-maybe stem (no-serialization)))
 
-(define (define-configuration-helper serialize? syn)
+(define (define-configuration-helper serialize? serializer-prefix syn)
   (syntax-case syn ()
     ((_ stem (field (field-type def ...) doc custom-serializer ...) ...)
      (with-syntax (((field-getter ...)
@@ -165,7 +171,11 @@ does not have a default value" field kind)))
                                   ((serializer)
                                    serializer)
                                   (()
-                                  (id #'stem #'serialize- type)))))
+                                   (if serializer-prefix
+                                       (id #'stem
+                                           serializer-prefix
+                                           #'serialize- type)
+                                       (id #'stem #'serialize- type))))))
                          #'(field-type ...)
                          #'((custom-serializer ...) ...))))
        #`(begin
@@ -212,15 +222,21 @@ does not have a default value" field kind)))
 
 (define-syntax define-configuration
   (lambda (s)
-    (syntax-case s (no-serialization)
+    (syntax-case s (no-serialization prefix)
       ((_ stem (field (field-type def ...) doc custom-serializer ...) ...
           (no-serialization))
        (define-configuration-helper
-         #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 ...) ...
+          (prefix serializer-prefix))
+       (define-configuration-helper
+         #t #'serializer-prefix #'(_ stem (field (field-type def ...)
+                                                 doc custom-serializer ...)
                  ...)))
       ((_ stem (field (field-type def ...) doc custom-serializer ...) ...)
        (define-configuration-helper
-         #t #'(_ 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
diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm
index 85badd2da65..86a36a388d3 100644
--- a/tests/services/configuration.scm
+++ b/tests/services/configuration.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -82,6 +83,17 @@
         (let ((config (serializable-configuration)))
           (serialize-configuration config serializable-configuration-fields)))))
 
+(define (custom-prefix-serialize-integer field-name name) name)
+
+(define-configuration configuration-with-prefix
+  (port (integer 10) "The port number.")
+  (prefix custom-prefix-))
+
+(test-assert "serialize-configuration with prefix"
+  (gexp?
+   (let ((config (configuration-with-prefix)))
+     (serialize-configuration config configuration-with-prefix-fields))))
+
 
 ;;;
 ;;; define-maybe macro.