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:
Ludovic Courtès 2018-07-02 23:51:20 +02:00
parent 0744a9f002
commit 8120b23e51
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 6 additions and 4 deletions

View File

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