[bug#63985] [PATCH v3 06/11] services: configuration: New generic-ini module.

[Bruno Victal <mirai@makinata.eu>]

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 <mirai@makinata.eu>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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
+;;;
+
+\f
+;;;
+;;; 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-<type> 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
+;; “<ini-entries>”.
+;;
+;; 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>
+  (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 ‘<ini-entries>’ 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))))
+
+\f
+;;;
+;;; 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 <mirai@makinata.eu>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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
+")
+
+\f
+;;;
+;;; 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)
+
+\f
+;;;
+;;; 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)
-- 
2.39.2