From patchwork Sat Oct 7 15:57:15 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bruno Victal X-Patchwork-Id: 54582 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id D25D927BBE9; Sat, 7 Oct 2023 16:59:23 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 8047327BBE9 for ; Sat, 7 Oct 2023 16:59:22 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qp9ha-0007tW-2k; Sat, 07 Oct 2023 11:58:50 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qp9hT-0007sm-6h for guix-patches@gnu.org; Sat, 07 Oct 2023 11:58:43 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qp9hS-00010T-Sl for guix-patches@gnu.org; Sat, 07 Oct 2023 11:58:42 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qp9hm-0002RJ-AS; Sat, 07 Oct 2023 11:59:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63985] [PATCH v4 2/5] services: configuration: Use transducers within serialize-configuration. Resent-From: Bruno Victal Original-Sender: "Debbugs-submit" Resent-CC: maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Sat, 07 Oct 2023 15:59:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63985 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63985@debbugs.gnu.org Cc: Bruno Victal , Maxim Cournoyer X-Debbugs-Original-To: guix-patches@gnu.org, 63985@debbugs.gnu.org X-Debbugs-Original-Xcc: Maxim Cournoyer Received: via spool by submit@debbugs.gnu.org id=B.16966943269356 (code B ref -1); Sat, 07 Oct 2023 15:59:02 +0000 Received: (at submit) by debbugs.gnu.org; 7 Oct 2023 15:58:46 +0000 Received: from localhost ([127.0.0.1]:55726 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qp9hW-0002Qp-49 for submit@debbugs.gnu.org; Sat, 07 Oct 2023 11:58:46 -0400 Received: from lists.gnu.org ([2001:470:142::17]:60526) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qp9hU-0002Qc-M8 for submit@debbugs.gnu.org; Sat, 07 Oct 2023 11:58:45 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qp9h5-0007qQ-Tt for guix-patches@gnu.org; Sat, 07 Oct 2023 11:58:19 -0400 Received: from smtpmciv4.myservices.hosting ([185.26.107.240]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qp9h4-0000xh-2S for guix-patches@gnu.org; Sat, 07 Oct 2023 11:58:19 -0400 Received: from mail1.netim.hosting (unknown [185.26.106.173]) by smtpmciv4.myservices.hosting (Postfix) with ESMTP id A67282098C; Sat, 7 Oct 2023 17:58:05 +0200 (CEST) Received: from localhost (localhost [127.0.0.1]) by mail1.netim.hosting (Postfix) with ESMTP id 23D0280099; Sat, 7 Oct 2023 17:58:00 +0200 (CEST) X-Virus-Scanned: Debian amavisd-new at mail1.netim.hosting Received: from mail1.netim.hosting ([127.0.0.1]) by localhost (mail1-2.netim.hosting [127.0.0.1]) (amavisd-new, port 10026) with ESMTP id TkxNS0czr6eu; Sat, 7 Oct 2023 17:57:59 +0200 (CEST) Received: from guix-nuc.home.arpa (unknown [10.192.1.83]) (Authenticated sender: lumen@makinata.eu) by mail1.netim.hosting (Postfix) with ESMTPSA id 7D91080098; Sat, 7 Oct 2023 17:57:59 +0200 (CEST) From: Bruno Victal Date: Sat, 7 Oct 2023 16:57:15 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 Received-SPF: pass client-ip=185.26.107.240; envelope-from=mirai@makinata.eu; helo=smtpmciv4.myservices.hosting X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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 | 38 +++++++++++++++++++++++++++----- gnu/services/telephony.scm | 27 +++++++++++------------ 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 @@ (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,36 @@ (define-record-type* (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 @@ (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) 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)))