summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
authorXinglu Chen <public@yoctocell.xyz>2021-05-07 22:39:54 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2021-05-08 00:50:39 -0400
commitb3e99d33990119276e895909ff8a3aa176cf8a2e (patch)
treecbc1d125f2f30f7d1d111761448bb598742fe120 /gnu/services
parent3f9a12dc082b20426fc740416601b69ea1897193 (diff)
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>
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/configuration.scm38
1 files changed, 25 insertions, 13 deletions
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)