diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-04-08 22:01:44 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-04-08 22:01:44 +0200 |
commit | 1d6243cf70269acdaf32f1ad61beba241f130484 (patch) | |
tree | c095e485d515820680f74ae2bd321d00d91190de /guix/ui.scm | |
parent | c397e502ca4f9a929e213e1c728b942a007ee278 (diff) | |
download | gnu-guix-1d6243cf70269acdaf32f1ad61beba241f130484.tar gnu-guix-1d6243cf70269acdaf32f1ad61beba241f130484.tar.gz |
ui: Add 'size->number'.
* guix/scripts/gc.scm (size->number): Remove.
* guix/ui.scm (size->number): New procedure.
* tests/ui.scm ("size->number, bytes",
"size->number, MiB", "size->number, GiB", "size->number, 1.2GiB",
"size->number, invalid unit"): New tests.
Diffstat (limited to 'guix/ui.scm')
-rw-r--r-- | guix/ui.scm | 33 |
1 files changed, 33 insertions, 0 deletions
diff --git a/guix/ui.scm b/guix/ui.scm index dcad55e72e..944c9f87fa 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -43,6 +43,7 @@ show-version-and-exit show-bug-report-information string->number* + size->number show-what-to-build call-with-error-handling with-error-handling @@ -160,6 +161,38 @@ General help using GNU software: <http://www.gnu.org/gethelp/>")) (or (string->number str) (leave (_ "~a: invalid number~%") str))) +(define (size->number str) + "Convert STR, a storage measurement representation such as \"1024\" or +\"1MiB\", to a number of bytes. Raise an error if STR could not be +interpreted." + (define unit-pos + (string-rindex str char-set:digit)) + + (define unit + (and unit-pos (substring str (+ 1 unit-pos)))) + + (let* ((numstr (if unit-pos + (substring str 0 (+ 1 unit-pos)) + str)) + (num (string->number numstr))) + (unless num + (leave (_ "invalid number: ~a~%") numstr)) + + ((compose inexact->exact round) + (* num + (match unit + ("KiB" (expt 2 10)) + ("MiB" (expt 2 20)) + ("GiB" (expt 2 30)) + ("TiB" (expt 2 40)) + ("KB" (expt 10 3)) + ("MB" (expt 10 6)) + ("GB" (expt 10 9)) + ("TB" (expt 10 12)) + ("" 1) + (_ + (leave (_ "unknown unit: ~a~%") unit))))))) + (define (call-with-error-handling thunk) "Call THUNK within a user-friendly error handler." (guard (c ((package-input-error? c) |