io.files.info: allow paths to be passed to directory?.

factor · Mar 5, 2021 · 3643123 · 3643123
1 parent db2e702
commit 3643123
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 9 deletions.
diff --git a/basis/io/files/info/info-docs.factor b/basis/io/files/info/info-docs.factor
@@ -14,15 +14,15 @@ HELP: link-info
 { file-info link-info file-info-tuple } related-words
 
 HELP: directory?
-{ $values { "file-info" file-info-tuple } { "?" boolean } }
+{ $values { "path/info" { $or "a pathname string" file-info-tuple } } { "?" boolean } }
 { $description "Tests if " { $snippet "file-info" } " is a directory." } ;
 
 HELP: regular-file?
-{ $values { "file-info" file-info-tuple } { "?" boolean } }
+{ $values { "path/info" { $or "a pathname string" file-info-tuple } } { "?" boolean } }
 { $description "Tests if " { $snippet "file-info" } " is a normal file." } ;
 
 HELP: symbolic-link?
-{ $values { "file-info" file-info-tuple } { "?" boolean } }
+{ $values { "path/info" { $or "a pathname string" file-info-tuple } } { "?" boolean } }
 { $description "Tests if " { $snippet "file-info" } " is a symbolic link." } ;
 
 HELP: file-systems

diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor
@@ -11,16 +11,31 @@ accessed ;
 HOOK: file-info os ( path -- info )
 
 : ?file-info ( path -- info/f )
-    dup exists? [ file-info ] [ drop f ] if ; inline
+    dup exists? [ file-info ] [ drop f ] if ;
 
 HOOK: link-info os ( path -- info )
 
-: directory? ( file-info -- ? ) type>> +directory+ = ;
-: regular-file? ( file-info -- ? ) type>> +regular-file+ = ;
-: symbolic-link? ( file-info -- ? ) type>> +symbolic-link+ = ;
+: ?link-info ( path -- info/f )
+    dup exists? [ link-info ] [ drop f ] if ;
 
-: sparse-file? ( file-info -- ? )
-    [ size-on-disk>> ] [ size>> ] bi < ;
+<PRIVATE
+
+: >file-info ( path/info -- info )
+    dup file-info-tuple? [ file-info ] unless ; inline
+
+PRIVATE>
+
+: directory? ( path/info -- ? )
+    >file-info type>> +directory+ = ;
+
+: regular-file? ( path/info -- ? )
+    >file-info type>> +regular-file+ = ;
+
+: symbolic-link? ( path/info -- ? )
+    >file-info type>> +symbolic-link+ = ;
+
+: sparse-file? ( path/info -- ? )
+    >file-info [ size-on-disk>> ] [ size>> ] bi < ;
 
 ! File systems
 HOOK: file-systems os ( -- array )