diff --git a/basis/io/directories/directories-docs.factor b/basis/io/directories/directories-docs.factor index 901dda1d71..bf47a77e89 100644 --- 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 6176629b58..99a6f6aa2a 100644 --- 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 + { 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 eee03c7852..55ef1e359b 100644 --- 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 [ + make-parent-directories binary [ swap binary [ swap stream-copy ] with-disposal diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor index 750c349195..50a30747e3 100644 --- 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 7db83144a7..4872068e58 100644 --- 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 f443b02563..50e7144170 100644 --- 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* ] 2dip - [ absolute-path ensure-fdb-filename-directory ] dip + [ make-parent-directories ] dip [ fdb_open fdb-check-error ] 3keep 2drop void* deref ; diff --git a/extra/forestdb/paths/paths.factor b/extra/forestdb/paths/paths.factor index d27af11e6a..9ba158673d 100644 --- 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 ]