[bug#63985,v3,02/11] services: configuration: Use transducers within serialize-configuration.
Commit Message
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.
---
gnu/services/configuration.scm | 29 ++++++++++++++++++++++++-----
gnu/services/telephony.scm | 27 +++++++++++++--------------
tests/services/configuration.scm | 6 +-----
3 files changed, 38 insertions(+), 24 deletions(-)
Comments
Hello,
Bruno Victal <mirai@makinata.eu> writes:
> 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.
Pretty cool stuff!
> ---
> gnu/services/configuration.scm | 29 ++++++++++++++++++++++++-----
> gnu/services/telephony.scm | 27 +++++++++++++--------------
> tests/services/configuration.scm | 6 +-----
> 3 files changed, 38 insertions(+), 24 deletions(-)
>
> diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
> index dafe72f4fe..cd2cb8318b 100644
> --- a/gnu/services/configuration.scm
> +++ b/gnu/services/configuration.scm
> @@ -42,6 +42,7 @@ (define-module (gnu services configuration)
> #: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-module (gnu services configuration)
> define-configuration/no-serialization
> no-serialization
>
> + empty-serializer?
> + tfilter-maybe-value
> + base-transducer
> +
> serialize-configuration
> define-maybe
> define-maybe/no-serialization
> @@ -125,13 +130,27 @@ (define-record-type* <configuration-field>
> (default-value-thunk configuration-field-default-value-thunk)
> (documentation configuration-field-documentation))
>
> +(define (empty-serializer? field)
> + (eq? empty-serializer
> + (configuration-field-serializer field)))
> +
> +(define (tfilter-maybe-value config)
> + (tfilter (lambda (field)
> + (let ((field-value ((configuration-field-getter field) config)))
> + (maybe-value-set? field-value)))))
> +
> +(define (base-transducer config)
> + (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))))))
> +
Please add docstrings.
> (define (serialize-configuration config fields)
> #~(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)))
>
While at it, please add a docstring for this procedure as well.
> (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 @@ (define-module (gnu services telephony)
> #: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 @@ (define (jami-account->alist jami-account-object)
> ('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))
Could you please state in a comment under "(define
jami-account-transducer" why the base transducer doesn't suffice? It
isn't obvious to me from a casual inspection. I guess it's because
base-transducer is not recursive? Should it be?
> (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-maybe symbol)
> (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)))
That's nice, though I don't understand why gexp->approximate needs to be
turned into eval-gexp?
On 2023-10-02 18:25, Maxim Cournoyer wrote:
> Bruno Victal <mirai@makinata.eu> writes:
>> 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
>> @@ -204,22 +205,20 @@ (define (jami-account->alist jami-account-object)
>> ('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))
>
> Could you please state in a comment under "(define
> jami-account-transducer" why the base transducer doesn't suffice? It
> isn't obvious to me from a casual inspection. I guess it's because
> base-transducer is not recursive? Should it be?
This is because you're changing the field names of the JAMI-ACCOUNT record type
through `field-name->account-detail'.
Conventional serializers are (serializer (field-name value)) procedures and this is
how `base-transducer' calls them. Here you want to do something of the sort
(serializer (translate-field-name name) value) so a custom transducer was written to
account for this detour.
I wonder if we could simply this with some functional programming as discussed in
[1] instead.
>> (test-equal "symbol maybe value serialization, unspecified"
>> ""
>> - (gexp->approximate-sexp
>> + (eval-gexp
>> (serialize-configuration (config-with-maybe-symbol)
>> config-with-maybe-symbol-fields)))
>
> That's nice, though I don't understand why gexp->approximate needs to be
> turned into eval-gexp?
Using `gexp->approximate-sexp' alone doesn't result in a evaluation of the
serialization process so eval-gexp has to be used in order to actually perform
this test.
[1]: Message-ID: <673081be-14c1-4864-9bd1-1cbc908823a6@makinata.eu>
Link: <https://lists.gnu.org/archive/html/guix-patches/2023-10/msg00313.html>
Hello,
Bruno Victal <mirai@makinata.eu> writes:
> On 2023-10-02 18:25, Maxim Cournoyer wrote:
>> Bruno Victal <mirai@makinata.eu> writes:
>>> 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
>>> @@ -204,22 +205,20 @@ (define (jami-account->alist jami-account-object)
>>> ('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))
>>
>> Could you please state in a comment under "(define
>> jami-account-transducer" why the base transducer doesn't suffice? It
>> isn't obvious to me from a casual inspection. I guess it's because
>> base-transducer is not recursive? Should it be?
>
> This is because you're changing the field names of the JAMI-ACCOUNT record type
> through `field-name->account-detail'.
> Conventional serializers are (serializer (field-name value)) procedures and this is
> how `base-transducer' calls them. Here you want to do something of the sort
> (serializer (translate-field-name name) value) so a custom transducer was written to
> account for this detour.
>
> I wonder if we could simply this with some functional programming as discussed in
> [1] instead.
>
>>> (test-equal "symbol maybe value serialization, unspecified"
>>> ""
>>> - (gexp->approximate-sexp
>>> + (eval-gexp
>>> (serialize-configuration (config-with-maybe-symbol)
>>> config-with-maybe-symbol-fields)))
>>
>> That's nice, though I don't understand why gexp->approximate needs to be
>> turned into eval-gexp?
>
> Using `gexp->approximate-sexp' alone doesn't result in a evaluation of the
> serialization process so eval-gexp has to be used in order to actually perform
> this test.
Great, thanks for the explanations!
@@ -42,6 +42,7 @@ (define-module (gnu services configuration)
#: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-module (gnu services configuration)
define-configuration/no-serialization
no-serialization
+ empty-serializer?
+ tfilter-maybe-value
+ base-transducer
+
serialize-configuration
define-maybe
define-maybe/no-serialization
@@ -125,13 +130,27 @@ (define-record-type* <configuration-field>
(default-value-thunk configuration-field-default-value-thunk)
(documentation configuration-field-documentation))
+(define (empty-serializer? field)
+ (eq? empty-serializer
+ (configuration-field-serializer field)))
+
+(define (tfilter-maybe-value config)
+ (tfilter (lambda (field)
+ (let ((field-value ((configuration-field-getter field) config)))
+ (maybe-value-set? field-value)))))
+
+(define (base-transducer config)
+ (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)
#~(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."
@@ -37,6 +37,7 @@ (define-module (gnu services telephony)
#: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 @@ (define (jami-account->alist jami-account-object)
('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)
@@ -337,13 +337,9 @@ (define-maybe symbol)
(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)))