bug#48934: [PATCH 0/2] Some improvements to (gnu services configuration)

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

Hello again,

Xinglu Chen <public@yoctocell.xyz> writes:

> * gnu/services/configuration.scm (generate-documentation): If the default
>   value of a field is a package, show the value of the ‘name’ field of the
>   package.  This might not be the correct name in some cases though.

Here also, I've edited the commit message like so:

  services: configuration: Derive the default value from the package variable.

  If the type of a configuration field is a package, show the name of its
  package *variable* as the default value.

  * gnu/services/configuration.scm (generate-documentation){show-default}
  {package->symbol}: New nested procedures.  Use them to format the field
  entries.

> ---
>  gnu/services/configuration.scm | 12 ++++++++++--
>  1 file changed, 10 insertions(+), 2 deletions(-)
>
> diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
> index abcbc70520..99687d065a 100644
> --- a/gnu/services/configuration.scm
> +++ b/gnu/services/configuration.scm
> @@ -252,12 +252,20 @@ does not have a default value" field kind)))
>                                          (configuration-field-default-value-thunk f)
>                                          (lambda _ '%invalid))))
>                           (define (show-default? val)
> -                           (or (string? val) (number? val) (boolean? val)
> +                           (or (string? val) (number? val) (boolean? val) (package? val)
>                                 (and (symbol? val) (not (eq? val '%invalid)))
>                                 (and (list? val) (and-map show-default? val))))
> +
> +                         (define (show-default val)
> +                           (cond
> +                            ((package? val)
> +                             ;; Maybe not always correct.
> +                             (package-name val))
> +                            (else (str val))))
> +
>                           `(entry (% (heading (code ,(str field-name))
>                                               ,@(if (show-default? default)
> -                                                   `(" (default: " (code ,(str default)) ")")
> +                                                   `(" (default: " (code ,(show-default default)) ")")
>                                                     '())
>                                               " (type: "
>                                               ,(str field-type)

I've found a (rather hacky?) way to derive a package's symbol name
instead of using its name, which eliminates the risk of a mismatch,
using such procedure:

--8<---------------cut here---------------start------------->8---
@@ -252,6 +254,21 @@ does not have a default value" field kind)))
 ;; A little helper to make it easier to document all those fields.
 (define (generate-documentation documentation documentation-name)
   (define (str x) (object->string x))
+
+  (define (package->symbol package)
+    "Return the first symbol name of a package that matches PACKAGE, else #f."
+    (let* ((module (file-name->module-name
+                    (location-file (package-location package))))
+           (symbols (filter-map
+                     identity
+                     (module-map (lambda (symbol var)
+                                   (and (equal? package (variable-ref var))
+                                        symbol))
+                                 (resolve-module module)))))
+      (if (null? symbols)
+          #f
+          (first symbols))))
+
   (define (generate configuration-name)
     (match (assq-ref documentation configuration-name)
       ((fields . sub-documentation)
@@ -270,14 +287,21 @@ does not have a default value" field kind)))
                                   (lambda _ '%invalid))))
                    (define (show-default? val)
                      (or (string? val) (number? val) (boolean? val)
+                         (package? val)
                          (and (symbol? val) (not (eq? val '%invalid)))
                          (and (list? val) (and-map show-default? val))))
 
+                   (define (show-default val)
+                     (cond
+                      ((package? val)
+                       (symbol->string (package->symbol val)))
+                      (else (str val))))
+
                    `(entry (% (heading
                                (code ,(str field-name))
                                ,@(if (show-default? default)
                                      `(" (default: "
--8<---------------cut here---------------end--------------->8---

Tested it to generate the new Jami service documentation, and pushed as
commit 8e1f94421873777c6bb0b83daa4f81cbacc8b3ff.

I think (guix services configuration) is starting to look good!  Thanks
to your efforts toward improving the module.

Closing.

Maxim