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.