From patchwork Mon Oct 17 06:49:21 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 43459 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 559E027BBED; Mon, 17 Oct 2022 07:53:40 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 555FB27BBEA for ; Mon, 17 Oct 2022 07:53:39 +0100 (BST) Received: from localhost ([::1]:46904 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1okK0G-0000Mo-Ta for patchwork@mira.cbaines.net; Mon, 17 Oct 2022 02:53:38 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:53620) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1okJwo-0000CW-Fk for guix-patches@gnu.org; Mon, 17 Oct 2022 02:50:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:47911) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1okJwo-0003wg-50 for guix-patches@gnu.org; Mon, 17 Oct 2022 02:50:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1okJwo-0007aX-0Z for guix-patches@gnu.org; Mon, 17 Oct 2022 02:50:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#58579] [PATCH 1/4] grafts: Move '%graft?' and related bindings to (guix store). References: <20221017064750.2332-1-ludo@gnu.org> In-Reply-To: <20221017064750.2332-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 17 Oct 2022 06:50:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 58579 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 58579@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 58579-submit@debbugs.gnu.org id=B58579.166598937829101 (code B ref 58579); Mon, 17 Oct 2022 06:50:01 +0000 Received: (at 58579) by debbugs.gnu.org; 17 Oct 2022 06:49:38 +0000 Received: from localhost ([127.0.0.1]:46979 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1okJwP-0007ZC-Fx for submit@debbugs.gnu.org; Mon, 17 Oct 2022 02:49:38 -0400 Received: from eggs.gnu.org ([209.51.188.92]:37050) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1okJwN-0007Ys-TW for 58579@debbugs.gnu.org; Mon, 17 Oct 2022 02:49:36 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:36468) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1okJwI-0003u4-Ky; Mon, 17 Oct 2022 02:49:30 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=3ZwtGT2uh5yp9zeYIEBVDrzvoQQyRLtEWaoHuUDe+Zk=; b=ndSAd/Z6XaaTzY 3XzSPV1azRyYojNsKcVfglQ8W7XHCa/IKzj0vbX4mSIaaLm4Y/gtr2IgLKU6i0aoborU5yLWk3ibH Y0tj2kn8gQetjCVslZTWzYYouG+eiuItUKHec67ivToZlR3dkypnH7yScL87/7OzHyDIs/SBnpQl7 20z45cEmIpon2dBRrFhVxc5QNJo4cN6fP9+awQBDIKbZ8B1nTytXq8AoE3LvNpasgu+4m6Ai4O5Ky UlbAkiM/SuGmGcyXhwEtbSsCuKv+TzxHlDIdSRHnPQi6WVSUtZBTw4nqVDowTQTv+FSyTUMELtZNO mXdaAJZGNA5sXeiaU1fg==; Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=47894 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1okJwI-0004tN-5K; Mon, 17 Oct 2022 02:49:30 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Mon, 17 Oct 2022 08:49:21 +0200 Message-Id: <20221017064924.2379-1-ludo@gnu.org> X-Mailer: git-send-email 2.38.0 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches The goal is to allow (guix grafts) to use (guix gexp) without introducing a cycle between these two modules. * guix/grafts.scm (%graft?, call-without-grafting, without-grafting) (set-grafting, grafting?): Move to... * guix/store.scm: ... here. --- guix/grafts.scm | 41 +++++------------------------------------ guix/store.scm | 36 ++++++++++++++++++++++++++++++++++++ 2 files changed, 41 insertions(+), 36 deletions(-) diff --git a/guix/grafts.scm b/guix/grafts.scm index 0ffda8f9aa..252abfd8b3 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -39,12 +39,11 @@ (define-module (guix grafts) graft-replacement-output graft-derivation - graft-derivation/shallow - - %graft? - without-grafting - set-grafting - grafting?)) + graft-derivation/shallow) + #:re-export (%graft? ;for backward compatibility + without-grafting + set-grafting + grafting?)) (define-record-type* graft make-graft graft? @@ -334,36 +333,6 @@ (define* (graft-derivation store drv grafts (graft-replacement first) drv))))) - -;; The following might feel more at home in (guix packages) but since (guix -;; gexp), which is a lower level, needs them, we put them here. - -(define %graft? - ;; Whether to honor package grafts by default. - (make-parameter #t)) - -(define (call-without-grafting thunk) - (lambda (store) - (values (parameterize ((%graft? #f)) - (run-with-store store (thunk))) - store))) - -(define-syntax-rule (without-grafting mexp ...) - "Bind monadic expressions MEXP in a dynamic extent where '%graft?' is -false." - (call-without-grafting (lambda () (mbegin %store-monad mexp ...)))) - -(define-inlinable (set-grafting enable?) - ;; This monadic procedure enables grafting when ENABLE? is true, and - ;; disables it otherwise. It returns the previous setting. - (lambda (store) - (values (%graft? enable?) store))) - -(define-inlinable (grafting?) - ;; Return a Boolean indicating whether grafting is enabled. - (lambda (store) - (values (%graft?) store))) - ;; Local Variables: ;; eval: (put 'with-cache 'scheme-indent-function 1) ;; End: diff --git a/guix/store.scm b/guix/store.scm index 4d21c5ff1a..a36dce416e 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -182,6 +182,11 @@ (define-module (guix store) interned-file interned-file-tree + %graft? + without-grafting + set-grafting + grafting? + %store-prefix store-path output-path @@ -2171,6 +2176,37 @@ (define* (run-with-store store mval (set-store-connection-caches! store caches))) result)))) + +;;; +;;; Whether to enable grafts. +;;; + +(define %graft? + ;; Whether to honor package grafts by default. + (make-parameter #t)) + +(define (call-without-grafting thunk) + (lambda (store) + (values (parameterize ((%graft? #f)) + (run-with-store store (thunk))) + store))) + +(define-syntax-rule (without-grafting mexp ...) + "Bind monadic expressions MEXP in a dynamic extent where '%graft?' is +false." + (call-without-grafting (lambda () (mbegin %store-monad mexp ...)))) + +(define-inlinable (set-grafting enable?) + ;; This monadic procedure enables grafting when ENABLE? is true, and + ;; disables it otherwise. It returns the previous setting. + (lambda (store) + (values (%graft? enable?) store))) + +(define-inlinable (grafting?) + ;; Return a Boolean indicating whether grafting is enabled. + (lambda (store) + (values (%graft?) store))) + ;;; ;;; Store paths.