From 565733c4d71ebfa0f200d027de2ea663461c1bd3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 7 Mar 2021 15:26:17 +0100 Subject: grafts: Add 'without-grafting'. * guix/grafts.scm (call-without-grafting): New procedure. (without-grafting): New macro. --- guix/grafts.scm | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'guix/grafts.scm') diff --git a/guix/grafts.scm b/guix/grafts.scm index fd8a108092..7f5b97c39d 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -42,6 +42,7 @@ (define-module (guix grafts) graft-derivation/shallow %graft? + without-grafting set-grafting grafting?)) @@ -323,6 +324,17 @@ (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. -- cgit v1.2.3