[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/02: services: configuration: Support fields without default values.
|
From: |
guix-commits |
|
Subject: |
01/02: services: configuration: Support fields without default values. |
|
Date: |
Fri, 7 May 2021 08:59:55 -0400 (EDT) |
apteryx pushed a commit to branch master
in repository guix.
commit d1caabbce7fb2ade4cca5ef22234670d3eca16fd
Author: Xinglu Chen <public@yoctocell.xyz>
AuthorDate: Sat May 1 13:24:43 2021 +0200
services: configuration: Support fields without default values.
Not all fields in a configuration have a sensible default value. This
changes
makes it possible to omit a default value for a configuration field,
requiring
the user to provide a value.
* gnu/services/configuration.scm (configuration-missing-field): New
procedure.
(define-configuration): Make default value optional.
Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
---
gnu/services/configuration.scm | 80 ++++++++++++++++++++++++++++--------------
1 file changed, 53 insertions(+), 27 deletions(-)
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 90f12a8..15bd309 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -63,6 +64,10 @@
(define (configuration-missing-field kind field)
(configuration-error
(format #f "~a configuration missing required field ~a" kind field)))
+(define (configuration-no-default-value kind field)
+ (configuration-error
+ (format #f "The field `~a' of the `~a' configuration record \
+does not have a default value" field kind)))
(define-record-type* <configuration-field>
configuration-field make-configuration-field configuration-field?
@@ -112,7 +117,7 @@
(define-syntax define-configuration
(lambda (stx)
(syntax-case stx ()
- ((_ stem (field (field-type def) doc) ...)
+ ((_ stem (field (field-type def ...) doc) ...)
(with-syntax (((field-getter ...)
(map (lambda (field)
(id #'stem #'stem #'- field))
@@ -121,36 +126,57 @@
(map (lambda (type)
(id #'stem type #'?))
#'(field-type ...)))
+ ((field-default ...)
+ (map (match-lambda
+ ((field-type default-value)
+ default-value)
+ ((field-type)
+ ;; Quote `undefined' to prevent a possibly
+ ;; unbound warning.
+ (syntax 'undefined)))
+ #'((field-type def ...) ...)))
((field-serializer ...)
(map (lambda (type)
(id #'stem #'serialize- type))
#'(field-type ...))))
- #`(begin
- (define-record-type* #,(id #'stem #'< #'stem #'>)
- #,(id #'stem #'% #'stem)
- #,(id #'stem #'make- #'stem)
- #,(id #'stem #'stem #'?)
- (%location #,(id #'stem #'-location)
- (default (and=> (current-source-location)
- source-properties->location))
- (innate))
- (field field-getter (default def))
- ...)
- (define #,(id #'stem #'stem #'-fields)
- (list (configuration-field
- (name 'field)
- (type 'field-type)
- (getter field-getter)
- (predicate field-predicate)
- (serializer field-serializer)
- (default-value-thunk (lambda () def))
- (documentation doc))
- ...))
- (define-syntax-rule (stem arg (... ...))
- (let ((conf (#,(id #'stem #'% #'stem) arg (... ...))))
- (validate-configuration conf
- #,(id #'stem #'stem #'-fields))
- conf))))))))
+ #`(begin
+ (define-record-type* #,(id #'stem #'< #'stem #'>)
+ #,(id #'stem #'% #'stem)
+ #,(id #'stem #'make- #'stem)
+ #,(id #'stem #'stem #'?)
+ (%location #,(id #'stem #'-location)
+ (default (and=> (current-source-location)
+ source-properties->location))
+ (innate))
+ #,@(map (lambda (name getter def)
+ (if (eq? (syntax->datum def) (quote 'undefined))
+ #`(#,name #,getter)
+ #`(#,name #,getter (default #,def))))
+ #'(field ...)
+ #'(field-getter ...)
+ #'(field-default ...)))
+ (define #,(id #'stem #'stem #'-fields)
+ (list (configuration-field
+ (name 'field)
+ (type 'field-type)
+ (getter field-getter)
+ (predicate field-predicate)
+ (serializer field-serializer)
+ (default-value-thunk
+ (lambda ()
+ (display '#,(id #'stem #'% #'stem))
+ (if (eq? (syntax->datum field-default)
+ 'undefined)
+ (configuration-no-default-value
+ '#,(id #'stem #'% #'stem) 'field)
+ field-default)))
+ (documentation doc))
+ ...))
+ (define-syntax-rule (stem arg (... ...))
+ (let ((conf (#,(id #'stem #'% #'stem) arg (... ...))))
+ (validate-configuration conf
+ #,(id #'stem #'stem #'-fields))
+ conf))))))))
(define (serialize-package field-name val)
"")