14/17: grafts: Add 'without-grafting'.

[guix-commits]

civodul pushed a commit to branch wip-build-systems-gexp
in repository guix.

commit 0c3dcd296e01ea492d4b86cd94d704912b94011b
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Mar 7 15:26:17 2021 +0100

    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(+)

diff --git a/guix/grafts.scm b/guix/grafts.scm
index fd8a108..7f5b97c 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.