]> gitweb.factorcode.org Git - factor.git/blob - extra/mason/disk/disk.factor
88b0414fe4c91ae5d4dc3cdd5e27bf1b2c914734
[factor.git] / extra / mason / disk / disk.factor
1 ! Copyright (C) 2010 Slava Pestov, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors formatting io.files.info io.pathnames kernel
4 mason.config math namespaces ;
5 IN: mason.disk
6
7 : Gi ( n -- gibibits ) 30 2^ * ; inline
8
9 : sufficient-disk-space? ( -- ? )
10     current-directory get find-mount-point-info
11     file-system-info available-space>>
12     1 Gi > ;
13
14 : check-disk-space ( -- )
15     sufficient-disk-space? [
16         "Less than 1 Gi free disk space." throw
17     ] unless ;
18
19 : Gi-str ( n -- string ) 1 Gi /f ;
20
21 : path>disk-usage ( path -- string )
22     find-mount-point-info
23     [ used-space>> ] [ available-space>> ] [ total-space>> ] tri
24     2dup /f 100 *
25     [ [ Gi-str ] tri@ ] dip
26     "%0.2fGi used, %0.2fGi avail, %0.2fGi total, %0.2f%% free" sprintf ;
27
28 : disk-usage ( -- string )
29     builds-dir get path>disk-usage ;