ui: Make 'check-available-space' public.
* guix/ui.scm (check-available-space): Add optional 'directory' parameter, defaulting to (%store-prefix). Honor it. Make public.
This commit is contained in:
parent
0744a9f002
commit
8120b23e51
10
guix/ui.scm
10
guix/ui.scm
|
@ -87,6 +87,7 @@
|
||||||
leave-on-EPIPE
|
leave-on-EPIPE
|
||||||
read/eval
|
read/eval
|
||||||
read/eval-package-expression
|
read/eval-package-expression
|
||||||
|
check-available-space
|
||||||
location->string
|
location->string
|
||||||
fill-paragraph
|
fill-paragraph
|
||||||
%text-width
|
%text-width
|
||||||
|
@ -795,16 +796,17 @@ error."
|
||||||
(derivation->output-path derivation out-name)))
|
(derivation->output-path derivation out-name)))
|
||||||
(derivation-outputs derivation))))
|
(derivation-outputs derivation))))
|
||||||
|
|
||||||
(define (check-available-space need)
|
(define* (check-available-space need
|
||||||
"Make sure at least NEED bytes are available in the store. Otherwise emit a
|
#:optional (directory (%store-prefix)))
|
||||||
|
"Make sure at least NEED bytes are available in DIRECTORY. Otherwise emit a
|
||||||
warning."
|
warning."
|
||||||
(let ((free (catch 'system-error
|
(let ((free (catch 'system-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(free-disk-space (%store-prefix)))
|
(free-disk-space directory))
|
||||||
(const #f))))
|
(const #f))))
|
||||||
(when (and free (>= need free))
|
(when (and free (>= need free))
|
||||||
(warning (G_ "at least ~,1h MB needed but only ~,1h MB available in ~a~%")
|
(warning (G_ "at least ~,1h MB needed but only ~,1h MB available in ~a~%")
|
||||||
(/ need 1e6) (/ free 1e6) (%store-prefix)))))
|
(/ need 1e6) (/ free 1e6) directory))))
|
||||||
|
|
||||||
(define* (show-what-to-build store drv
|
(define* (show-what-to-build store drv
|
||||||
#:key dry-run? (use-substitutes? #t)
|
#:key dry-run? (use-substitutes? #t)
|
||||||
|
|
Loading…
Reference in New Issue