Hi,
On Fri, Apr 23 2021, Xinglu Chen wrote:
>> Wouldn’t it be nicer to write:
>>
>> (define-configuration foo
>> (bar (integer 123) "doc" no-serializer)
>> (baz (string "") "doc"))
>>
>> where ‘bar’ wouldn’t have a serializer and ‘baz’ would?
>>
>> It’s also probably easier to implement correctly.
>
> I think that would be a good idea, maybe it could also make having a
> default value be optional, like this:
>
> #+begin_src scheme
> (define-configuration foo
> (bar (integer) "doc" no-serializer) ;no default
> (baz (string "default") "doc"))
> #+end_src
Since nobody seemed to show any objections, I went ahead and did
something like this myself (see the attached patches). My macros skills
aren’t that good so I hope I didn’t make any obvious mistakes. :)
I haven’t tested it thoroughly, but at least it didn’t break anything
when I ran ‘./pre-inst-env guix home build ...’. :)
>From 231281ebf555295e83513873293a1ad3eab884a8 Mon Sep 17 00:00:00 2001
Message-Id: <231281ebf555295e83513873293a1ad3eab884a8.1619869705.git.pub...@yoctocell.xyz>
In-Reply-To: <cover.1619869705.git.pub...@yoctocell.xyz>
References: <cover.1619869705.git.pub...@yoctocell.xyz>
From: Xinglu Chen <pub...@yoctocell.xyz>
Date: Sat, 1 May 2021 13:24:43 +0200
Subject: [PATCH 1/2] services: configuration: Support fields without default
values.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Not all fields in a configuration have a sensible default value,
e.g. ‘user.name’ in gitconfig, the user should have to set that themselves
* gnu/services/configuration.scm (configuration-missing-field): New procedure.
(define-configuration): Make default value optional.
---
gnu/services/configuration.scm | 78 ++++++++++++++++++++++------------
1 file changed, 51 insertions(+), 27 deletions(-)
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 90f12a8d39..85e1ac78cb 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2015 Andy Wingo <wi...@igalia.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othac...@gmail.com>
;;; Copyright © 2017, 2018 Clément Lassieur <clem...@lassieur.org>
+;;; Copyright © 2021 Xinglu Chen <pub...@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -63,6 +64,9 @@
(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 "`~a' in `~a' does not have a default value" kind field)))
(define-record-type* <configuration-field>
configuration-field make-configuration-field configuration-field?
@@ -112,7 +116,7 @@
(define-syntax define-configuration
(lambda (stx)
(syntax-case stx ()
- ((_ stem (field (field-type def) doc) ...)
+ ((_ stem (field (field-type properties ...) doc) ...)
(with-syntax (((field-getter ...)
(map (lambda (field)
(id #'stem #'stem #'- field))
@@ -121,36 +125,56 @@
(map (lambda (type)
(id #'stem type #'?))
#'(field-type ...)))
+ ((field-default ...)
+ (map (match-lambda
+ ((field-type default _ ...) default)
+ ;; We get warnings about `disabled' being an
+ ;; unbound variable unless we quote it.
+ (_ (syntax 'disabled)))
+ #'((field-type properties ...) ...)))
((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 (equal? (syntax->datum def) (quote 'disabled))
+ #`(#,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)
+ ;; TODO: What if there is no default value?
+ (default-value-thunk
+ (lambda ()
+ (display '#,(id #'stem #'% #'stem))
+ (if (equal? (syntax->datum field-default)
+ (quote 'disabled))
+ (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)
"")
--
2.31.1
>From 90d63a46a29a8080b7f95eabcec115c5c2c6481e Mon Sep 17 00:00:00 2001
Message-Id: <90d63a46a29a8080b7f95eabcec115c5c2c6481e.1619869705.git.pub...@yoctocell.xyz>
In-Reply-To: <cover.1619869705.git.pub...@yoctocell.xyz>
References: <cover.1619869705.git.pub...@yoctocell.xyz>
From: Xinglu Chen <pub...@yoctocell.xyz>
Date: Sat, 1 May 2021 13:31:27 +0200
Subject: [PATCH 2/2] services: configuration: Add ability to use custom
serializer.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Some configuration values should not be serialized to a configuration file,
e.g. command line options for a daemon.
* gnu/services/configuration.scm (define-configuration): Add option to use a
custom serializer.
(empty-serializer): New procedure.
(serialize-package): Alias to ‘empty-serializer’.
---
gnu/services/configuration.scm | 16 ++++++++++------
1 file changed, 10 insertions(+), 6 deletions(-)
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 85e1ac78cb..7024b13136 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -44,6 +44,7 @@
define-configuration
validate-configuration
generate-documentation
+ empty-serializer
serialize-package))
;;; Commentary:
@@ -116,7 +117,7 @@
(define-syntax define-configuration
(lambda (stx)
(syntax-case stx ()
- ((_ stem (field (field-type properties ...) doc) ...)
+ ((_ stem (field (field-type properties ...) doc custom-serializer ...) ...)
(with-syntax (((field-getter ...)
(map (lambda (field)
(id #'stem #'stem #'- field))
@@ -133,9 +134,12 @@
(_ (syntax 'disabled)))
#'((field-type properties ...) ...)))
((field-serializer ...)
- (map (lambda (type)
- (id #'stem #'serialize- type))
- #'(field-type ...))))
+ (map (lambda (type serializer)
+ (match serializer
+ (((serializer)) serializer)
+ (_ (id #'stem #'serialize- type))))
+ #'(field-type ...)
+ #'((custom-serializer ...) ...))))
#`(begin
(define-record-type* #,(id #'stem #'< #'stem #'>)
#,(id #'stem #'% #'stem)
@@ -176,8 +180,8 @@
#,(id #'stem #'stem #'-fields))
conf))))))))
-(define (serialize-package field-name val)
- "")
+(define (empty-serializer field-name val) "")
+(define serialize-package empty-serializer)
;; A little helper to make it easier to document all those fields.
(define (generate-documentation documentation documentation-name)
--
2.31.1
