diff mbox series

[bug#58579,1/4] grafts: Move '%graft?' and related bindings to (guix store).

Message ID 20221017064924.2379-1-ludo@gnu.org
State Accepted
Headers show
Series Rewrite grafts using gexps | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git-branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/issue success View issue

Commit Message

Ludovic Courtès Oct. 17, 2022, 6:49 a.m. UTC 
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.
---
 guix/grafts.scm | 41 +++++------------------------------------
 guix/store.scm  | 36 ++++++++++++++++++++++++++++++++++++
 2 files changed, 41 insertions(+), 36 deletions(-)
diff mbox series

Patch

diff --git a/guix/grafts.scm b/guix/grafts.scm
index 0ffda8f9aa..252abfd8b3 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -39,12 +39,11 @@  (define-module (guix grafts)
             graft-replacement-output
 
             graft-derivation
-            graft-derivation/shallow
-
-            %graft?
-            without-grafting
-            set-grafting
-            grafting?))
+            graft-derivation/shallow)
+  #:re-export (%graft?                            ;for backward compatibility
+               without-grafting
+               set-grafting
+               grafting?))
 
 (define-record-type* <graft> graft make-graft
   graft?
@@ -334,36 +333,6 @@  (define* (graft-derivation store drv grafts
            (graft-replacement first)
            drv)))))
 
-
-;; The following might feel more at home in (guix packages) but since (guix
-;; gexp), which is a lower level, needs them, we put them here.
-
-(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)))
-
 ;; Local Variables:
 ;; eval: (put 'with-cache 'scheme-indent-function 1)
 ;; End:
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 @@  (define-module (guix store)
             interned-file
             interned-file-tree
 
+            %graft?
+            without-grafting
+            set-grafting
+            grafting?
+
             %store-prefix
             store-path
             output-path
@@ -2171,6 +2176,37 @@  (define* (run-with-store store mval
             (set-store-connection-caches! store caches)))
         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.