summary refs log tree commit diff
path: root/gnu/services/configuration.scm
diff options
context:
space:
mode:
authorMarius Bakke <marius@gnu.org>2021-08-12 00:30:27 +0200
committerMarius Bakke <marius@gnu.org>2021-08-12 00:30:27 +0200
commitc4133c43c7cfe2476ebfae87f9e4d10d96de9bc7 (patch)
tree47bd773d2f434384b54e56916c1a287dd8e51511 /gnu/services/configuration.scm
parentffa01e68859bb7a6daa9fcffdc8d77ca35db4bc0 (diff)
parent4eb0a5146ae5a195a29c79f586fcc1e58f7fa69b (diff)
downloadguix-c4133c43c7cfe2476ebfae87f9e4d10d96de9bc7.tar.gz
Merge branch 'master' into core-updates-frozen
 Conflicts:
	gnu/packages/algebra.scm
	gnu/packages/games.scm
	gnu/packages/golang.scm
	gnu/packages/kerberos.scm
	gnu/packages/mail.scm
	gnu/packages/python.scm
	gnu/packages/ruby.scm
	gnu/packages/scheme.scm
	gnu/packages/tex.scm
	gnu/packages/tls.scm
	gnu/packages/version-control.scm
Diffstat (limited to 'gnu/services/configuration.scm')
-rw-r--r--gnu/services/configuration.scm83
1 files changed, 56 insertions, 27 deletions
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index fd07b6fa49..df3d3b6f9b 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,35 +254,62 @@ 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)
-       `((para "Available " (code ,(str configuration-name)) " fields are:")
-         ,@(map
-            (lambda (f)
-              (let ((field-name (configuration-field-name f))
-                    (field-type (configuration-field-type f))
-                    (field-docs (cdr (texi-fragment->stexi
-                                      (configuration-field-documentation f))))
-                    (default (catch #t
-                               (configuration-field-default-value-thunk f)
-                               (lambda _ '%invalid))))
-                (define (show-default? val)
-                  (or (string? val) (number? val) (boolean? val)
-                      (and (symbol? val) (not (eq? val '%invalid)))
-                      (and (list? val) (and-map show-default? val))))
-                `(deftypevr (% (category
-                                (code ,(str configuration-name)) " parameter")
-                               (data-type ,(str field-type))
-                               (name ,(str field-name)))
-                   ,@field-docs
-                   ,@(if (show-default? default)
-                         `((para "Defaults to " (samp ,(str default)) "."))
-                         '())
-                   ,@(append-map
-                      generate
-                      (or (assq-ref sub-documentation field-name) '())))))
-            fields)))))
+       `((deftp (% (category "Data Type") (name ,(str configuration-name)))
+           (para "Available " (code ,(str configuration-name)) " fields are:")
+           (table
+            (% (formatter (asis)))
+            ,@(map
+               (lambda (f)
+                 (let ((field-name (configuration-field-name f))
+                       (field-type (configuration-field-type f))
+                       (field-docs (cdr (texi-fragment->stexi
+                                         (configuration-field-documentation f))))
+                       (default (catch #t
+                                  (configuration-field-default-value-thunk f)
+                                  (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 ,(show-default default)) ")")
+                                     '())
+                               " (type: " ,(str field-type) ")"))
+                           (para ,@field-docs)
+                           ,@(append-map
+                              generate
+                              (or (assq-ref sub-documentation field-name)
+                                  '())))))
+               fields)))))))
   (stexi->texi `(*fragment* . ,(generate documentation-name))))
 
 (define (configuration->documentation configuration-symbol)