mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
services: configuration: Use transducers within serialize-configuration.
Introduces 'base-transducer', a SRFI-171 based transducer that can be used as a starting point for writing custom configuration record serializing procedures. This also fixes the symbol maybe-value serialization test case. * gnu/services/configuration.scm (empty-serializer?): New predicate. (base-transducer, tfilter-maybe-value): New procedure. (serialize-configuration): Adapt to use base-transducer. * gnu/services/telephony.scm (jami-account->alist): Use transducers to skip fields that are unserializable or whose field maybe-value is unset. * tests/services/configuration.scm: Remove test-expect-fail. Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
This commit is contained in:
parent
1b29e5db8f
commit
a7994ed58d
3 changed files with 47 additions and 24 deletions
|
@ -42,6 +42,7 @@ (define-module (gnu services configuration)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-35)
|
#:use-module (srfi srfi-35)
|
||||||
|
#:use-module (srfi srfi-171)
|
||||||
#:export (configuration-field
|
#:export (configuration-field
|
||||||
configuration-field-name
|
configuration-field-name
|
||||||
configuration-field-type
|
configuration-field-type
|
||||||
|
@ -59,6 +60,10 @@ (define-module (gnu services configuration)
|
||||||
define-configuration/no-serialization
|
define-configuration/no-serialization
|
||||||
no-serialization
|
no-serialization
|
||||||
|
|
||||||
|
empty-serializer?
|
||||||
|
tfilter-maybe-value
|
||||||
|
base-transducer
|
||||||
|
|
||||||
serialize-configuration
|
serialize-configuration
|
||||||
define-maybe
|
define-maybe
|
||||||
define-maybe/no-serialization
|
define-maybe/no-serialization
|
||||||
|
@ -125,13 +130,36 @@ (define-record-type* <configuration-field>
|
||||||
(default-value-thunk configuration-field-default-value-thunk)
|
(default-value-thunk configuration-field-default-value-thunk)
|
||||||
(documentation configuration-field-documentation))
|
(documentation configuration-field-documentation))
|
||||||
|
|
||||||
|
(define (empty-serializer? field)
|
||||||
|
"Predicate that checks whether FIELD is exempt from serialization."
|
||||||
|
(eq? empty-serializer
|
||||||
|
(configuration-field-serializer field)))
|
||||||
|
|
||||||
|
(define (tfilter-maybe-value config)
|
||||||
|
"Return a transducer for CONFIG that removes all maybe-type fields whose
|
||||||
|
value is '%unset-marker."
|
||||||
|
(tfilter (lambda (field)
|
||||||
|
(let ((field-value ((configuration-field-getter field) config)))
|
||||||
|
(maybe-value-set? field-value)))))
|
||||||
|
|
||||||
|
(define (base-transducer config)
|
||||||
|
"Return a transducer for CONFIG that calls the serializing procedures only
|
||||||
|
for fields marked for serialization and whose values are not '%unset-marker."
|
||||||
|
(compose (tremove empty-serializer?)
|
||||||
|
;; Only serialize fields whose value isn't '%unset-marker%.
|
||||||
|
(tfilter-maybe-value config)
|
||||||
|
(tmap (lambda (field)
|
||||||
|
((configuration-field-serializer field)
|
||||||
|
(configuration-field-name field)
|
||||||
|
((configuration-field-getter field) config))))))
|
||||||
|
|
||||||
(define (serialize-configuration config fields)
|
(define (serialize-configuration config fields)
|
||||||
|
"Return a G-expression that contains the values corresponding to the
|
||||||
|
FIELDS of CONFIG, a record that has been generated by `define-configuration'.
|
||||||
|
The G-expression can then be serialized to disk by using something like
|
||||||
|
`mixed-text-file'."
|
||||||
#~(string-append
|
#~(string-append
|
||||||
#$@(map (lambda (field)
|
#$@(list-transduce (base-transducer config) rcons fields)))
|
||||||
((configuration-field-serializer field)
|
|
||||||
(configuration-field-name field)
|
|
||||||
((configuration-field-getter field) config)))
|
|
||||||
fields)))
|
|
||||||
|
|
||||||
(define-syntax-rule (id ctx parts ...)
|
(define-syntax-rule (id ctx parts ...)
|
||||||
"Assemble PARTS into a raw (unhygienic) identifier."
|
"Assemble PARTS into a raw (unhygienic) identifier."
|
||||||
|
|
|
@ -37,6 +37,7 @@ (define-module (gnu services telephony)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-2)
|
#:use-module (srfi srfi-2)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
|
#:use-module (srfi srfi-171)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:export (jami-account
|
#:export (jami-account
|
||||||
|
@ -204,22 +205,20 @@ (define (field-name->account-detail name)
|
||||||
('rendezvous-point? "Account.rendezVous")
|
('rendezvous-point? "Account.rendezVous")
|
||||||
('peer-discovery? "Account.peerDiscovery")
|
('peer-discovery? "Account.peerDiscovery")
|
||||||
('bootstrap-hostnames "Account.hostname")
|
('bootstrap-hostnames "Account.hostname")
|
||||||
('name-server-uri "RingNS.uri")
|
('name-server-uri "RingNS.uri")))
|
||||||
(_ #f)))
|
|
||||||
|
|
||||||
(filter-map (lambda (field)
|
(define jami-account-transducer
|
||||||
(and-let* ((name (field-name->account-detail
|
(compose (tremove empty-serializer?)
|
||||||
|
(tfilter-maybe-value jami-account-object)
|
||||||
|
(tmap (lambda (field)
|
||||||
|
(let* ((name (field-name->account-detail
|
||||||
(configuration-field-name field)))
|
(configuration-field-name field)))
|
||||||
(value ((configuration-field-serializer field)
|
(value ((configuration-field-serializer field)
|
||||||
name ((configuration-field-getter field)
|
name ((configuration-field-getter field)
|
||||||
jami-account-object)))
|
jami-account-object))))
|
||||||
;; The define-maybe default serializer produces an
|
(cons name value))))))
|
||||||
;; empty string for unspecified values.
|
|
||||||
(value* (if (string-null? value)
|
(list-transduce jami-account-transducer rcons jami-account-fields))
|
||||||
#f
|
|
||||||
value)))
|
|
||||||
(cons name value*)))
|
|
||||||
jami-account-fields))
|
|
||||||
|
|
||||||
(define (jami-account-list? val)
|
(define (jami-account-list? val)
|
||||||
(and (list? val)
|
(and (list? val)
|
||||||
|
|
|
@ -337,13 +337,9 @@ (define-maybe symbol)
|
||||||
(define-configuration config-with-maybe-symbol
|
(define-configuration config-with-maybe-symbol
|
||||||
(protocol maybe-symbol ""))
|
(protocol maybe-symbol ""))
|
||||||
|
|
||||||
;;; Maybe symbol values are currently seen as serializable, because the
|
|
||||||
;;; unspecified value is '%unset-marker%, which is a symbol itself.
|
|
||||||
;;; TODO: Remove expected fail marker after resolution.
|
|
||||||
(test-expect-fail 1)
|
|
||||||
(test-equal "symbol maybe value serialization, unspecified"
|
(test-equal "symbol maybe value serialization, unspecified"
|
||||||
""
|
""
|
||||||
(gexp->approximate-sexp
|
(eval-gexp
|
||||||
(serialize-configuration (config-with-maybe-symbol)
|
(serialize-configuration (config-with-maybe-symbol)
|
||||||
config-with-maybe-symbol-fields)))
|
config-with-maybe-symbol-fields)))
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue