ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-11 13:49:23 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
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>
This commit is contained in:
Xinglu Chen 2021-06-09 15:06:27 +02:00 committed by Maxim Cournoyer
parent ad945029a2
commit 8e1f944218
No known key found for this signature in database
GPG key ID: 1260E46482E63562
1 changed files with 26 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
gnu/services/configuration.scm
View file

@ -25,10 +25,12 @@ (define-module (gnu services configuration)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module ((guix utils) #:select (source-properties->location)) #: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) (texi-fragment->stexi)
#:autoload (texinfo serialize) (stexi->texi) #:autoload (texinfo serialize) (stexi->texi)
#:use-module (ice-9 match) #: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-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:export (configuration-field #:export (configuration-field
@ -252,6 +254,21 @@ (define serialize-package empty-serializer)
;; A little helper to make it easier to document all those fields. ;; A little helper to make it easier to document all those fields.
(define (generate-documentation documentation documentation-name) (define (generate-documentation documentation documentation-name)
(define (str x) (object->string x)) (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) (define (generate configuration-name)
(match (assq-ref documentation configuration-name) (match (assq-ref documentation configuration-name)
((fields . sub-documentation) ((fields . sub-documentation)
@ -270,14 +287,21 @@ (define (generate configuration-name)
(lambda _ '%invalid)))) (lambda _ '%invalid))))
(define (show-default? val) (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 (symbol? val) (not (eq? val '%invalid)))
(and (list? val) (and-map show-default? val)))) (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 `(entry (% (heading
(code ,(str field-name)) (code ,(str field-name))
,@(if (show-default? default) ,@(if (show-default? default)
`(" (default: " `(" (default: "
(code ,(str default)) ")") (code ,(show-default default)) ")")
'()) '())
" (type: " ,(str field-type) ")")) " (type: " ,(str field-type) ")"))
(para ,@field-docs) (para ,@field-docs)