steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
factor/extra/mason/disk/disk.factor

29 lines
861 B
Factor
Raw Normal View History

mason.disk: Better handling of free disk space. - Works if the build directory does not exist, assuming it would be created on the root disk containing the path of the first existing parent directory - Space calculation is wrong, we should be using the available space - MB is GB, comment was wrong - Call find-mount-point-info to get the real disk mount point even if the dir does not exist
2020-01-03 11:48:24 -05:00
! Copyright (C) 2010 Slava Pestov, Doug Coleman.
mason: various assorted improvements - put disk usage in build report - bump minimum disk space required before starting a build from 300mb to 1gb - check repository consistency before pulling; if there are untracked files, or if the pull fails, blow away the repo and clone it again
2010-09-05 18:22:02 -04:00
! See http://factorcode.org/license.txt for BSD license.
mason.disk: Better handling of free disk space. - Works if the build directory does not exist, assuming it would be created on the root disk containing the path of the first existing parent directory - Space calculation is wrong, we should be using the available space - MB is GB, comment was wrong - Call find-mount-point-info to get the real disk mount point even if the dir does not exist
2020-01-03 11:48:24 -05:00
USING: accessors formatting io.files.info io.pathnames kernel
mason.config math namespaces ;
mason: various assorted improvements - put disk usage in build report - bump minimum disk space required before starting a build from 300mb to 1gb - check repository consistency before pulling; if there are untracked files, or if the pull fails, blow away the repo and clone it again
2010-09-05 18:22:02 -04:00
IN: mason.disk
mason.disk: Better handling of free disk space. - Works if the build directory does not exist, assuming it would be created on the root disk containing the path of the first existing parent directory - Space calculation is wrong, we should be using the available space - MB is GB, comment was wrong - Call find-mount-point-info to get the real disk mount point even if the dir does not exist
2020-01-03 11:48:24 -05:00
: Gi ( n -- gibibits ) 30 2^ * ; inline
mason: various assorted improvements - put disk usage in build report - bump minimum disk space required before starting a build from 300mb to 1gb - check repository consistency before pulling; if there are untracked files, or if the pull fails, blow away the repo and clone it again
2010-09-05 18:22:02 -04:00
: sufficient-disk-space? ( -- ? )
mason.disk: fix word name
2020-01-04 14:40:26 -05:00
current-directory get find-mount-point
file-system-info available-space>> 1 Gi > ;
mason: various assorted improvements - put disk usage in build report - bump minimum disk space required before starting a build from 300mb to 1gb - check repository consistency before pulling; if there are untracked files, or if the pull fails, blow away the repo and clone it again
2010-09-05 18:22:02 -04:00
: check-disk-space ( -- )
sufficient-disk-space? [
mason.disk: Better handling of free disk space. - Works if the build directory does not exist, assuming it would be created on the root disk containing the path of the first existing parent directory - Space calculation is wrong, we should be using the available space - MB is GB, comment was wrong - Call find-mount-point-info to get the real disk mount point even if the dir does not exist
2020-01-03 11:48:24 -05:00
"Less than 1 Gi free disk space." throw
mason: various assorted improvements - put disk usage in build report - bump minimum disk space required before starting a build from 300mb to 1gb - check repository consistency before pulling; if there are untracked files, or if the pull fails, blow away the repo and clone it again
2010-09-05 18:22:02 -04:00
] unless ;
mason.disk: Better handling of free disk space. - Works if the build directory does not exist, assuming it would be created on the root disk containing the path of the first existing parent directory - Space calculation is wrong, we should be using the available space - MB is GB, comment was wrong - Call find-mount-point-info to get the real disk mount point even if the dir does not exist
2020-01-03 11:48:24 -05:00
: Gi-str ( n -- string ) 1 Gi /f ;
: path>disk-usage ( path -- string )
mason.disk: fix word name
2020-01-04 14:40:26 -05:00
find-mount-point file-system-info
mason.disk: Better handling of free disk space. - Works if the build directory does not exist, assuming it would be created on the root disk containing the path of the first existing parent directory - Space calculation is wrong, we should be using the available space - MB is GB, comment was wrong - Call find-mount-point-info to get the real disk mount point even if the dir does not exist
2020-01-03 11:48:24 -05:00
[ used-space>> ] [ available-space>> ] [ total-space>> ] tri
2dup /f 100 *
[ [ Gi-str ] tri@ ] dip
"%0.2fGi used, %0.2fGi avail, %0.2fGi total, %0.2f%% free" sprintf ;
mason: various assorted improvements - put disk usage in build report - bump minimum disk space required before starting a build from 300mb to 1gb - check repository consistency before pulling; if there are untracked files, or if the pull fails, blow away the repo and clone it again
2010-09-05 18:22:02 -04:00
: disk-usage ( -- string )
mason.disk: Fix usage of word
2020-01-03 16:18:14 -05:00
builds-dir get path>disk-usage ;