From patchwork Mon Jun 26 21:59:32 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Bruno Victal X-Patchwork-Id: 51372 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 DF72427BBE2; Mon, 26 Jun 2023 23:01:46 +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,URIBL_BLOCKED autolearn=ham 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 3835C27BBEA for ; Mon, 26 Jun 2023 23:01:44 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qDuGo-0005Lm-OX; Mon, 26 Jun 2023 18:01:14 -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 1qDuGi-00051s-9c for guix-patches@gnu.org; Mon, 26 Jun 2023 18:01:10 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qDuGc-0005X2-TM for guix-patches@gnu.org; Mon, 26 Jun 2023 18:01:05 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qDuGc-0008SY-O3 for guix-patches@gnu.org; Mon, 26 Jun 2023 18:01:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63985] [PATCH v3 06/11] services: configuration: New generic-ini module. Resent-From: Bruno Victal Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 26 Jun 2023 22:01: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 Received: via spool by 63985-submit@debbugs.gnu.org id=B63985.168781682232367 (code B ref 63985); Mon, 26 Jun 2023 22:01:02 +0000 Received: (at 63985) by debbugs.gnu.org; 26 Jun 2023 22:00:22 +0000 Received: from localhost ([127.0.0.1]:47174 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qDuFx-0008Pv-Ex for submit@debbugs.gnu.org; Mon, 26 Jun 2023 18:00:22 -0400 Received: from smtpm3.myservices.hosting ([185.26.105.234]:32906) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qDuFu-0008Pk-4i for 63985@debbugs.gnu.org; Mon, 26 Jun 2023 18:00:19 -0400 Received: from mail1.netim.hosting (unknown [185.26.106.173]) by smtpm3.myservices.hosting (Postfix) with ESMTP id 5B82D20FAB for <63985@debbugs.gnu.org>; Tue, 27 Jun 2023 00:00:17 +0200 (CEST) Received: from localhost (localhost [127.0.0.1]) by mail1.netim.hosting (Postfix) with ESMTP id A1EB28009B; Tue, 27 Jun 2023 00:00:16 +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 yhy3_izi1NZy; Tue, 27 Jun 2023 00:00:15 +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 023A98009A; Tue, 27 Jun 2023 00:00:14 +0200 (CEST) From: Bruno Victal Date: Mon, 26 Jun 2023 22:59:32 +0100 Message-Id: X-Mailer: git-send-email 2.39.2 In-Reply-To: References: MIME-Version: 1.0 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 Implements a ‘serialize-ini-configuration’ procedure for serializing record-types defined with define-configuration into generic INI files. * gnu/services/configuration/generic-ini.scm: New module. * tests/services/configuration/generic-ini.scm: Add tests for new module. * Makefile.am: Register tests. * gnu/local.mk: Register module. --- Makefile.am | 1 + gnu/local.mk | 1 + gnu/services/configuration/generic-ini.scm | 165 +++++++++++++++++++ tests/services/configuration/generic-ini.scm | 129 +++++++++++++++ 4 files changed, 296 insertions(+) create mode 100644 gnu/services/configuration/generic-ini.scm create mode 100644 tests/services/configuration/generic-ini.scm diff --git a/Makefile.am b/Makefile.am index a386e6033c..b6d048f140 100644 --- a/Makefile.am +++ b/Makefile.am @@ -553,6 +553,7 @@ SCM_TESTS = \ tests/services.scm \ tests/services/file-sharing.scm \ tests/services/configuration.scm \ + tests/services/configuration/generic-ini.scm \ tests/services/lightdm.scm \ tests/services/linux.scm \ tests/services/telephony.scm \ diff --git a/gnu/local.mk b/gnu/local.mk index e65888a044..796ac33107 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -670,6 +670,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/cgit.scm \ %D%/services/ci.scm \ %D%/services/configuration.scm \ + %D%/services/configuration/generic-ini.scm \ %D%/services/cuirass.scm \ %D%/services/cups.scm \ %D%/services/databases.scm \ diff --git a/gnu/services/configuration/generic-ini.scm b/gnu/services/configuration/generic-ini.scm new file mode 100644 index 0000000000..4f83cce13a --- /dev/null +++ b/gnu/services/configuration/generic-ini.scm @@ -0,0 +1,165 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2023 Bruno Victal +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu services configuration generic-ini) + #:use-module (gnu services configuration) + #:use-module (guix gexp) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-171) + #:use-module (srfi srfi-171 meta) + #:use-module (ice-9 match) + #:export (ini-entry? + list-of-ini-entries? + + ini-entries + ini-entries? + entries + + serialize-ini-configuration + generic-ini-serialize-string + generic-ini-serialize-boolean + generic-ini-serialize-ini-entry + generic-ini-serialize-list-of-ini-entries)) + +;;; +;;; Generic INI serializer +;;; + + +;;; +;;; Predicates +;;; + +;; This is the same format used in SRFI-233 but without comment support. +(define ini-entry? + (match-lambda + (((? symbol?) (? symbol?) (? string?)) #t) + (_ #f))) + +(define list-of-ini-entries? + (list-of ini-entry?)) + +;; +;; Overall design document +;; +;; This module implements a generic INI serializer for a record-type defined +;; using define-configuration. +;; It expects that the serialize- procedures return a list with +;; three elements of the form: +;; (list section key value) +;; Where ‘section’ and ‘key’ are symbols and ‘value’ is a string. +;; For serializing procedures that have to return multiple entries at once, +;; such as encountered when synthesizing configuration from a record object +;; or “escape hatch fields”, it must wrap the result by calling ‘ini-entries’ +;; with a list of INI-entries as described above. +;; This is implemented as a constructor for a SRFI-9 record type named +;; “”. +;; +;; The fields within define-configuration do not have to be ordered in, +;; any way whatsoever as the ‘serialize-ini’ will group them up automatically. +;; This implies that no assumptions should be made regarding the order of the +;; values in the serializied INI output. +;; +;; Additional notes: +;; Q: Why not replace rcons with string-append and forego the ungexp-splice? +;; A: The transduction happens outside of the G-Exp while the final string-append +;; takes place in the G-Exp. +;; +;; Debugging tips: Open a REPL and try one transducer at a time from +;; ‘ini-transducer’. +;; + +;; A “bag” holding multiple ini-entries. +(define-record-type + (ini-entries val) + ini-entries? + (val entries)) + +(define (add-section-header partition) + (let ((header (caar partition))) + (cons (list header) + partition))) + +(define serializer + (match-lambda + ((section) + #~(format #f "[~a]~%" '#$section)) + ((section key value) + #~(format #f "~a=~a~%" '#$key #$value)) + ;; Used for the newline between sections. + ('*section-separator* "\n"))) + +(define ini-transducer + (compose (tpartition car) + (tmap add-section-header) + (tadd-between '(*section-separator*)) + tconcatenate + (tmap serializer))) + +;; A selective version of ‘tconcatenate’ but for ‘’ objects only. +(define (tconcatenate-ini-entries reducer) + (case-lambda + (() '()) + ((result) (reducer result)) + ((result input) + (if (ini-entries? input) + (list-reduce (preserving-reduced reducer) result (entries input)) + (reducer result input))))) + +;; A “first-pass” serialization is performed and sorted in order +;; to group up the fields by “section” before passing through the +;; transducer. +(define (serialize-ini-configuration config fields) + (let* ((srfi-233-IR + ;; First pass: “serialize” into a (disordered) list of + ;; SRFI-233 entries. + (list-transduce (compose (base-transducer config) + tconcatenate-ini-entries) + rcons fields)) + (comparator (lambda (x y) + ;; Sort the SRFI-233 entries by section. + (string<=? (symbol->string (car x)) + (symbol->string (car y))))) + (sorted-entries (sort srfi-233-IR comparator))) + #~(string-append + #$@(list-transduce ini-transducer rcons sorted-entries)))) + + +;;; +;;; Serializers +;;; + +;; These are “gratuitous” serializers that can be readily used by +;; using the literal (prefix generic-ini-) within define-configuration. + +;; Notes: field-name-transform can be used to “uglify” a field-name, +;; e.g. want-ipv6? -> want_ipv6 +(define* (generic-ini-serialize-string field-name value #:key section + (field-name-transform identity)) + (list section (field-name-transform field-name) value)) + +(define* (generic-ini-serialize-boolean field-name value #:key section + (field-name-transform identity)) + (list section (field-name-transform field-name) + (if value "true" "false"))) + +(define (generic-ini-serialize-ini-entry field-name value) + value) + +(define (generic-ini-serialize-list-of-ini-entries field-name value) + (ini-entries value)) diff --git a/tests/services/configuration/generic-ini.scm b/tests/services/configuration/generic-ini.scm new file mode 100644 index 0000000000..797a01af31 --- /dev/null +++ b/tests/services/configuration/generic-ini.scm @@ -0,0 +1,129 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2023 Bruno Victal +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (tests services configuration generic-ini) + #:use-module (gnu services configuration) + #:use-module (gnu services configuration generic-ini) + #:use-module (guix diagnostics) + #:use-module (guix gexp) + #:use-module (guix store) + #:autoload (guix i18n) (G_) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-64) + #:use-module (srfi srfi-71)) + +;;; Tests for the (gnu services configuration generic-ini) module. + +(test-begin "generic-ini serializer") + + +(define expected-output "\ +[guardians] +llamas=Tommy,Isabella +donkeys=Franz,Olly + +[ranch] +shepherd=Emma + +[shed] +colours=Alizarin +enabled=true +capacity=50 +production=wool + +[vehicles] +cars=313 +bikes=Amaryllis +") + + +;;; +;;; Serializers +;;; +(define (strip-trailing-?-character field-name) + "Drop rightmost '?' character" + (let ((str (symbol->string field-name))) + (if (string-suffix? "?" str) + (string->symbol (string-drop-right str 1)) + field-name))) + +(define* (serialize-string field-name value #:key section) + (list section field-name value)) + +(define* (serialize-number field-name value #:key section) + (list section field-name (number->string value))) + +(define* (serialize-boolean field-name value #:key section) + (list section (strip-trailing-?-character field-name) + (if value "true" "false"))) + +(define serialize-ini-entry + generic-ini-serialize-ini-entry) + +(define serialize-list-of-ini-entries + generic-ini-serialize-list-of-ini-entries) + + +;;; +;;; Record-type definition +;;; + +(define-configuration foo-configuration + (production + (string "wool") + "Lorem Ipsum …" + (serializer-options '(#:section shed))) + + (capacity + (number 50) + "Lorem Ipsum …" + (serializer-options '(#:section shed))) + + (enabled? + (boolean #t) + "Lorem Ipsum …" + (serializer-options '(#:section shed))) + + (shepherd + (string "Emma") + "Lorem Ipsum …" + (serializer-options '(#:section ranch))) + + (raw-entry + (ini-entry '(shed colours "Alizarin")) + "Lorem Ipsum …") + + (escape-hatch + (list-of-ini-entries '((vehicles bikes "Amaryllis") + (vehicles cars "313") + (guardians donkeys "Franz,Olly") + (guardians llamas "Tommy,Isabella"))) + "Lorem Ipsum …")) + +(test-equal "Well-formed INI output from serialize-ini" + expected-output + ;; Serialize the above into a string, properly resolving any potential + ;; nested G-Exps as well. + (let* ((serialized-ini + (serialize-ini-configuration (foo-configuration) + foo-configuration-fields)) + (lowered conn (with-store store + ((lower-gexp serialized-ini) store)))) + (eval (lowered-gexp-sexp lowered) (current-module)))) + +(test-end)