me
/
guix
Archived
1
0
Fork 0
Code

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>
master
Xinglu Chen 2021-05-07 22:39:54 -04:00 committed by Maxim Cournoyer
parent 3f9a12dc08
commit b3e99d3399
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
1 changed files with 25 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
gnu/services/configuration.scm
View File

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