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

[guix-commits]

apteryx pushed a commit to branch master
in repository guix.

commit 8e1f94421873777c6bb0b83daa4f81cbacc8b3ff
Author: Xinglu Chen <public@yoctocell.xyz>
AuthorDate: Wed Jun 9 15:06:27 2021 +0200

    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.
    
    Co-authored-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
    Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
---
 gnu/services/configuration.scm | 28 ++++++++++++++++++++++++++--
 1 file changed, 26 insertions(+), 2 deletions(-)

diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 3974fba..df3d3b6 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -25,10 +25,12 @@
   #:use-module (guix records)
   #:use-module (guix gexp)
   #:use-module ((guix utils) #:select (source-properties->location))
+  #:use-module ((guix diagnostics) #:select (location-file))
+  #:use-module ((guix modules) #:select (file-name->module-name))
   #:autoload   (texinfo) (texi-fragment->stexi)
   #:autoload   (texinfo serialize) (stexi->texi)
   #:use-module (ice-9 match)
-  #:use-module ((srfi srfi-1) #:select (append-map))
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:export (configuration-field
@@ -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: "
-                                       (code ,(str default)) ")")
+                                       (code ,(show-default default)) ")")
                                      '())
                                " (type: " ,(str field-type) ")"))
                            (para ,@field-docs)