So, after a bit of bikeshedding on #guile, it turns out that the
controversy moved to the second commit.
Here is the justification for it.
When a program user wants to save data to a file, if the place where to
save the file does not exist yet, there will be an error: "cannot
create file or directory". That's puzzling to the user, because, yes,
the user wants to create that file. If the error is a little more
precise, it will be something in the line of "Please create directory
blah/blah/blah before invoking this program".
So, the user will wonder why the program was not able to create
blah/blah/blah itself, create it, and re-run the program. This is more
work for the user, work that could have been easily handled by the
program.
Good behaving programs should (recursively) create the directory before
trying to write to a file specified by the user. That include log files
for a daemon, for instance. Emacs org-mode babel tangling uses a
:mkdirp t for a similar reason. In order to simplify the development of
such programs, and in order to avoid bugs where the developer forgot to
call (mkdir-recursive (dirname output-file)) before (open-output-file,
call-with-output-file or with-output-to-file, while still keeping
compatibility of the other programs, I propose to add a keyword
argument to these functions.
There are also worries that this keyword will not be of much use and
will clutter the implementation. I am willing to bet that this keyword
will be more used than, for instance, #:guess-encoding, which is
available in all the corresponding input functions.
I also simplified the mkdir-recursive function, to be closer to
https://gitlab.com/leoprikler/guile-filesystem/-/blob/master/ice-9/filesystem.scm
.
From d825e09dac796ed69d083feb6a033b68b66de499 Mon Sep 17 00:00:00 2001
From: divoplade <d...@divoplade.fr>
Date: Sat, 24 Oct 2020 00:35:01 +0200
Subject: [PATCH 2/2] Use the recursive mkdir function in file output
procedures
2020-10-25 divoplade <d...@divoplade.fr>
* module/ice-9/ports.scm (open-output-file): add a mkdir keyword
to try to recursively create the directory of the output file.
* module/ice-9/ports.scm (call-with-output-file): same.
* module/ice-9/ports.scm (with-output-to-file): same.
* module/ice-9/ports.scm (with-error-to-file): same.
* doc/ref/api-io.texi: document the new keyword argument for
opening output files.
* NEWS: indicate that the open output function can now create
the filename directory if it does not exist.
---
NEWS | 6 +++-
doc/ref/api-io.texi | 16 ++++++---
module/ice-9/ports.scm | 75 ++++++++++++++++++++++--------------------
3 files changed, 57 insertions(+), 40 deletions(-)
diff --git a/NEWS b/NEWS
index 94a3f3154..09e06a7ba 100644
--- a/NEWS
+++ b/NEWS
@@ -19,7 +19,11 @@ many similar clauses whose first differentiator are constants.
** New function mkdir-recursive
This function will try and create the directory and parent directories,
-up to a directory that can be opened or the root.
+up to a directory that can be opened or the root. This behavior is
+included in open-output-file, call-with-output-file, with-output-to-file
+and with-error-to-file by adding a keyword argument `#:mkdir' which,
+when set to `#t', creates the directories before trying to open the
+file.
* Incompatible changes
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index ecbd35585..dabceb646 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1036,13 +1036,15 @@ for @code{open-file}. Equivalent to
@rnindex open-output-file
@deffn {Scheme Procedure} open-output-file filename @
- [#:encoding=#f] [#:binary=#f]
+ [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
Open @var{filename} for output. If @var{binary} is true, open the port
in binary mode, otherwise use text mode. @var{encoding} specifies the
character encoding as described above for @code{open-file}. Equivalent
to
@lisp
+(when @var{mkdir}
+ (mkdir-recursive (dirname @var{filename})))
(open-file @var{filename}
(if @var{binary} "wb" "w")
#:encoding @var{encoding})
@@ -1052,7 +1054,7 @@ to
@deffn {Scheme Procedure} call-with-input-file filename proc @
[#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f]
@deffnx {Scheme Procedure} call-with-output-file filename proc @
- [#:encoding=#f] [#:binary=#f]
+ [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
@rnindex call-with-input-file
@rnindex call-with-output-file
Open @var{filename} for input or output, and call @code{(@var{proc}
@@ -1065,14 +1067,17 @@ When @var{proc} returns, the port is closed. If @var{proc} does not
return (e.g.@: if it throws an error), then the port might not be
closed automatically, though it will be garbage collected in the usual
way if not otherwise referenced.
+
+If @var{mkdir} is true, create @var{filename}'s directory and all
+its parents.
@end deffn
@deffn {Scheme Procedure} with-input-from-file filename thunk @
[#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f]
@deffnx {Scheme Procedure} with-output-to-file filename thunk @
- [#:encoding=#f] [#:binary=#f]
+ [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
@deffnx {Scheme Procedure} with-error-to-file filename thunk @
- [#:encoding=#f] [#:binary=#f]
+ [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
@rnindex with-input-from-file
@rnindex with-output-to-file
Open @var{filename} and call @code{(@var{thunk})} with the new port
@@ -1095,6 +1100,9 @@ exited via an exception or new continuation. This ensures it's still
ready for use if @var{thunk} is re-entered by a captured continuation.
Of course the port is always garbage collected and closed in the usual
way when no longer referenced anywhere.
+
+If @var{mkdir} is true, then @var{filename}'s directory and all its
+parents are created.
@end deffn
@deffn {Scheme Procedure} port-mode port
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index d85e48107..78a31619e 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -425,11 +425,14 @@ directory, or up to the root."
#t
(mkdir-recursive (dirname name))))))
-(define* (open-output-file file #:key (binary #f) (encoding #f))
+(define* (open-output-file file #:key (binary #f) (encoding #f) (mkdir #f))
"Takes a string naming an output file to be created and returns an
-output port capable of writing characters to a new file by that
-name. If the file cannot be opened, an error is signalled. If a
-file with the given name already exists, the effect is unspecified."
+output port capable of writing characters to a new file by that name.
+If the file cannot be opened, an error is signalled. If a file with the
+given name already exists, the effect is unspecified. If @var{mkdir} is
+true, recursively create the directory of @var{file}."
+ (when mkdir
+ (mkdir-p (dirname file)))
(open-file file (if binary "wb" "w")
#:encoding encoding))
@@ -459,18 +462,18 @@ never again be used for a read or write operation."
(close-input-port p)
(apply values vals)))))
-(define* (call-with-output-file file proc #:key (binary #f) (encoding #f))
+(define* (call-with-output-file file proc #:key (binary #f) (encoding #f) (mkdir #f))
"PROC should be a procedure of one argument, and FILE should be a
-string naming a file. The behaviour is unspecified if the file
-already exists. These procedures call PROC
-with one argument: the port obtained by opening the named file for
-input or output. If the file cannot be opened, an error is
-signalled. If the procedure returns, then the port is closed
-automatically and the values yielded by the procedure are returned.
-If the procedure does not return, then the port will not be closed
-automatically unless it is possible to prove that the port will
-never again be used for a read or write operation."
- (let ((p (open-output-file file #:binary binary #:encoding encoding)))
+string naming a file. The behaviour is unspecified if the file already
+exists. These procedures call PROC with one argument: the port obtained
+by opening the named file for input or output. If the file cannot be
+opened, an error is signalled. If the procedure returns, then the port
+is closed automatically and the values yielded by the procedure are
+returned. If the procedure does not return, then the port will not be
+closed automatically unless it is possible to prove that the port will
+never again be used for a read or write operation. When MKDIR is true,
+create FILE's directory and all its parents."
+ (let ((p (open-output-file file #:binary binary #:encoding encoding #:mkdir mkdir)))
(call-with-values
(lambda () (proc p))
(lambda vals
@@ -506,35 +509,37 @@ procedures, their behavior is implementation dependent."
#:encoding encoding
#:guess-encoding guess-encoding))
-(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f))
- "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file. The effect is unspecified if the file already exists.
+(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f) (mkdir #f))
+ "THUNK must be a procedure of no arguments, and FILE must be a string
+naming a file. The effect is unspecified if the file already exists.
The file is opened for output, an output port connected to it is made
-the default value returned by `current-output-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored. Returns the values yielded by THUNK. If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
+the default value returned by `current-output-port', and the THUNK is
+called with no arguments. When the THUNK returns, the port is closed
+and the previous default is restored. Returns the values yielded by
+THUNK. If an escape procedure is used to escape from the continuation
+of these procedures, their behavior is implementation dependent. When
+MKDIR is true, the directory of FILE and all its parents are created."
(call-with-output-file file
(lambda (p) (with-output-to-port p thunk))
#:binary binary
- #:encoding encoding))
+ #:encoding encoding
+ #:mkdir mkdir))
-(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f))
- "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file. The effect is unspecified if the file already exists.
+(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f) (mkdir #f))
+ "THUNK must be a procedure of no arguments, and FILE must be a string
+naming a file. The effect is unspecified if the file already exists.
The file is opened for output, an output port connected to it is made
-the default value returned by `current-error-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored. Returns the values yielded by THUNK. If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
+the default value returned by `current-error-port', and the THUNK is
+called with no arguments. When the THUNK returns, the port is closed
+and the previous default is restored. Returns the values yielded by
+THUNK. If an escape procedure is used to escape from the continuation
+of these procedures, their behavior is implementation dependent. When
+MKDIR is true, the directory of FILE and all its parents are created."
(call-with-output-file file
(lambda (p) (with-error-to-port p thunk))
#:binary binary
- #:encoding encoding))
+ #:encoding encoding
+ #:mkdir mkdir))
(define (call-with-input-string string proc)
"Calls the one-argument procedure @var{proc} with a newly created
--
2.28.0
From 1a0bf46864ccbac742c5d97205d68b43d0448719 Mon Sep 17 00:00:00 2001
From: divoplade <d...@divoplade.fr>
Date: Fri, 23 Oct 2020 22:44:36 +0200
Subject: [PATCH 1/2] ports: Add mkdir-recursive
2020-10-25 divoplade <d...@divoplade.fr>
* module/ice-9/ports.scm: add a function, mkdir-recursive, to
create the chain of directories.
* doc/ref/posix.texi: document the new function mkdir-recursive.
* NEWS: mention the new function.
* test-suite/tests/ports.test: add a test suite to check
recursive mkdir.
---
NEWS | 5 +++++
doc/ref/posix.texi | 15 ++++++++++----
module/ice-9/ports.scm | 12 +++++++++++
test-suite/tests/ports.test | 40 +++++++++++++++++++++++++++++++++++++
4 files changed, 68 insertions(+), 4 deletions(-)
diff --git a/NEWS b/NEWS
index 694449202..94a3f3154 100644
--- a/NEWS
+++ b/NEWS
@@ -16,6 +16,11 @@ O(1) dispatch time, regardless of the length of the chain. This
optimization is also unlocked in many cases for `match' expressions with
many similar clauses whose first differentiator are constants.
+** New function mkdir-recursive
+
+This function will try and create the directory and parent directories,
+up to a directory that can be opened or the root.
+
* Incompatible changes
** `copy' read-option removed
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index f34c5222d..cb9943977 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -881,10 +881,17 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to)
@deffn {Scheme Procedure} mkdir path [mode]
@deffnx {C Function} scm_mkdir (path, mode)
Create a new directory named by @var{path}. If @var{mode} is omitted
-then the permissions of the directory are set to @code{#o777}
-masked with the current umask (@pxref{Processes, @code{umask}}).
-Otherwise they are set to the value specified with @var{mode}.
-The return value is unspecified.
+then the permissions of the directory are set to @code{#o777} masked
+with the current umask (@pxref{Processes, @code{umask}}). Otherwise
+they are set to the value specified with @var{mode}. The return value
+is unspecified.
+@end deffn
+
+@deffn {Scheme Procedure} mkdir-recursive @var{path} [mode]
+Create the directory named @var{path}, with the optional given
+@var{mode}, as for @code{mkdir}. Create all parent directories up to a
+directory that can be opened, or the root. The chain of directories is
+not cleaned in case of an error.
@end deffn
@deffn {Scheme Procedure} rmdir path
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index dbc7ef7a7..d85e48107 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -105,6 +105,7 @@
OPEN_READ OPEN_WRITE OPEN_BOTH
*null-device*
open-input-file
+ mkdir-recursive
open-output-file
open-io-file
call-with-input-file
@@ -413,6 +414,17 @@ cannot be opened, an error is signalled."
#:encoding encoding
#:guess-encoding guess-encoding))
+(define (mkdir-recursive name)
+ "Create the parent directories of @var{name}, up to an existing
+directory, or up to the root."
+ (catch 'system-error
+ (lambda ()
+ (mkdir name))
+ (lambda error
+ (if (= EEXIST (system-error-errno error))
+ #t
+ (mkdir-recursive (dirname name))))))
+
(define* (open-output-file file #:key (binary #f) (encoding #f))
"Takes a string naming an output file to be created and returns an
output port capable of writing characters to a new file by that
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 31fb2b0a8..ab696195b 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2022,6 +2022,46 @@
(delete-file (test-file))
+(with-test-prefix "recursive mkdir"
+
+ (pass-if "Relative recursive mkdir creates the chain of directories"
+ (let ((dir "./nested/relative/subdirectory"))
+ (mkdir-recursive dir)
+ (let ((ok
+ (catch #t
+ (lambda ()
+ (with-output-to-file "./nested/relative/subdirectory/file"
+ (lambda ()
+ (display "The directories have been created!")
+ #t)))
+ (lambda (error . args)
+ #f))))
+ (when ok
+ (delete-file "./nested/relative/subdirectory/file")
+ (rmdir "./nested/relative/subdirectory")
+ (rmdir "./nested/relative")
+ (rmdir "./nested"))
+ ok)))
+
+ (pass-if "Absolute recursive mkdir creates the chain of directories"
+ (let ((dir (string-append %temporary-directory "/nested/absolute/subdirectory")))
+ (mkdir-recursive dir)
+ (let ((ok
+ (catch #t
+ (lambda ()
+ (with-output-to-file (string-append dir "/file")
+ (lambda ()
+ (display "The directories have been created!")
+ #t)))
+ (lambda (error . args)
+ #f))))
+ (when ok
+ (delete-file (string-append dir "/file"))
+ (rmdir (string-append %temporary-directory "/nested/absolute/subdirectory"))
+ (rmdir (string-append %temporary-directory "/nested/absolute"))
+ (rmdir (string-append %temporary-directory "/nested")))
+ ok))))
+
;;; Local Variables:
;;; eval: (put 'test-decoding-error 'scheme-indent-function 3)
;;; eval: (put 'with-load-path 'scheme-indent-function 1)
--
2.28.0
