[bug#31089] [PATCH 3/5] services: cgit: Add support for file-like objects.

["Clément Lassieur" <clement@lassieur.org>]

* doc/guix.texi (Version Control Services): Update accordingly.
* gnu/services/cgit.scm (serialize-field, serialize-string, serialize-boolean,
serialize-integer, serialize-repository-cgit-configuration-list,
serialize-nginx-server-configuration-list, serialize-repo-field,
serialize-repo-boolean, serialize-repo-integer, serialize-module-link-path,
serialize-repository-directory, serialize-mimetype-alist): Return strings or
string-valued gexps and stop printing.
(repository-cgit-configuration)[source-filter, about-filter, commit-filter,
logo, owner-filter], (cgit-configuration)[auth-filter, commit-filter, css,
email-filter, favicon, include, logo, owner-filter, mimetype-file, readme,
source-filter]: Replace STRING with FILE-OBJECT.
(file-object?, serialize-file-object, repo-file-object?,
serialize-repo-file-object): New procedures.
(cgit-activation): Use SERIALIZE-CONFIGURATION's return value with
MIXED-TEXT-FILE instead of using its output with PLAIN-FILE.
---
 doc/guix.texi         | 37 +++++++++---------
 gnu/services/cgit.scm | 87 ++++++++++++++++++++++++-------------------
 2 files changed, 67 insertions(+), 57 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 738fdf65c..35d23e1be 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -18552,7 +18552,7 @@ NGINX configuration.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string about-filter
+@deftypevr {@code{cgit-configuration} parameter} file-object about-filter
 Specifies a command which will be invoked to format the content of about
 pages (both top-level and for each repository).
 
@@ -18568,7 +18568,7 @@ Defaults to @samp{""}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string auth-filter
+@deftypevr {@code{cgit-configuration} parameter} file-object auth-filter
 Specifies a command that will be invoked for authenticating repository
 access.
 
@@ -18677,7 +18677,7 @@ Defaults to @samp{()}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string commit-filter
+@deftypevr {@code{cgit-configuration} parameter} file-object commit-filter
 Command which will be invoked to format commit messages.
 
 Defaults to @samp{""}.
@@ -18693,14 +18693,14 @@ Defaults to @samp{"git log"}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string css
+@deftypevr {@code{cgit-configuration} parameter} file-object css
 URL which specifies the css document to include in all cgit pages.
 
 Defaults to @samp{"/share/cgit/cgit.css"}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string email-filter
+@deftypevr {@code{cgit-configuration} parameter} file-object email-filter
 Specifies a command which will be invoked to format names and email
 address of committers, authors, and taggers, as represented in various
 places throughout the cgit interface.
@@ -18824,7 +18824,7 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string favicon
+@deftypevr {@code{cgit-configuration} parameter} file-object favicon
 URL used as link to a shortcut icon for cgit.
 
 Defaults to @samp{"/favicon.ico"}.
@@ -18856,7 +18856,7 @@ Defaults to @samp{""}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string include
+@deftypevr {@code{cgit-configuration} parameter} file-object include
 Name of a configfile to include before the rest of the current config-
 file is parsed.
 
@@ -18888,7 +18888,7 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string logo
+@deftypevr {@code{cgit-configuration} parameter} file-object logo
 URL which specifies the source of an image which will be used as a logo
 on all cgit pages.
 
@@ -18903,7 +18903,7 @@ Defaults to @samp{""}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string owner-filter
+@deftypevr {@code{cgit-configuration} parameter} file-object owner-filter
 Command which will be invoked to format the Owner column of the main
 page.
 
@@ -18972,7 +18972,7 @@ Defaults to @samp{((gif "image/gif") (html "text/html") (jpg
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string mimetype-file
+@deftypevr {@code{cgit-configuration} parameter} file-object mimetype-file
 Specifies the file to use for automatic mimetype lookup.
 
 Defaults to @samp{""}.
@@ -19010,7 +19010,7 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string readme
+@deftypevr {@code{cgit-configuration} parameter} file-object readme
 Text which will be used as default value for @code{cgit-repo-readme}.
 
 Defaults to @samp{""}.
@@ -19128,7 +19128,7 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string source-filter
+@deftypevr {@code{cgit-configuration} parameter} file-object source-filter
 Specifies a command which will be invoked to format plaintext blobs in
 the tree view.
 
@@ -19190,7 +19190,7 @@ Defaults to @samp{()}.
 
 @end deftypevr
 
-@deftypevr {@code{repository-cgit-configuration} parameter} repo-string source-filter
+@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object source-filter
 Override the default @code{source-filter}.
 
 Defaults to @samp{""}.
@@ -19204,7 +19204,7 @@ Defaults to @samp{""}.
 
 @end deftypevr
 
-@deftypevr {@code{repository-cgit-configuration} parameter} repo-string about-filter
+@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object about-filter
 Override the default @code{about-filter}.
 
 Defaults to @samp{""}.
@@ -19226,7 +19226,7 @@ Defaults to @samp{()}.
 
 @end deftypevr
 
-@deftypevr {@code{repository-cgit-configuration} parameter} repo-string commit-filter
+@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object commit-filter
 Override the default @code{commit-filter}.
 
 Defaults to @samp{""}.
@@ -19266,7 +19266,7 @@ Defaults to @samp{""}.
 
 @end deftypevr
 
-@deftypevr {@code{repository-cgit-configuration} parameter} repo-string email-filter
+@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object email-filter
 Override the default @code{email-filter}.
 
 Defaults to @samp{""}.
@@ -19336,7 +19336,7 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
-@deftypevr {@code{repository-cgit-configuration} parameter} repo-string logo
+@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object logo
 URL which specifies the source of an image which will be used as a logo
 on this repo’s pages.
 
@@ -19351,7 +19351,7 @@ Defaults to @samp{""}.
 
 @end deftypevr
 
-@deftypevr {@code{repository-cgit-configuration} parameter} repo-string owner-filter
+@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object owner-filter
 Override the default @code{owner-filter}.
 
 Defaults to @samp{""}.
@@ -19436,6 +19436,7 @@ Defaults to @samp{()}.
 
 @end deftypevr
 
+
 @c %end of fragment
 
 However, it could be that you just want to get a @code{cgitrc} up and
diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index 3c685f1b5..98e46e0b8 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -76,13 +76,12 @@
   (string-delete #\? (symbol->string field-name)))
 
 (define (serialize-field field-name val)
-  (format #t "~a=~a\n" (uglify-field-name field-name) val))
+  #~(format #f "~a=~a\n" #$(uglify-field-name field-name) #$val))
 
 (define (serialize-string field-name val)
-  (if (string=? val "") "" (serialize-field field-name val)))
-
-(define (serialize-boolean field-name val)
-  (serialize-field field-name (if val 1 0)))
+  (if (and (string? val) (string=? val ""))
+      ""
+      (serialize-field field-name val)))
 
 (define (serialize-list field-name val)
   (if (null? val) "" (serialize-field field-name (string-join val))))
@@ -96,7 +95,10 @@
   (exact-integer? val))
 
 (define (serialize-integer field-name val)
-  (serialize-field field-name val))
+  (serialize-field field-name (number->string val)))
+
+(define (serialize-boolean field-name val)
+  (serialize-integer field-name (if val 1 0)))
 
 (define (serialize-repository-cgit-configuration x)
   (serialize-configuration x repository-cgit-configuration-fields))
@@ -105,7 +107,13 @@
   (list? val))
 
 (define (serialize-repository-cgit-configuration-list field-name val)
-  (for-each serialize-repository-cgit-configuration val))
+  #~(string-append
+     #$@(map serialize-repository-cgit-configuration val)))
+
+(define (file-object? val)
+  (or (file-like? val) (string? val)))
+(define (serialize-file-object field-name val)
+  (serialize-string field-name val))
 
 \f
 ;;;
@@ -116,7 +124,7 @@
   (and (list? val) (and-map nginx-server-configuration? val)))
 
 (define (serialize-nginx-server-configuration-list field-name val)
-  #f)
+  "")
 
 \f
 ;;;
@@ -124,18 +132,18 @@
 ;;;
 
 (define (serialize-repo-field field-name val)
-  (format #t "repo.~a=~a\n" (uglify-field-name field-name) val))
+  #~(format #f "repo.~a=~a\n" #$(uglify-field-name field-name) #$val))
 
 (define (serialize-repo-list field-name val)
   (if (null? val) "" (serialize-repo-field field-name (string-join val))))
 
 (define repo-boolean? boolean?)
 
-(define (serialize-repo-boolean field-name val)
-  (serialize-repo-field field-name (if val 1 0)))
-
 (define (serialize-repo-integer field-name val)
-  (serialize-repo-field field-name val))
+  (serialize-repo-field field-name (number->string val)))
+
+(define (serialize-repo-boolean field-name val)
+  (serialize-repo-integer field-name (if val 1 0)))
 
 (define repo-list? list?)
 
@@ -144,23 +152,26 @@
 (define (serialize-repo-string field-name val)
   (if (string=? val "") "" (serialize-repo-field field-name val)))
 
+(define repo-file-object? file-object?)
+(define serialize-repo-file-object serialize-repo-string)
+
 (define module-link-path? list?)
 
 (define (serialize-module-link-path field-name val)
   (if (null? val) ""
       (match val
         ((path text)
-         (format #t "repo.module-link.~a=~a\n" path text)))))
+         (format #f "repo.module-link.~a=~a\n" path text)))))
 
 (define repository-directory? string?)
 
 (define (serialize-repository-directory _ val)
-  (if (string=? val "") "" (format #t "scan-path=~a\n" val)))
+  (if (string=? val "") "" (format #f "scan-path=~a\n" val)))
 
 (define mimetype-alist? list?)
 
 (define (serialize-mimetype-alist field-name val)
-  (format #t "# Mimetypes\n~a"
+  (format #f "# Mimetypes\n~a"
           (string-join
            (map (match-lambda
                   ((extension mimetype)
@@ -174,13 +185,13 @@
    "A mask of snapshot formats for this repo that cgit generates links for,
 restricted by the global @code{snapshots} setting.")
   (source-filter
-   (repo-string "")
+   (repo-file-object "")
    "Override the default @code{source-filter}.")
   (url
    (repo-string "")
    "The relative URL used to access the repository.")
   (about-filter
-   (repo-string "")
+   (repo-file-object "")
    "Override the default @code{about-filter}.")
   (branch-sort
    (repo-string "")
@@ -190,7 +201,7 @@ ref list, and when set to @samp{name} enables ordering by branch name.")
    (repo-list '())
    "A list of URLs which can be used to clone repo.")
   (commit-filter
-   (repo-string "")
+   (repo-file-object "")
    "Override the default @code{commit-filter}.")
   (commit-sort
    (repo-string "")
@@ -209,7 +220,7 @@ is no suitable HEAD.")
    (repo-string "")
    "The value to show as repository homepage.")
   (email-filter
-   (repo-string "")
+   (repo-file-object "")
    "Override the default @code{email-filter}.")
   (enable-commit-graph?
    (repo-boolean #f)
@@ -243,14 +254,14 @@ repository index.")
    (repo-boolean #f)
    "Flag which, when set to @samp{#t}, ignores the repository.")
   (logo
-   (repo-string "")
+   (repo-file-object "")
    "URL which specifies the source of an image which will be used as a
 logo on this repo’s pages.")
   (logo-link
    (repo-string "")
    "URL loaded when clicking on the cgit logo image.")
   (owner-filter
-   (repo-string "")
+   (repo-file-object "")
    "Override the default @code{owner-filter}.")
   (module-link
    (repo-string "")
@@ -296,7 +307,7 @@ after this option will inherit the current section name.")
    (nginx-server-configuration-list (list %cgit-configuration-nginx))
    "NGINX configuration.")
   (about-filter
-   (string "")
+   (file-object "")
    "Specifies a command which will be invoked to format the content of about
 pages (both top-level and for each repository).")
   (agefile
@@ -304,7 +315,7 @@ pages (both top-level and for each repository).")
    "Specifies a path, relative to each repository path, which can be used to
 specify the date and time of the youngest commit in the repository.")
   (auth-filter
-   (string "")
+   (file-object "")
    "Specifies a command that will be invoked for authenticating repository
 access.")
   (branch-sort
@@ -357,7 +368,7 @@ generates valid clone URLs for the repository.")
    (list '())
    "List of @code{clone-url} templates.")
   (commit-filter
-   (string "")
+   (file-object "")
    "Command which will be invoked to format commit messages.")
   (commit-sort
    (string "git log")
@@ -365,10 +376,10 @@ generates valid clone URLs for the repository.")
 commit log, and when set to @samp{topo} enables strict topological
 ordering.")
   (css
-   (string "/share/cgit/cgit.css")
+   (file-object "/share/cgit/cgit.css")
    "URL which specifies the css document to include in all cgit pages.")
   (email-filter
-   (string "")
+   (file-object "")
    "Specifies a command which will be invoked to format names and email
 address of committers, authors, and taggers, as represented in various
 places throughout the cgit interface.")
@@ -432,7 +443,7 @@ links for plaintext blobs printed in the tree view.")
    "Flag which, when set to @samp{#f}, will allow cgit to use Git config to
 set any repo specific settings.")
   (favicon
-   (string "/favicon.ico")
+   (file-object "/favicon.ico")
    "URL used as link to a shortcut icon for cgit.")
   (footer
    (string "")
@@ -448,7 +459,7 @@ verbatim in the HTML HEAD section on all pages.")
    "The content of the file specified with this option will be included
 verbatim at the top of all pages.")
   (include
-   (string "")
+   (file-object "")
    "Name of a configfile to include before the rest of the current config-
 file is parsed.")
   (index-header
@@ -464,14 +475,14 @@ verbatim below the heading on the repository index page.")
    "Flag which, if set to @samp{#t}, makes cgit print commit and tag times
 in the servers timezone.")
   (logo
-   (string "/share/cgit/cgit.png")
+   (file-object "/share/cgit/cgit.png")
    "URL which specifies the source of an image which will be used as a logo
 on all cgit pages.")
   (logo-link
    (string "")
    "URL loaded when clicking on the cgit logo image.")
   (owner-filter
-   (string "")
+   (file-object "")
    "Command which will be invoked to format the Owner column of the main
 page.")
   (max-atom-items
@@ -508,7 +519,7 @@ on the repository index page.")
                      (svg "image/svg+xml")))
    "Mimetype for the specified filename extension.")
   (mimetype-file
-   (string "")
+   (file-object "")
    "Specifies the file to use for automatic mimetype lookup.")
   (module-link
    (string "")
@@ -533,7 +544,7 @@ header on all pages.")
   ;;    "A list of subdirectories inside of @code{repository-directory},
   ;; relative to it, that should loaded as Git repositories.")
   (readme
-   (string "")
+   (file-object "")
    "Text which will be used as default value for @code{cgit-repo-readme}.")
   (remove-suffix?
    (boolean #f)
@@ -591,7 +602,7 @@ many path elements from each repo path to use as a default section name.")
    "If set to @samp{#t} shows side-by-side diffs instead of unidiffs per
 default.")
   (source-filter
-   (string "")
+   (file-object "")
    "Specifies a command which will be invoked to format plaintext blobs in the
 tree view.")
   (summary-branches
@@ -640,16 +651,14 @@ for cgit to allow access to that repository.")
          (config-str
           (if opaque-config?
               (opaque-cgit-configuration-cgitrc config)
-              (with-output-to-string
-                (lambda ()
-                  (serialize-configuration config
-                                           cgit-configuration-fields))))))
+              (serialize-configuration config cgit-configuration-fields))))
     #~(begin
         (use-modules (guix build utils))
         (mkdir-p #$(if opaque-config?
                        (opaque-cgit-configuration-cache-root config)
                        (cgit-configuration-cache-root config)))
-        (copy-file #$(plain-file "cgitrc" config-str) "/etc/cgitrc"))))
+        (copy-file #$(mixed-text-file "cgitrc" config-str)
+                   "/etc/cgitrc"))))
 
 (define (cgit-configuration-nginx-config config)
   (if (opaque-cgit-configuration? config)
-- 
2.17.0