aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorMathieu Othacehe <m.othacehe@gmail.com>2017-03-24 11:00:13 +0100
committerClément Lassieur <clement@lassieur.org>2017-03-24 16:09:17 +0100
commite7c797f3481a35905a5861059294815b2210f889 (patch)
treec5c8b429789039af647def13fb77edef175f6aa1 /gnu
parent32e75b4808c312f6ef99a2e200a75a0d056b60fe (diff)
downloadguix-e7c797f3481a35905a5861059294815b2210f889.tar.gz
guix-e7c797f3481a35905a5861059294815b2210f889.zip
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>
Diffstat (limited to 'gnu')
-rw-r--r--gnu/services/configuration.scm34
-rw-r--r--gnu/services/messaging.scm23
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)))