grafts: Add 'without-grafting'.

* guix/grafts.scm (call-without-grafting): New procedure.
(without-grafting): New macro.

1 files changed, 12 insertions, 0 deletions

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 @@
             graft-derivation/shallow
 
             %graft?
+            without-grafting
             set-grafting
             grafting?))
 
@@ -323,6 +324,17 @@ DRV, and graft DRV itself to refer to those grafted dependencies."
   ;; 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.