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.
			
			
This commit is contained in:
		
							parent
							
								
									c397e502ca
								
							
						
					
					
						commit
						1d6243cf70
					
				
					 3 changed files with 57 additions and 31 deletions
				
			
		|  | @ -62,36 +62,6 @@ Invoke the garbage collector.\n")) | ||||||
|   (newline) |   (newline) | ||||||
|   (show-bug-report-information)) |   (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 | (define %options | ||||||
|   ;; Specification of the command-line options. |   ;; Specification of the command-line options. | ||||||
|   (list (option '(#\h "help") #f #f |   (list (option '(#\h "help") #f #f | ||||||
|  |  | ||||||
							
								
								
									
										33
									
								
								guix/ui.scm
									
										
									
									
									
								
							
							
						
						
									
										33
									
								
								guix/ui.scm
									
										
									
									
									
								
							|  | @ -43,6 +43,7 @@ | ||||||
|             show-version-and-exit |             show-version-and-exit | ||||||
|             show-bug-report-information |             show-bug-report-information | ||||||
|             string->number* |             string->number* | ||||||
|  |             size->number | ||||||
|             show-what-to-build |             show-what-to-build | ||||||
|             call-with-error-handling |             call-with-error-handling | ||||||
|             with-error-handling |             with-error-handling | ||||||
|  | @ -160,6 +161,38 @@ General help using GNU software: <http://www.gnu.org/gethelp/>")) | ||||||
|   (or (string->number str) |   (or (string->number str) | ||||||
|       (leave (_ "~a: invalid 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) | (define (call-with-error-handling thunk) | ||||||
|   "Call THUNK within a user-friendly error handler." |   "Call THUNK within a user-friendly error handler." | ||||||
|   (guard (c ((package-input-error? c) |   (guard (c ((package-input-error? c) | ||||||
|  |  | ||||||
							
								
								
									
										25
									
								
								tests/ui.scm
									
										
									
									
									
								
							
							
						
						
									
										25
									
								
								tests/ui.scm
									
										
									
									
									
								
							|  | @ -1,5 +1,5 @@ | ||||||
| ;;; GNU Guix --- Functional package management for GNU | ;;; 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. | ;;; This file is part of GNU Guix. | ||||||
| ;;; | ;;; | ||||||
|  | @ -166,6 +166,29 @@ interface, and powerful string processing.") | ||||||
|   #f |   #f | ||||||
|   (string->duration "d")) |   (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") | (test-end "ui") | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  |  | ||||||
		Reference in a new issue