[bug#31089] cgit service: add support for file-like objects

[bug#31089] cgit service: add support for file-like objects

[Clément Lassieur]

Hi,

These patches aim to add support for file-like objects and a few other
things related to the cgit service.

Comments are welcome,
Clément

[bug#31089] [PATCH 1/5] services: cgit: Simplify 'uglify-field-name'.

[Clément Lassieur]

* gnu/services/cgit.scm (uglify-field-name): Remove STRING-JOIN and
STRING-SPLIT.
---
 gnu/services/cgit.scm | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index a868d758a..b263aa491 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -72,8 +73,7 @@
 ;;;
 
 (define (uglify-field-name field-name)
-  (let ((str (symbol->string field-name)))
-    (string-join (string-split (string-delete #\? str) #\-) "-")))
+  (string-delete #\? (symbol->string field-name)))
 
 (define (serialize-field field-name val)
   (format #t "~a=~a\n" (uglify-field-name field-name) val))
-- 
2.17.0

[bug#31089] [PATCH 2/5] services: cgit: Simplify 'serialize-module-link-path'.

[Clément Lassieur]

* gnu/services/cgit.scm (serialize-module-link-path): Remove STRING-DROP-RIGHT
and UGLIFY-FIELD-NAME.
---
 gnu/services/cgit.scm | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index b263aa491..3c685f1b5 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -150,10 +150,7 @@
   (if (null? val) ""
       (match val
         ((path text)
-         (format #t "repo.~a.~a=~a\n"
-                 (string-drop-right (uglify-field-name 'module-link-path)
-                                    (string-length "-path"))
-                 path text)))))
+         (format #t "repo.module-link.~a=~a\n" path text)))))
 
 (define repository-directory? string?)
 
-- 
2.17.0

[bug#31089] [PATCH 2/5] services: cgit: Simplify 'serialize-module-link-path'.

[Ludovic Courtès]

Clément Lassieur <clement@lassieur.org> skribis:

> * gnu/services/cgit.scm (serialize-module-link-path): Remove STRING-DROP-RIGHT
> and UGLIFY-FIELD-NAME.

OK.

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

[Clément Lassieur]

* 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

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

[Clément Lassieur]

Clément Lassieur <clement@lassieur.org> writes:

> * 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.

I'll also add:

The @code{file-object} type designates either a file-like object
(@pxref{G-Expressions, file-like objects}) or a string.

>  @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).

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

[Ludovic Courtès]

Clément Lassieur <clement@lassieur.org> skribis:

> * 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.

Nice!

>           (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"))))

For clarity, since ‘config-str’ is no longer a string (right?), I’d
rename it to just ‘config’ or something.

Also, could it be that you’re missing ‘apply’ above, as in:

  (apply mixed-text-file "cgitrc" config-str)

?

Otherwise LGTM, thanks!

Ludo’.

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

[Clément Lassieur]

Ludovic Courtès <ludo@gnu.org> writes:

>>           (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"))))
>
> For clarity, since ‘config-str’ is no longer a string (right?), I’d
> rename it to just ‘config’ or something.
>
> Also, could it be that you’re missing ‘apply’ above, as in:
>
>   (apply mixed-text-file "cgitrc" config-str)
>
> ?

Yes, config-str is still a string (or a string-valued gexp).  I use
mixed-text-file because it can take gexps as arguments, whereas
plain-file can't.

> Otherwise LGTM, thanks!

Thank you for the review!

Clément

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

[Clément Lassieur]

Clément Lassieur <clement@lassieur.org> writes:

> Ludovic Courtès <ludo@gnu.org> writes:
>
>>>           (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"))))
>>
>> For clarity, since ‘config-str’ is no longer a string (right?), I’d
>> rename it to just ‘config’ or something.
>>
>> Also, could it be that you’re missing ‘apply’ above, as in:
>>
>>   (apply mixed-text-file "cgitrc" config-str)
>>
>> ?
>
> Yes, config-str is still a string (or a string-valued gexp).  I use
> mixed-text-file because it can take gexps as arguments, whereas
> plain-file can't.
>
>> Otherwise LGTM, thanks!
>
> Thank you for the review!
>
> Clément

Pushed.

[bug#31089] [PATCH 4/5] services: cgit: Enforce serialization order.

[Clément Lassieur]

This distinguishes fields whose order matters, and makes sure further changes
won't inadvertently change the order.

* gnu/services/cgit.scm (serialize-cgit-configuration): New procedure that
serializes fields with a precise order.
(cgit-activation): Replace the generic SERIALIZE-CONFIGURATION with
SERIALIZE-CGIT-CONFIGURATION.
---
 gnu/services/cgit.scm | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index 98e46e0b8..f53306cd3 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -631,6 +631,17 @@ for cgit to allow access to that repository.")
    (list '())
    "Extra options will be appended to cgitrc file."))
 
+(define (serialize-cgit-configuration config)
+  (define (rest? field)
+    (not (memq (configuration-field-name field)
+               '(repositories))))
+  #~(string-append
+     #$(let ((rest (filter rest? cgit-configuration-fields)))
+         (serialize-configuration config rest))
+     #$(serialize-repository-cgit-configuration-list
+        'repositories
+        (cgit-configuration-repositories config))))
+
 (define-configuration opaque-cgit-configuration
   (cgit
    (package cgit)
@@ -651,7 +662,7 @@ for cgit to allow access to that repository.")
          (config-str
           (if opaque-config?
               (opaque-cgit-configuration-cgitrc config)
-              (serialize-configuration config cgit-configuration-fields))))
+              (serialize-cgit-configuration config))))
     #~(begin
         (use-modules (guix build utils))
         (mkdir-p #$(if opaque-config?
-- 
2.17.0

[bug#31089] [PATCH 4/5] services: cgit: Enforce serialization order.

[Ludovic Courtès]

Clément Lassieur <clement@lassieur.org> skribis:

> This distinguishes fields whose order matters, and makes sure further changes
> won't inadvertently change the order.
>
> * gnu/services/cgit.scm (serialize-cgit-configuration): New procedure that
> serializes fields with a precise order.
> (cgit-activation): Replace the generic SERIALIZE-CONFIGURATION with
> SERIALIZE-CGIT-CONFIGURATION.
> ---
>  gnu/services/cgit.scm | 13 ++++++++++++-
>  1 file changed, 12 insertions(+), 1 deletion(-)
>
> diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
> index 98e46e0b8..f53306cd3 100644
> --- a/gnu/services/cgit.scm
> +++ b/gnu/services/cgit.scm
> @@ -631,6 +631,17 @@ for cgit to allow access to that repository.")
>     (list '())
>     "Extra options will be appended to cgitrc file."))
>  
> +(define (serialize-cgit-configuration config)
> +  (define (rest? field)
> +    (not (memq (configuration-field-name field)
> +               '(repositories))))
> +  #~(string-append
> +     #$(let ((rest (filter rest? cgit-configuration-fields)))
> +         (serialize-configuration config rest))
> +     #$(serialize-repository-cgit-configuration-list
> +        'repositories
> +        (cgit-configuration-repositories config))))

Please add a comment here explaining the story about field ordering.

OK with this change!

Ludo’.

[bug#31089] [PATCH 5/5] services: cgit: Add support for project-list.

[Clément Lassieur]

* doc/guix.texi (Version Control Services): Update accordingly.
* gnu/services/cgit.scm (cgit-configuration)[project-list]: New field.
(serialize-project-list): New procedure that uses PLAIN-FILE to generate a
file from the string list given by the user as input.
(serialize-cgit-configuration): Make sure to serialize 'project-list' before
'repostory-directory'.
---
 doc/guix.texi         |  9 +++++++++
 gnu/services/cgit.scm | 28 ++++++++++++++++++++--------
 2 files changed, 29 insertions(+), 8 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 35d23e1be..add29320e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -19010,6 +19010,15 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
+@deftypevr {@code{cgit-configuration} parameter} list project-list
+A list of subdirectories inside of @code{repository-directory}, relative
+to it, that should loaded as Git repositories.  An empty list means that
+all subdirectories will be loaded.
+
+Defaults to @samp{()}.
+
+@end deftypevr
+
 @deftypevr {@code{cgit-configuration} parameter} file-object readme
 Text which will be used as default value for @code{cgit-repo-readme}.
 
diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index f53306cd3..a39c09721 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -163,6 +163,12 @@
         ((path text)
          (format #f "repo.module-link.~a=~a\n" path text)))))
 
+(define (serialize-project-list _ val)
+  (if (null? val) ""
+      (serialize-field
+       'project-list
+       (plain-file "project-list" (string-join val "\n")))))
+
 (define repository-directory? string?)
 
 (define (serialize-repository-directory _ val)
@@ -536,13 +542,11 @@ disabled.")
    (boolean #f)
    "Flag which, when set to @samp{#t}, will make cgit omit the standard
 header on all pages.")
-  ;; TODO: cgit expects a file name
-  ;; that should be created from a list of strings provided by the user.
-  ;;
-  ;; (project-list
-  ;;    (string "")
-  ;;    "A list of subdirectories inside of @code{repository-directory},
-  ;; relative to it, that should loaded as Git repositories.")
+  (project-list
+   (list '())
+   "A list of subdirectories inside of @code{repository-directory}, relative
+to it, that should loaded as Git repositories.  An empty list means that all
+subdirectories will be loaded.")
   (readme
    (file-object "")
    "Text which will be used as default value for @code{cgit-repo-readme}.")
@@ -634,10 +638,18 @@ for cgit to allow access to that repository.")
 (define (serialize-cgit-configuration config)
   (define (rest? field)
     (not (memq (configuration-field-name field)
-               '(repositories))))
+               '(project-list
+                 repository-directory
+                 repositories))))
   #~(string-append
      #$(let ((rest (filter rest? cgit-configuration-fields)))
          (serialize-configuration config rest))
+     #$(serialize-project-list
+        'project-list
+        (cgit-configuration-project-list config))
+     #$(serialize-repository-directory
+        'repository-directory
+        (cgit-configuration-repository-directory config))
      #$(serialize-repository-cgit-configuration-list
         'repositories
         (cgit-configuration-repositories config))))
-- 
2.17.0

[bug#31089] [PATCH 5/5] services: cgit: Add support for project-list.

[Ludovic Courtès]

Clément Lassieur <clement@lassieur.org> skribis:

> * doc/guix.texi (Version Control Services): Update accordingly.
> * gnu/services/cgit.scm (cgit-configuration)[project-list]: New field.
> (serialize-project-list): New procedure that uses PLAIN-FILE to generate a
> file from the string list given by the user as input.
> (serialize-cgit-configuration): Make sure to serialize 'project-list' before
> 'repostory-directory'.

Pretty cool.  LGTM, thanks!

Ludo'.

[bug#31089] [PATCH 1/5] services: cgit: Simplify 'uglify-field-name'.

[Ludovic Courtès]

Hello,

Clément Lassieur <clement@lassieur.org> skribis:

> * gnu/services/cgit.scm (uglify-field-name): Remove STRING-JOIN and
> STRING-SPLIT.

LGTM!

> -    (string-join (string-split (string-delete #\? str) #\-) "-")))

Funny.  :-)

Ludo’.