From ce1eb42ab2db13235e2de71d10529daacdf9df87 Mon Sep 17 00:00:00 2001 From: divoplade 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 * 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 | 38 ++++++++++++++------- module/ice-9/ports.scm | 75 ++++++++++++++++++++++-------------------- 3 files changed, 71 insertions(+), 48 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..0c6beec20 100644 --- a/doc/ref/api-io.texi +++ b/doc/ref/api-io.texi @@ -1036,13 +1036,16 @@ 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 +character encoding as described above for @code{open-file}. If +@var{mkdir} is true, recursively create the directory of @var{filename} +if it does not exist first. Equivalent to @lisp +(when @var{mkdir} + (mkdir-recursive (dirname @var{filename}))) (open-file @var{filename} (if @var{binary} "wb" "w") #:encoding @var{encoding}) @@ -1052,12 +1055,14 @@ 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} -port)} with the resulting port. Return the value returned by -@var{proc}. @var{filename} is opened as per @code{open-input-file} or +port)} with the resulting port. For @var{call-with-output-file}, if +@var{mkdir} is true, create the directory of @var{filename} recursively +if it does not exist first. Return the value returned by @var{proc}. +@var{filename} is opened as per @code{open-input-file} or @code{open-output-file} respectively, and an error is signaled if it cannot be opened. @@ -1065,22 +1070,28 @@ 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 setup as respectively the @code{current-input-port}, -@code{current-output-port}, or @code{current-error-port}. Return the -value returned by @var{thunk}. @var{filename} is opened as per -@code{open-input-file} or @code{open-output-file} respectively, and an -error is signaled if it cannot be opened. +@code{current-output-port}, or @code{current-error-port}. For +@var{with-output-to-file} and @var{with-error-to-file}, if @var{mkdir} +is true, recursively create the directory of @var{filename} if it does +not exist first. Return the value returned by @var{thunk}. +@var{filename} is opened as per @code{open-input-file} or +@code{open-output-file} respectively, and an error is signaled if it +cannot be opened. When @var{thunk} returns, the port is closed and the previous setting of the respective current port is restored. @@ -1095,6 +1106,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 ed074238b..0ea048e23 100644 --- a/module/ice-9/ports.scm +++ b/module/ice-9/ports.scm @@ -429,11 +429,14 @@ directory, or up to the root." (lambda error #t)))))) -(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)) @@ -463,18 +466,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 @@ -510,35 +513,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.29.1