]> gitweb.factorcode.org Git - factor.git/commitdiff
io.files: adding if-file-exists, when-file-exists, unless-file-exists
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 31 Aug 2023 00:55:48 +0000 (17:55 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 31 Aug 2023 00:55:48 +0000 (17:55 -0700)
core/io/files/files-docs.factor
core/io/files/files.factor

index afbba2ad3227f353ff7fd0416e6499dab0096601..e3b54ada9e0f6aead4317f5302d98e547065099a 100644 (file)
@@ -114,3 +114,17 @@ HELP: file-contents
 HELP: file-exists?
 { $values { "path" "a pathname string" } { "?" boolean } }
 { $description "Tests if the file named by " { $snippet "path" } " exists." } ;
+
+HELP: if-file-exists
+{ $values { "path" "a pathname string" } { "true" { $quotation ( ..a path -- ..b ) } } { "false" { $quotation ( ..a path -- ..b ) } } }
+{ $description "If " { $snippet "path" } " is a file that exists, calls the " { $snippet "true" } " quotation, otherwise calls the " { $snippet "false" } " quotation." } ;
+
+HELP: when-file-exists
+{ $values { "path" "a pathname string" } { "quot" { $quotation ( ... path -- ... ) } } }
+{ $description "If " { $snippet "path" } " is a file that exists, calls the " { $snippet "quot" } " quotation." } ;
+
+HELP: unless-file-exists
+{ $values { "path" "a pathname string" } { "quot" { $quotation ( ... path -- ... ) } } }
+{ $description "If " { $snippet "path" } " is a file that does not exist, calls the " { $snippet "quot" } " quotation." } ;
+
+{ if-file-exists when-file-exists unless-file-exists } related-words
index 893e8871b9b1675c7e951fcab3825cdeeb8cfe59..bb612e6d1b4910f8c40922aa626bee6e566814fa 100644 (file)
@@ -71,6 +71,15 @@ HOOK: (file-appender) io-backend ( path -- stream )
 : file-exists? ( path -- ? )
     normalize-path native-string>alien (file-exists?) ;
 
+: if-file-exists ( ..a path true: ( ..a path -- ..b ) false: ( ..a path -- ..b ) -- ..b )
+    [ dup file-exists? ] 2dip if ; inline
+
+: when-file-exists ( ... path quot: ( ... path -- ... ) -- ... )
+    [ drop ] if-file-exists ; inline
+
+: unless-file-exists ( ... path quot: ( ... path -- ... ) -- ... )
+    [ drop ] swap if-file-exists ; inline
+
 ! Current directory
 <PRIVATE