aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-04-08 22:01:44 +0200
committerLudovic Courtès <ludo@gnu.org>2014-04-08 22:01:44 +0200
commit1d6243cf70269acdaf32f1ad61beba241f130484 (patch)
treec095e485d515820680f74ae2bd321d00d91190de
parentc397e502ca4f9a929e213e1c728b942a007ee278 (diff)
downloadguix-1d6243cf70269acdaf32f1ad61beba241f130484.tar
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.
-rw-r--r--guix/scripts/gc.scm30
-rw-r--r--guix/ui.scm33
-rw-r--r--tests/ui.scm25
3 files changed, 57 insertions, 31 deletions
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 77ec7635de..ed16cab8f9 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -62,36 +62,6 @@ Invoke the garbage collector.\n"))
(newline)
(show-bug-report-information))
-(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)))
- (if num
- (* 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))))
- (leave (_ "invalid number: ~a~%") numstr))))
-
(define %options
;; Specification of the command-line options.
(list (option '(#\h "help") #f #f
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)
diff --git a/tests/ui.scm b/tests/ui.scm
index 08ee3967a8..886223ef54 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -166,6 +166,29 @@ interface, and powerful string processing.")
#f
(string->duration "d"))
+(test-equal "size->number, bytes"
+ 42
+ (size->number "42"))
+
+(test-equal "size->number, MiB"
+ (* 42 (expt 2 20))
+ (size->number "42MiB"))
+
+(test-equal "size->number, GiB"
+ (* 3 (expt 2 30))
+ (size->number "3GiB"))
+
+(test-equal "size->number, 1.2GiB"
+ (inexact->exact (round (* 1.2 (expt 2 30))))
+ (size->number "1.2GiB"))
+
+(test-assert "size->number, invalid unit"
+ (catch 'quit
+ (lambda ()
+ (size->number "9X"))
+ (lambda args
+ #t)))
+
(test-end "ui")