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

35
guix/grafts.scm
View File

@ -39,9 +39,8 @@
graft-replacement-output
graft-derivation
graft-derivation/shallow
%graft?
graft-derivation/shallow)
#:re-export (%graft? ;for backward compatibility
without-grafting
set-grafting
grafting?))
@ -334,36 +333,6 @@ DRV, and graft DRV itself to refer to those grafted dependencies."
(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:

36
guix/store.scm
View File

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