M: object mount-points
file-systems [ [ mount-point>> ] keep ] H{ } map>assoc ;
-: (find-mount-point) ( path assoc -- path )
+: (find-mount-point) ( path assoc -- object )
[ resolve-symlinks canonicalize-path-full ] dip
2dup at* [
2nip
] [
- drop [ parent-directory ] dip
- (find-mount-point)
+ drop [ parent-directory ] dip (find-mount-point)
] if ;
-: find-mount-point ( path -- path' )
- mount-points (find-mount-point) mount-point>> ;
+: find-mount-point ( path -- object )
+ mount-points (find-mount-point) ;
{
{ [ os unix? ] [ "io.files.info.unix" ] }
CHAR: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter
[ mtab-csv>mtab-entry ] map ;
+: (file-system-info) ( path -- file-system-info )
+ [ new-file-system-info ] dip
+ [ file-system-statfs statfs>file-system-info ]
+ [ file-system-statvfs statvfs>file-system-info ] bi
+ file-system-calculations ; inline
+
: mtab-entry>file-system-info ( mtab-entry -- file-system-info/f )
'[
- _ [ mount-point>> file-system-info ] keep
+ _ [ mount-point>> (file-system-info) ] [ ] bi
{
[ file-system-name>> >>device-name ]
[ mount-point>> >>mount-point ]
parse-mtab [ mtab-entry>file-system-info ] map sift ;
M: linux file-system-info ( path -- file-system-info )
- normalize-path
- [
- [ new-file-system-info ] dip
- [ file-system-statfs statfs>file-system-info ]
- [ file-system-statvfs statvfs>file-system-info ] bi
- file-system-calculations
- ] keep
- find-mount-point-info
+ normalize-path [ (file-system-info) ] [ ] bi
+ find-mount-point
{
[ file-system-name>> >>device-name drop ]
[ mount-point>> >>mount-point drop ]
: Gi ( n -- gibibits ) 30 2^ * ; inline
: sufficient-disk-space? ( -- ? )
- current-directory get find-mount-point
+ current-directory get find-mount-point mount-point>>
file-system-info available-space>> 1 Gi > ;
: check-disk-space ( -- )
: Gi-str ( n -- string ) 1 Gi /f ;
: path>disk-usage ( path -- string )
- find-mount-point file-system-info
+ find-mount-point mount-point>> file-system-info
[ used-space>> ] [ available-space>> ] [ total-space>> ] tri
2dup /f 100 *
[ [ Gi-str ] tri@ ] dip