From b3e99d33990119276e895909ff8a3aa176cf8a2e Mon Sep 17 00:00:00 2001
From: Xinglu Chen <public@yoctocell.xyz>
Date: Fri, 7 May 2021 22:39:54 -0400
Subject: services: configuration: Allow specifying a custom serializer.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

In some cases, rather than globally disabling serialization, it may be more
appropriate to disable or otherwise alter the serialization procedure of a
specific field.  In large module, multiple configurations may also exist that
would need to alter the default serialization procedure, which is named after
the field type.  Being able to specify a per-field serialization procedure
provides more flexibility.

* gnu/services/configuration.scm (define-configuration): Add an optional
pattern variable to allow specifying a custom serialization procedure.
(define-configuration-helper) <field-serializer>: Use it to transform the
syntax.
(empty-serializer): New procedure.
(serialize-package): Alias to ‘empty-serializer’.

Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
---
 gnu/services/configuration.scm | 38 +++++++++++++++++++++++++-------------
 1 file changed, 25 insertions(+), 13 deletions(-)

(limited to 'gnu/services')

diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 612bfc9e2e..e7eb61efe8 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -40,12 +40,17 @@
             configuration-field-getter
             configuration-field-default-value-thunk
             configuration-field-documentation
+
+            configuration-error?
+
+            define-configuration
+
             serialize-configuration
             define-maybe
-            define-configuration
             validate-configuration
             generate-documentation
             configuration->documentation
+            empty-serializer
             serialize-package))
 
 ;;; Commentary:
@@ -118,7 +123,7 @@ does not have a default value" field kind)))
 
 (define (define-configuration-helper serialize? syn)
   (syntax-case syn ()
-    ((_ stem (field (field-type def ...) doc) ...)
+    ((_ stem (field (field-type def ...) doc custom-serializer ...) ...)
      (with-syntax (((field-getter ...)
                     (map (lambda (field)
                            (id #'stem #'stem #'- field))
@@ -137,11 +142,15 @@ does not have a default value" field kind)))
                             (syntax 'undefined)))
     			 #'((field-type def ...) ...)))
                    ((field-serializer ...)
-                    (map (lambda (type)
-    			   (if serialize?
-    			       (id #'stem #'serialize- type)
-    			       #f))
-    			 #'(field-type ...))))
+                    (map (lambda (type custom-serializer)
+                           (and serialize?
+                                (match custom-serializer
+                                  ((serializer)
+                                   serializer)
+                                  (()
+                                  (id #'stem #'serialize- type)))))
+                         #'(field-type ...)
+                         #'((custom-serializer ...) ...))))
        #`(begin
     	   (define-record-type* #,(id #'stem #'< #'stem #'>)
     	     #,(id #'stem #'% #'stem)
@@ -184,15 +193,18 @@ does not have a default value" field kind)))
 (define-syntax define-configuration
   (lambda (s)
     (syntax-case s (no-serialization)
-      ((_ stem (field (field-type def ...) doc) ... (no-serialization))
+      ((_ stem (field (field-type def ...) doc custom-serializer ...) ...
+          (no-serialization))
        (define-configuration-helper
-         #f #'(_ stem (field (field-type def ...) doc) ...)))
-      ((_ stem (field (field-type def ...) doc) ...)
+         #f #'(_ 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) ...))))))
+         #t #'(_ stem (field (field-type def ...) doc custom-serializer ...)
+                 ...))))))
 
-(define (serialize-package field-name val)
-  "")
+(define (empty-serializer field-name val) "")
+(define serialize-package empty-serializer)
 
 ;; A little helper to make it easier to document all those fields.
 (define (generate-documentation documentation documentation-name)
-- 
cgit v1.2.3