diff options
| -rw-r--r-- | gnu/services/configuration.scm | 38 | ||||
| -rw-r--r-- | gnu/services/telephony.scm | 27 | ||||
| -rw-r--r-- | tests/services/configuration.scm | 6 |
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))) |