services: Factorize define-maybe macro.

* 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.

Signed-off-by: Clément Lassieur <clement@lassieur.org>

2 files changed, 30 insertions, 27 deletions

diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 2ad3a637a4..400f231b94 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 <wingo@igalia.com>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; 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,16 +87,32 @@
                    (configuration-field-name field) val))))
             fields))
 
+(define (id ctx part . parts)
+  (let ((part (syntax->datum part)))
+    (datum->syntax
+     ctx
+     (match parts
+       (() 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)
-    (define (id ctx part . parts)
-      (let ((part (syntax->datum part)))
-        (datum->syntax
-         ctx
-         (match parts
-           (() part)
-           (parts (symbol-append part
-                                 (syntax->datum (apply id ctx parts))))))))
     (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 34723dc11c..715d6181f5 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 <clement@lassieur.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; 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)))