io.directories: new utility word make-parent-directories, for making sure directories...

diff --git a/basis/io/directories/directories-docs.factor b/basis/io/directories/directories-docs.factor
index 901dda1d71a44b577aaf9a665bd3a3455f2f9a6e..bf47a77e89b362b13033c485bccd411065c963da 100644 (file)
--- a/basis/io/directories/directories-docs.factor
+++ b/basis/io/directories/directories-docs.factor
@@ -17,7 +17,12 @@ HELP: cd
 HELP: current-directory
 { $description "A variable holding the current directory as an absolute path. Words that use the filesystem do so in relation to this variable."
 $nl
-"This variable should never be set directly; instead, use " { $link set-current-directory } " or " { $link with-directory } ". This preserves the invariant that the value of this variable is an absolute path." } ;
+  "This variable should never be set directly; instead, use " { $link set-current-directory } " or " { $link with-directory } ". This preserves the invariant that the value of this variable is an absolute path." } ;
+
+HELP: make-parent-directories
+{ $values { "path" "a pathname string" } }
+{ $description "Creates all parent directories of the path which do not yet exist." }
+{ $errors "Throws an error if the directories could not be created." } ;
 
 HELP: set-current-directory
 { $values { "path" "a pathname string" } }

diff --git a/basis/io/directories/directories-tests.factor b/basis/io/directories/directories-tests.factor
index 6176629b58bfa7298735f4a5311d22083e06008e..99a6f6aa2aca53b3f81cec4037f283fb0d0ec255 100644 (file)
--- a/basis/io/directories/directories-tests.factor
+++ b/basis/io/directories/directories-tests.factor
@@ -158,6 +158,8 @@ io.launcher io.pathnames kernel sequences tools.test ;
         [ "touch bar" try-output-process ] with-directory
     ] unit-test
 
-] with-test-directory
-
+    { t } [
+        "one/two/three" make-parent-directories parent-directory exists?
+    ] unit-test
 
+] with-test-directory

diff --git a/basis/io/directories/directories.factor b/basis/io/directories/directories.factor
index eee03c78520e5e0491c406fc120a771df02918e4..55ef1e359bd1066ce5eb2c4113518147f5d0911c 100644 (file)
--- a/basis/io/directories/directories.factor
+++ b/basis/io/directories/directories.factor
@@ -17,6 +17,8 @@ IN: io.directories
 ! Creating directories
 HOOK: make-directory io-backend ( path -- )
 
+DEFER: make-parent-directories
+
 : make-directories ( path -- )
     normalize-path trim-tail-separators dup {
         [ "." = ]
@@ -24,10 +26,13 @@ HOOK: make-directory io-backend ( path -- )
         [ empty? ]
         [ exists? ]
     } 1|| [
-        dup parent-directory make-directories
+        make-parent-directories
         dup make-directory
     ] unless drop ;
 
+: make-parent-directories ( filename -- filename )
+    dup parent-directory make-directories ;
+
 ! Listing directories
 TUPLE: directory-entry name type ;
 
@@ -76,8 +81,7 @@ HOOK: move-file io-backend ( from to -- )
 HOOK: copy-file io-backend ( from to -- )
 
 M: object copy-file
-    dup parent-directory make-directories
-    binary <file-writer> [
+    make-parent-directories binary <file-writer> [
         swap binary <file-reader> [
             swap stream-copy
         ] with-disposal

diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor
index 750c3491952d518948e7a213ce5db98d45714cfa..50a30747e395ec4b6d22550dfa5ae44df0790eaa 100644 (file)
--- a/basis/io/directories/windows/windows.factor
+++ b/basis/io/directories/windows/windows.factor
@@ -37,7 +37,7 @@ M: windows delete-file ( path -- )
     [ \ file-delete-failed boa rethrow ] recover ;
 
 M: windows copy-file ( from to -- )
-    dup parent-directory make-directories
+    make-parent-directories
     [ normalize-path ] bi@ 0 CopyFile win32-error=0/f ;
 
 M: windows make-directory ( path -- )

diff --git a/basis/vocabs/metadata/resources/resources.factor b/basis/vocabs/metadata/resources/resources.factor
index 7db83144a7bec2bec4be9de348401e5fea195834..4872068e58f82bedad85773c9938bc4307e89a33 100644 (file)
--- a/basis/vocabs/metadata/resources/resources.factor
+++ b/basis/vocabs/metadata/resources/resources.factor
@@ -18,7 +18,7 @@ IN: vocabs.metadata.resources
     [ append-path ] curry bi@
     dup file-info directory?
     [ drop make-directories ]
-    [ swap [ parent-directory make-directories ] [ copy-file ] bi ] if ;
+    [ swap make-parent-directories copy-file ] if ;
 
 PRIVATE>
 

diff --git a/extra/forestdb/lib/lib.factor b/extra/forestdb/lib/lib.factor
index f443b025639951906bb956d839b5b657cfffb319..50e714417045fe22bae4f6818ccb5c892ac559b1 100644 (file)
--- a/extra/forestdb/lib/lib.factor
+++ b/extra/forestdb/lib/lib.factor
@@ -1,11 +1,10 @@
 ! Copyright (C) 2014 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.data alien.strings arrays
-byte-arrays classes.struct combinators constructors
-continuations destructors forestdb.ffi forestdb.paths fry
-generalizations io.encodings.string io.encodings.utf8
-io.pathnames kernel libc math multiline namespaces sequences
-strings ;
+USING: accessors alien.c-types alien.data alien.strings byte-arrays
+classes.struct combinators constructors continuations destructors
+forestdb.ffi fry generalizations io.directories io.encodings.string
+io.encodings.utf8 io.pathnames kernel libc math multiline namespaces
+sequences strings ;
 QUALIFIED: sets
 IN: forestdb.lib
 
@@ -310,7 +309,7 @@ PRIVATE>
 
 : fdb-open ( path config -- file-handle )
     [ f void* <ref> ] 2dip
-    [ absolute-path ensure-fdb-filename-directory ] dip
+    [ make-parent-directories ] dip
     [ fdb_open fdb-check-error ] 3keep
     2drop void* deref <fdb-file-handle> ;
 

diff --git a/extra/forestdb/paths/paths.factor b/extra/forestdb/paths/paths.factor
index d27af11e6a760505049472aad627430f5eb39202..9ba158673d1b8f4fa3ce65ab11603aededf91bc4 100644 (file)
--- a/extra/forestdb/paths/paths.factor
+++ b/extra/forestdb/paths/paths.factor
@@ -72,11 +72,5 @@ ERROR: not-a-string-number string ;
 : path-fdb-duplicates ( path -- seq )
     directory-files [ canonical-fdb-name ] map members ;
 
-: ensure-fdb-directory ( filename -- filename )
-    [ make-directories ] keep ;
-
-: ensure-fdb-filename-directory ( filename -- filename )
-    [ parent-directory make-directories ] keep ;
-
 ! : path>next-vnode-version-name ( path -- path' )
     ! [ file-name ]