mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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>
This commit is contained in:
parent
3f9a12dc08
commit
b3e99d3399
1 changed files with 25 additions and 13 deletions
|
@ -40,12 +40,17 @@ (define-module (gnu services configuration)
|
|||
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 @@ (define (serialize-maybe-stem field-name val)
|
|||
|
||||
(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 @@ (define (define-configuration-helper serialize? syn)
|
|||
(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 @@ (define-syntax-rule (stem arg (... ...))
|
|||
(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)
|
||||
|
|
Loading…
Reference in a new issue