ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

grafts: Move '%graft?' and related bindings to (guix store).

Browse source 
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.
This commit is contained in:
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 @@ (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:

36
guix/store.scm
View file

@ -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.