01/06: services: configuration: Add a define-maybe/no-serialization syntax.

[guix-commits]

apteryx pushed a commit to branch master
in repository guix.

commit b7297d66c58b4fe2c153dce4f1069235269cd005
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Sun May 16 01:09:39 2021 -0400

    services: configuration: Add a define-maybe/no-serialization syntax.
    
    Before this change, using define-maybe along define-configuration with the
    no-serialization syntactic keyword would result in the following warning:
    
      warning: possibly unbound variable `VARIABLE-NAME'
    
    This change introduces the define-maybe/no-serialization variant that does
    away with defining a serialization helper procedure, which makes it possible
    to avoid the above warning.
    
    * gnu/services/configuration.scm (define-maybe/no-serialization): New 
syntax.
    (define-maybe-helper): New procedure.
    (define-maybe): Define syntax using the above procedure.
    * tests/services/configuration.scm (tests): Fix module name.
    (custom-number-serializer): Do not print to standard output.
    (maybe-number?, serialize-maybe-number): New procedures defined via the
    define-maybe macro.
    (config-with-maybe-number): New configuration.
    (serialize-number): New procedure.
    ("maybe value serialization"): New test.
    (maybe-string?): New procedure defined via the define-maybe/no-serialization
    macro.
    (config-with-maybe-string/no-serialization): New configuration.
    ("maybe value without serialization no procedure bound"): New test.
---
 gnu/services/configuration.scm   | 37 ++++++++++++++++++++++++++-----------
 tests/services/configuration.scm | 29 +++++++++++++++++++++++++++--
 2 files changed, 53 insertions(+), 13 deletions(-)

diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 21cb829..72b1d1c 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -48,6 +48,7 @@
 
             serialize-configuration
             define-maybe
+            define-maybe/no-serialization
             validate-configuration
             generate-documentation
             configuration->documentation
@@ -107,20 +108,34 @@ does not have a default value" field kind)))
   "Assemble PARTS into a raw (unhygienic) identifier."
   (datum->syntax ctx (symbol-append (syntax->datum parts) ...)))
 
+(define (define-maybe-helper serialize? syn)
+  (syntax-case syn ()
+    ((_ stem)
+     (with-syntax
+         ((stem?            (id #'stem #'stem #'?))
+          (maybe-stem?      (id #'stem #'maybe- #'stem #'?))
+          (serialize-stem   (id #'stem #'serialize- #'stem))
+          (serialize-maybe-stem (id #'stem #'serialize-maybe- #'stem)))
+       #`(begin
+           (define (maybe-stem? val)
+             (or (eq? val 'disabled) (stem? val)))
+           #,@(if serialize?
+                  (list #'(define (serialize-maybe-stem field-name val)
+                            (if (stem? val)
+                                (serialize-stem field-name val)
+                                "")))
+                  '()))))))
+
 (define-syntax define-maybe
   (lambda (x)
-    (syntax-case x ()
+    (syntax-case x (no-serialization)
+      ((_ stem (no-serialization))
+       (define-maybe-helper #f #'(_ stem)))
       ((_ stem)
-       (with-syntax
-           ((stem?                (id #'stem #'stem #'?))
-            (maybe-stem?          (id #'stem #'maybe- #'stem #'?))
-            (serialize-stem       (id #'stem #'serialize- #'stem))
-            (serialize-maybe-stem (id #'stem #'serialize-maybe- #'stem)))
-         #'(begin
-             (define (maybe-stem? val)
-               (or (eq? val 'disabled) (stem? val)))
-             (define (serialize-maybe-stem field-name val)
-               (if (stem? val) (serialize-stem field-name val) ""))))))))
+       (define-maybe-helper #t #'(_ stem))))))
+
+(define-syntax-rule (define-maybe/no-serialization stem)
+  (define-maybe stem (no-serialization)))
 
 (define (define-configuration-helper serialize? syn)
   (syntax-case syn ()
diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm
index 21ad188..85badd2 100644
--- a/tests/services/configuration.scm
+++ b/tests/services/configuration.scm
@@ -16,7 +16,7 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
-(define-module (tests services linux)
+(define-module (tests services configuration)
   #:use-module (gnu services configuration)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-34)
@@ -61,7 +61,7 @@
     (port-configuration-ndv-port (port-configuration-ndv))))
 
 (define (custom-number-serializer name value)
-  (format #t "~a = ~a;" name value))
+  (format #f "~a = ~a;" name value))
 
 (define-configuration serializable-configuration
   (port (number 80) "The port number." custom-number-serializer))
@@ -81,3 +81,28 @@
   (not (false-if-exception
         (let ((config (serializable-configuration)))
           (serialize-configuration config 
serializable-configuration-fields)))))
+
+
+;;;
+;;; define-maybe macro.
+;;;
+(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))
+
+(test-equal "maybe value serialization"
+  "port=80"
+  (serialize-maybe-number "port" 80))
+
+(define-maybe/no-serialization string)
+
+(define-configuration config-with-maybe-string/no-serialization
+  (name (maybe-string) "The name of the item.")
+  (no-serialization))
+
+(test-assert "maybe value without serialization no procedure bound"
+  (not (defined? 'serialize-maybe-string)))