diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index 95da980649..57546b6ca9 100644 --- a/basis/io/files/info/info.factor +++ b/basis/io/files/info/info.factor @@ -39,17 +39,16 @@ HOOK: mount-points os ( -- assoc ) 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" ] } diff --git a/basis/io/files/info/unix/linux/linux.factor b/basis/io/files/info/unix/linux/linux.factor index e179354685..52948eccc7 100644 --- a/basis/io/files/info/unix/linux/linux.factor +++ b/basis/io/files/info/unix/linux/linux.factor @@ -68,9 +68,15 @@ frequency pass-number ; 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 ] @@ -85,14 +91,8 @@ M: linux file-systems 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 ] diff --git a/extra/mason/disk/disk.factor b/extra/mason/disk/disk.factor index 97e48ff88d..a80556cd16 100644 --- a/extra/mason/disk/disk.factor +++ b/extra/mason/disk/disk.factor @@ -7,7 +7,7 @@ IN: mason.disk : 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 ( -- ) @@ -18,7 +18,7 @@ IN: mason.disk : 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