From 1d6243cf70269acdaf32f1ad61beba241f130484 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 8 Apr 2014 22:01:44 +0200
Subject: 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.
---
 guix/scripts/gc.scm | 30 ------------------------------
 guix/ui.scm         | 33 +++++++++++++++++++++++++++++++++
 tests/ui.scm        | 25 ++++++++++++++++++++++++-
 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")
 
 
-- 
cgit 1.4.1