From 5f0febcd459d103e6078e688aa28d5d832d82a60 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 14 Oct 2022 21:51:18 +0200 Subject: grafts: Move '%graft?' and related bindings to (guix store). 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/store.scm | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) (limited to 'guix/store.scm') 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. -- cgit v1.2.3