mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-12 06:06:53 -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)
|
(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 @@ (define-module (guix ui)
|
||||||
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 @@ (define (string->number* str)
|
||||||
(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 @@ (define %paragraph
|
||||||
#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")
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue