03/06: services: configuration: Allow specifying a custom serializer.

[guix-commits]

apteryx pushed a commit to branch master
in repository guix.

commit b3e99d33990119276e895909ff8a3aa176cf8a2e
Author: Xinglu Chen <public@yoctocell.xyz>
AuthorDate: Fri May 7 22:39:54 2021 -0400

    services: configuration: Allow specifying a custom serializer.
    
    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(-)

diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 612bfc9..e7eb61e 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)