bug#26137: [PATCH 2/6] services: Factorize define-maybe macro.

[Mathieu Othacehe]

* gnu/services/configuration.scm (id): New procedure extracted from
  define-configuration.
(define-maybe): New exported procedure, moved from messaging.scm.
* gnu/services/messaging.scm (define-maybe): Remove it.
(id): Move declaration inside define-all-configurations which is now
the only caller procedure.
---
 gnu/services/configuration.scm | 24 +++++++++++++++++++++---
 gnu/services/messaging.scm     | 23 ++++-------------------
 2 files changed, 25 insertions(+), 22 deletions(-)

diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 2ad3a637a..f59920d5a 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Andy Wingo <address@hidden>
+;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,6 +37,7 @@
             configuration-field-default-value-thunk
             configuration-field-documentation
             serialize-configuration
+            define-maybe
             define-configuration
             validate-configuration
             generate-documentation
@@ -85,9 +87,7 @@
                    (configuration-field-name field) val))))
             fields))
 
-(define-syntax define-configuration
-  (lambda (stx)
-    (define (id ctx part . parts)
+(define (id ctx part . parts)
       (let ((part (syntax->datum part)))
         (datum->syntax
          ctx
@@ -95,6 +95,24 @@
            (() part)
            (parts (symbol-append part
                                  (syntax->datum (apply id ctx parts))))))))
+
+(define-syntax define-maybe
+  (lambda (x)
+    (syntax-case x ()
+      ((_ 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)
+               (when (stem? val) (serialize-stem field-name val)))))))))
+
+(define-syntax define-configuration
+  (lambda (stx)
     (syntax-case stx ()
       ((_ stem (field (field-type def) doc) ...)
        (with-syntax (((field-getter ...)
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 34723dc11..715d6181f 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Clément Lassieur <address@hidden>
+;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -49,27 +50,11 @@
 ;;;
 ;;; Code:
 
-(define-syntax-rule (id ctx parts ...)
-  "Assemble PARTS into a raw (unhygienic) identifier."
-  (datum->syntax ctx (symbol-append (syntax->datum parts) ...)))
-
-(define-syntax define-maybe
-  (lambda (x)
-    (syntax-case x ()
-      ((_ 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)
-               (when (stem? val) (serialize-stem field-name val)))))))))
-
 (define-syntax define-all-configurations
   (lambda (stx)
+    (define-syntax-rule (id ctx parts ...)
+      "Assemble PARTS into a raw (unhygienic) identifier."
+      (datum->syntax ctx (symbol-append (syntax->datum parts) ...)))
     (define (make-pred arg)
       (lambda (field target)
         (and (memq (syntax->datum target) `(common ,arg)) field)))
-- 
2.12.0