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

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" } }

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
 
+    { t } [
+        "one/two/three" make-parent-directories parent-directory exists?
+    ] unit-test
+
 ] with-test-directory
-
-

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
+    make-parent-directories binary <file-writer> [
-    binary <file-writer> [
         swap binary <file-reader> [
             swap stream-copy
         ] with-disposal

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 -- )

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>
 

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
+USING: accessors alien.c-types alien.data alien.strings byte-arrays
-byte-arrays classes.struct combinators constructors
+classes.struct combinators constructors continuations destructors
-continuations destructors forestdb.ffi forestdb.paths fry
+forestdb.ffi fry generalizations io.directories io.encodings.string
-generalizations io.encodings.string io.encodings.utf8
+io.encodings.utf8 io.pathnames kernel libc math multiline namespaces
-io.pathnames kernel libc math multiline namespaces sequences
+sequences strings ;
-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> ;
 

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 ]