From debbugs-submit-bounces@debbugs.gnu.org Fri Mar 17 06:35:00 2017 Received: (at 26137) by debbugs.gnu.org; 17 Mar 2017 10:35:01 +0000 Received: from localhost ([127.0.0.1]:59665 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1copDo-0000cj-Kw for submit@debbugs.gnu.org; Fri, 17 Mar 2017 06:35:00 -0400 Received: from mail-wm0-f66.google.com ([74.125.82.66]:34323) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1copDm-0000cA-0a for 26137@debbugs.gnu.org; Fri, 17 Mar 2017 06:34:58 -0400 Received: by mail-wm0-f66.google.com with SMTP id u132so2524770wmg.1 for <26137@debbugs.gnu.org>; Fri, 17 Mar 2017 03:34:57 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=2JHQN5zyOKv6qzg5raL0RCSAq/dAmMXZt2oN3O/EpjM=; b=kbzJOFkiJj60EHmzA2inThOeRlqps9/NVGBzIo6+Z8ngm4Y5XlQp9GMBmqQfXaYrJp 3GKtF2r5TuPDx+Sz+w1nH5qCTJcScCZvRf2Y1xojJWIkaxW7fYvhMzt2Rn+lSmRyXliN EdAhq7ULTubgZN4vcIwLaIwgxJUcHcbkSokeD6Z534JJLIhbEofbUjIXe+RJgqJ00ujR +eTlT/aIxs1dNPBIeCNkTtffeju8gV1ADIfzcKBoH9/3OUZcIdBUgTUNHlRsURIcIaHJ 39AsgGKt2idUQaURxFbcGWNVwNypTuEtQl43fm2xRHb4D9iOgbjO31hcxObHbfonfqEK BRnw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=2JHQN5zyOKv6qzg5raL0RCSAq/dAmMXZt2oN3O/EpjM=; b=uigs0P0bPegkDJGsA8t2h7ZbnYw54rOPmtHUDihkJtUNi09DtA4x7O9fZAtp2PHeEM vOe/6TYQPZNSoFdbq/EBqB2VvEE0I8CIhGKMS9KWI684vbwNs/T7dpub3k+Dp89qdiNo LaY9EB6gckXIwc/KlrQPsUEXcSJh+vqyK5/fssLL4XN6ewcvU0QVjQ6TSFNCxKfSrY0v m1PjlFHXFek3CB9zYQSFhCU5oKWY3qVeH5BWzPg2+SWvlsVGZKgVJvmXwGEdDQHJ53lR amoWsgAuvVYKrnzuVKGuYyWzbrsEQ18Q3djbTs7vPr62m1YP99KRNephuYGMlec1jWWr 8dLw== X-Gm-Message-State: AFeK/H2cGwIDqNmMd6rFZ6adt2sT5h8TDlLo/5eCvfcx5PtW7Ledt8gMb38jTTBM5HG9Pg== X-Received: by 10.28.145.130 with SMTP id t124mr2145241wmd.39.1489746892224; Fri, 17 Mar 2017 03:34:52 -0700 (PDT) Received: from cervin.8.8.8.8 (85-169-37-239.rev.numericable.fr. [85.169.37.239]) by smtp.gmail.com with ESMTPSA id x127sm2149142wmf.31.2017.03.17.03.34.51 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Fri, 17 Mar 2017 03:34:51 -0700 (PDT) From: Mathieu Othacehe To: 26137@debbugs.gnu.org Subject: [PATCH 2/6] services: Factorize define-maybe macro. Date: Fri, 17 Mar 2017 11:34:26 +0100 Message-Id: <20170317103430.7629-2-m.othacehe@gmail.com> X-Mailer: git-send-email 2.12.0 In-Reply-To: <20170317103430.7629-1-m.othacehe@gmail.com> References: <20170317103430.7629-1-m.othacehe@gmail.com> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: 0.5 (/) X-Debbugs-Envelope-To: 26137 Cc: Mathieu Othacehe X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.5 (/) * 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 +;;; Copyright © 2017 Mathieu Othacehe ;;; ;;; 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 +;;; Copyright © 2017 Mathieu Othacehe ;;; ;;; 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