me
/
guix
Archived
1
0
Fork 0
Code

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.
Ludovic Courtès 2022-10-14 21:51:18 +02:00
parent b544f46098
commit 5f0febcd45
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 41 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
guix/grafts.scm
View File

@ -39,12 +39,11 @@
graft-replacement-output graft-replacement-output
graft-derivation graft-derivation
graft-derivation/shallow graft-derivation/shallow)
#:re-export (%graft? ;for backward compatibility
%graft? without-grafting
without-grafting set-grafting
set-grafting grafting?))
grafting?))
(define-record-type* <graft> graft make-graft (define-record-type* <graft> graft make-graft
graft? graft?
@ -334,36 +333,6 @@ DRV, and graft DRV itself to refer to those grafted dependencies."
(graft-replacement first) (graft-replacement first)
drv))))) 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: ;; Local Variables:
;; eval: (put 'with-cache 'scheme-indent-function 1) ;; eval: (put 'with-cache 'scheme-indent-function 1)
;; End: ;; End:

36
guix/store.scm
View File

@ -182,6 +182,11 @@
interned-file interned-file
interned-file-tree interned-file-tree
%graft?
without-grafting
set-grafting
grafting?
%store-prefix %store-prefix
store-path store-path
output-path output-path
@ -2171,6 +2176,37 @@ connection, and return the result."
(set-store-connection-caches! store caches))) (set-store-connection-caches! store caches)))
result)))) 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. ;;; Store paths.