diff mbox series

[bug#54674,v4,1/2] services: configuration: Support (field1 maybe-number "") format.

Message ID 20220420091553.26732-1-attila@lendvai.name
State Accepted
Headers show
Series [bug#54674,v4,1/2] services: configuration: Support (field1 maybe-number "") format. | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/issue success View issue

Commit Message

Attila Lendvai April 20, 2022, 9:15 a.m. UTC 
As opposed to explicitly using 'disabled as value, or using the
(field1 (maybe-number) "") format.

It's mostly the work of Maxime Devos shared under #54674, with some
modifications by Attila Lendvai.

* gnu/services/configuration.scm (normalize-field-type+def): New function.
(define-configuration-helper) (define-configuration): Support new field
format.
* tests/services/configuration.scm (config-with-maybe-number->string): New
function.
("maybe value serialization of the instance"): New test.
("maybe value serialization of the instance, unspecified"): New test.
---

v4: the only change is to drop the extra parens around the type in
all the (field1 (maybe-foo) "") forms.

 gnu/services/configuration.scm   | 169 +++++++++++++++++--------------
 tests/services/configuration.scm |  28 ++++-
 2 files changed, 114 insertions(+), 83 deletions(-)

Comments

M April 23, 2022, 2:55 p.m. UTC | #1 
I didn't look into the code in detail, but for this kind of thing,
if it compiles, it probably works.  For completeness, you might want to
run a few system tests (‘make check-system’ IIRC).

However, ...

Attila Lendvai schreef op wo 20-04-2022 om 11:15 [+0200]:
> As opposed to explicitly using 'disabled as value, or using the
> (field1 (maybe-number) "") format.
> 
> It's mostly the work of Maxime Devos shared under #54674, with some
> modifications by Attila Lendvai.
> 
> * gnu/services/configuration.scm (normalize-field-type+def): New function.
> (define-configuration-helper) (define-configuration): Support new field
> format.
> * tests/services/configuration.scm (config-with-maybe-number->string): New
> function.
> ("maybe value serialization of the instance"): New test.
> ("maybe value serialization of the instance, unspecified"): New test.

... 'define-configuration' and 'disabled' is documented in the manual
(guix)Complex Configurations:

     When defining a “maybe type”, the corresponding serializer for the
     regular type will be used by default.  For example, a field of
     type ‘maybe-string’ will be serialized using the
     ‘serialize-string’ procedure by default, you can of course change
     this by specifying a custom serializer procedure.  Likewise, the
     type of the value would have to be a string, unless it is set to
     the ‘disabled’ symbol.

It also appears in other locations in the documentation:

     ‘daytime-brightness’ (default: ‘disabled’) (type: maybe-inexact-number)
          Daytime screen brightness, between 0.1 and 1.0.

   The available configuration parameters follow.  Each parameter
definition is preceded by its type; for example, ‘string-list foo’
indicates that the ‘foo’ parameter should be specified as a list of
strings.  Types starting with ‘maybe-’ denote parameters that won’t show
up in ‘prosody.cfg.lua’ when their value is ‘'disabled’.

     [...]

So the documentation appears to be needed to be changed as well.

Greetings,
Maxime.
Attila Lendvai May 17, 2022, 11:38 a.m. UTC | #2 
thank you for suggesting `make check-system` Maxime. it pointed out some issues with the jami service that i have fixed.

i would love to reshape this into something that will get merged. is there anything i can do to help that process?

unfortunately, `make check-system` returns with the attached output. after some staring and grepping, i can't identify why these tests are failing, and whether it is a new bug at all that happens due to my changes.

i'll send the new version of the patch in upcoming mails.

--
• attila lendvai
• PGP: 963F 5D5F 45C7 DFCD 0A39
--
“Anything that can contribute to such a fundamental change in our perception of reality must therefore command our earnest attention.”
	— Albert Hofmann (1906–2008), 'LSD: My Problem Child'
M May 17, 2022, 4:15 p.m. UTC | #3 
Attila Lendvai schreef op di 17-05-2022 om 11:38 [+0000]:
> unfortunately, `make check-system` returns with the attached output.
> after some staring and grepping, i can't identify why these tests are
> failing, and whether it is a new bug at all that happens due to my
> changes.

The standard test is to run "make check-system" again without patches
and see if it still fails.

> i would love to reshape this into something that will get merged.
> is there anything i can do to help that process?

AFAICT the patch is ready, except for maybe the Jami issue.

Also, if there are more reviewers for patches in general (and likewise,
more people investigating bugs), then committers have less to take care
of (-> faster response times).  Likewise with more committers.
That's more of a long-term and general (not specific to this patch)
thing though.

Greetings,
Maxime.
Attila Lendvai May 19, 2022, 2:21 p.m. UTC | #4 
> The standard test is to run "make check-system" again without patches
> and see if it still fails.


the trouble is that it fails even on master. i took the time now, pulled latest master, and ran a `make check-system`, and it fails the same way for me as with my patch. i've attached the log, produced this time by *master*; in essence:

This is the GNU system.  Welcome.
jami login: Jami Daemon 11.0.0, by Savoir-faire Linux 2004-2019
https://jami.net/
[Video support enabled]
[Plugins support enabled]

10:05:11.924         os_core_unix.c !pjlib 2.11 for POSIX initialized
Jami Daemon 11.0.0, by Savoir-faire Linux 2004-2019
https://jami.net/
[Video support enabled]
[Plugins support enabled]

One does not simply initialize the client: Another daemon is detected
/gnu/store/01phrvxnxrg1q0gxa35g7f77q06crf6v-shepherd-marionette.scm:1:1718: ERROR:
  1. &action-exception-error:
      service: jami
      action: start
      key: match-error
      args: ("match" "no matching pattern" #f)

[...]

--
• attila lendvai
• PGP: 963F 5D5F 45C7 DFCD 0A39
--
“You’ve stopped seeking the truth when you view doubt not as a clue to be followed but a challenge to be overcome.”
	— Peter Boghossian (1966–)
Attila Lendvai May 19, 2022, 8:41 p.m. UTC | #5 
FTR, master's `make check-system` failures are tracked here:

https://issues.guix.gnu.org/54786

--
• attila lendvai
• PGP: 963F 5D5F 45C7 DFCD 0A39
--
“War must be, while we defend our lives against a destroyer who would devour all; but I do not love the bright sword for its sharpness, nor the arrow for its swiftness, nor the warrior for his glory. I love only that which they defend.”
	— J. R. R. Tolkien (1892–1973), 'The Two Towers' (1954), http://youtu.be/jfxdlWje5nk
diff mbox series

Patch

diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 0de350a4df..bdca33ed68 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -5,6 +5,7 @@ 
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -162,78 +163,90 @@  (define-maybe-helper #t #f #'(_ stem))))))
 (define-syntax-rule (define-maybe/no-serialization stem)
   (define-maybe stem (no-serialization)))
 
+(define (normalize-field-type+def s)
+  (syntax-case s ()
+    ((field-type def)
+     (identifier? #'field-type)
+     (values #'(field-type def)))
+    ((field-type)
+     (identifier? #'field-type)
+     (values #'(field-type 'disabled)))
+    (field-type
+     (identifier? #'field-type)
+     (values #'(field-type 'disabled)))))
+
 (define (define-configuration-helper serialize? serializer-prefix syn)
   (syntax-case syn ()
-    ((_ stem (field (field-type def ...) doc custom-serializer ...) ...)
-     (with-syntax (((field-getter ...)
-                    (map (lambda (field)
-                           (id #'stem #'stem #'- field))
-    			 #'(field ...)))
-                   ((field-predicate ...)
-                    (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 custom-serializer)
-                           (and serialize?
-                                (match custom-serializer
-                                  ((serializer)
-                                   serializer)
-                                  (()
-                                   (if serializer-prefix
-                                       (id #'stem
-                                           serializer-prefix
-                                           #'serialize- type)
-                                       (id #'stem #'serialize- type))))))
-                         #'(field-type ...)
-                         #'((custom-serializer ...) ...))))
-       #`(begin
-    	   (define-record-type* #,(id #'stem #'< #'stem #'>)
-    	     #,(id #'stem #'% #'stem)
-    	     #,(id #'stem #'make- #'stem)
-    	     #,(id #'stem #'stem #'?)
-    	     (%location #,(id #'stem #'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)))))))
+    ((_ stem (field field-type+def doc custom-serializer ...) ...)
+     (with-syntax
+         ((((field-type def) ...)
+           (map normalize-field-type+def #'(field-type+def ...))))
+       (with-syntax
+           (((field-getter ...)
+             (map (lambda (field)
+                    (id #'stem #'stem #'- field))
+                  #'(field ...)))
+            ((field-predicate ...)
+             (map (lambda (type)
+                    (id #'stem type #'?))
+                  #'(field-type ...)))
+            ((field-default ...)
+             (map (match-lambda
+                    ((field-type default-value)
+                     default-value))
+                  #'((field-type def) ...)))
+            ((field-serializer ...)
+             (map (lambda (type custom-serializer)
+                    (and serialize?
+                         (match custom-serializer
+                           ((serializer)
+                            serializer)
+                           (()
+                            (if serializer-prefix
+                                (id #'stem
+                                    serializer-prefix
+                                    #'serialize- type)
+                                (id #'stem #'serialize- type))))))
+                  #'(field-type ...)
+                  #'((custom-serializer ...) ...))))
+         #`(begin
+             (define-record-type* #,(id #'stem #'< #'stem #'>)
+               #,(id #'stem #'% #'stem)
+               #,(id #'stem #'make- #'stem)
+               #,(id #'stem #'stem #'?)
+               (%location #,(id #'stem #'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 no-serialization         ;syntactic keyword for 'define-configuration'
   '(no serialization))
@@ -241,26 +254,26 @@  (define no-serialization         ;syntactic keyword for 'define-configuration'
 (define-syntax define-configuration
   (lambda (s)
     (syntax-case s (no-serialization prefix)
-      ((_ stem (field (field-type def ...) doc custom-serializer ...) ...
+      ((_ stem (field field-type+def doc custom-serializer ...) ...
           (no-serialization))
        (define-configuration-helper
-         #f #f #'(_ stem (field (field-type def ...) doc custom-serializer ...)
+         #f #f #'(_ stem (field field-type+def doc custom-serializer ...)
                  ...)))
-      ((_ stem  (field (field-type def ...) doc custom-serializer ...) ...
+      ((_ stem  (field field-type+def doc custom-serializer ...) ...
           (prefix serializer-prefix))
        (define-configuration-helper
-         #t #'serializer-prefix #'(_ stem (field (field-type def ...)
+         #t #'serializer-prefix #'(_ stem (field field-type+def
                                                  doc custom-serializer ...)
                  ...)))
-      ((_ stem (field (field-type def ...) doc custom-serializer ...) ...)
+      ((_ stem (field field-type+def doc custom-serializer ...) ...)
        (define-configuration-helper
-         #t #f #'(_ stem (field (field-type def ...) doc custom-serializer ...)
+         #t #f #'(_ stem (field field-type+def doc custom-serializer ...)
                  ...))))))
 
 (define-syntax-rule (define-configuration/no-serialization
-                      stem (field (field-type def ...)
+                      stem (field field-type+def
                                   doc custom-serializer ...) ...)
-  (define-configuration stem (field (field-type def ...)
+  (define-configuration stem (field field-type+def
                                     doc custom-serializer ...) ...
     (no-serialization)))
 
diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm
index 86a36a388d..0debf8095b 100644
--- a/tests/services/configuration.scm
+++ b/tests/services/configuration.scm
@@ -27,6 +27,9 @@  (define-module (tests services configuration)
 
 (test-begin "services-configuration")
 
+(define (serialize-number field value)
+  (format #f "~a=~a" field value))
+
 
 ;;;
 ;;; define-configuration macro.
@@ -47,7 +50,6 @@  (define-configuration port-configuration-cs
   80
   (port-configuration-cs-port (port-configuration-cs)))
 
-(define serialize-number "")
 (define-configuration port-configuration-ndv
   (port (number) "The port number."))
 
@@ -101,15 +103,31 @@  (define-configuration configuration-with-prefix
 (define-maybe number)
 
 (define-configuration config-with-maybe-number
-  (port (maybe-number 80) "The port number."))
-
-(define (serialize-number field value)
-  (format #f "~a=~a" field value))
+  (port  (maybe-number 80) "")
+  (count maybe-number ""))
 
 (test-equal "maybe value serialization"
   "port=80"
   (serialize-maybe-number "port" 80))
 
+(define (config-with-maybe-number->string x)
+  (eval (gexp->approximate-sexp
+         (serialize-configuration x config-with-maybe-number-fields))
+        (current-module)))
+
+(test-equal "maybe value serialization of the instance"
+  "port=42count=43"
+  (config-with-maybe-number->string
+   (config-with-maybe-number
+    (port 42)
+    (count 43))))
+
+(test-equal "maybe value serialization of the instance, unspecified"
+  "port=42"
+  (config-with-maybe-number->string
+   (config-with-maybe-number
+    (port 42))))
+
 (define-maybe/no-serialization string)
 
 (define-configuration config-with-maybe-string/no-serialization