aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBruno Victal <mirai@makinata.eu>2023-10-07 16:57:15 +0100
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-10-07 12:41:05 -0400
commita7994ed58dc1ac3b57aa2df8508f05fd0748b3e0 (patch)
tree69aabbc3928eb64e51d7b6871f34a04c98b9606b
parent1b29e5db8f51fcde00a8523f3558c3468ede37c3 (diff)
downloadguix-a7994ed58dc1ac3b57aa2df8508f05fd0748b3e0.tar.gz
guix-a7994ed58dc1ac3b57aa2df8508f05fd0748b3e0.zip
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>
-rw-r--r--gnu/services/configuration.scm38
-rw-r--r--gnu/services/telephony.scm27
-rw-r--r--tests/services/configuration.scm6
3 files changed, 47 insertions, 24 deletions
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index ecc5049a79..aa5fb832d5 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -42,6 +42,7 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (srfi srfi-171)
#:export (configuration-field
configuration-field-name
configuration-field-type
@@ -59,6 +60,10 @@
define-configuration/no-serialization
no-serialization
+ empty-serializer?
+ tfilter-maybe-value
+ base-transducer
+
serialize-configuration
define-maybe
define-maybe/no-serialization
@@ -125,13 +130,36 @@ does not have a default value" field kind)))
(default-value-thunk configuration-field-default-value-thunk)
(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)
+ "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
- #$@(map (lambda (field)
- ((configuration-field-serializer field)
- (configuration-field-name field)
- ((configuration-field-getter field) config)))
- fields)))
+ #$@(list-transduce (base-transducer config) rcons fields)))
(define-syntax-rule (id ctx parts ...)
"Assemble PARTS into a raw (unhygienic) identifier."
diff --git a/gnu/services/telephony.scm b/gnu/services/telephony.scm
index 23ccb8d403..56b7772f58 100644
--- a/gnu/services/telephony.scm
+++ b/gnu/services/telephony.scm
@@ -37,6 +37,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-171)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (jami-account
@@ -204,22 +205,20 @@ SET-ACCOUNT-DETAILS."
('rendezvous-point? "Account.rendezVous")
('peer-discovery? "Account.peerDiscovery")
('bootstrap-hostnames "Account.hostname")
- ('name-server-uri "RingNS.uri")
- (_ #f)))
+ ('name-server-uri "RingNS.uri")))
- (filter-map (lambda (field)
- (and-let* ((name (field-name->account-detail
+ (define jami-account-transducer
+ (compose (tremove empty-serializer?)
+ (tfilter-maybe-value jami-account-object)
+ (tmap (lambda (field)
+ (let* ((name (field-name->account-detail
(configuration-field-name field)))
- (value ((configuration-field-serializer field)
- name ((configuration-field-getter field)
- jami-account-object)))
- ;; The define-maybe default serializer produces an
- ;; empty string for unspecified values.
- (value* (if (string-null? value)
- #f
- value)))
- (cons name value*)))
- jami-account-fields))
+ (value ((configuration-field-serializer field)
+ name ((configuration-field-getter field)
+ jami-account-object))))
+ (cons name value))))))
+
+ (list-transduce jami-account-transducer rcons jami-account-fields))
(define (jami-account-list? val)
(and (list? val)
diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm
index 8ad5907f37..40a4e74b4d 100644
--- a/tests/services/configuration.scm
+++ b/tests/services/configuration.scm
@@ -337,13 +337,9 @@
(define-configuration config-with-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"
""
- (gexp->approximate-sexp
+ (eval-gexp
(serialize-configuration (config-with-maybe-symbol)
config-with-maybe-symbol-fields)))