summaryrefslogtreecommitdiff
path: root/guix/store.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-10-14 21:51:18 +0200
committerLudovic Courtès <ludo@gnu.org>2022-10-22 01:46:54 +0200
commit5f0febcd459d103e6078e688aa28d5d832d82a60 (patch)
tree890bb225ac10a325e593afe1161c0f12d8a3cc61 /guix/store.scm
parentb544f460989a6189af111bb3ff6752cabdf23abc (diff)
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.
Diffstat (limited to 'guix/store.scm')
-rw-r--r--guix/store.scm36
1 files changed, 36 insertions, 0 deletions
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 @@
interned-file
interned-file-tree
+ %graft?
+ without-grafting
+ set-grafting
+ grafting?
+
%store-prefix
store-path
output-path
@@ -2173,6 +2178,37 @@ connection, and return the 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.
;;;