mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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 @@ (define (show-help)
|
|||
(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
|
||||
|
|
33
guix/ui.scm
33
guix/ui.scm
|
@ -43,6 +43,7 @@ (define-module (guix ui)
|
|||
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 @@ (define (string->number* str)
|
|||
(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)
|
||||
|
|
25
tests/ui.scm
25
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 @@ (define %paragraph
|
|||
#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")
|
||||
|
||||
|
||||
|
|
Loading…
Reference in a new issue