/**
* Portable file operations.
*/
module system/io/file
imports
system/io/-
collection/list/-
term/string
/**
* Stream and file representations
*/
signature
constructors
Stream : ImplDep -> Stream
Path : String -> FileLoc
stdin : FileLoc
stdout : FileLoc
stderr : FileLoc
/**
* Abstractions for streams
*/
strategies
/**
* Opens a Stream associated to a FileLoc
*
* @type (FileLoc, String) -> Stream
*/
open-stream = ?(_, _);
( Fst; stdio-stream
<+ (?Path(<id>), id); fopen
<+ (is-string, id); fopen
)
/**
* @type FileLoc -> Stream
*/
stdio-stream = ?stdin() ; stdin-stream
stdio-stream = ?stdout(); stdout-stream
stdio-stream = ?stderr(); stderr-stream
/**
* Returns the Stream for stdin, stdout and stderr
*
* @type _ -> Stream
*/
stdin-stream = prim("SSL_stdin_stream") ; !Stream(<id>)
stdout-stream = prim("SSL_stdout_stream"); !Stream(<id>)
stderr-stream = prim("SSL_stderr_stream"); !Stream(<id>)
/**
* Stream operations
*/
strategies
/**
* Opens the file whose name is the string pointed to by
* pathname and returns a Stream associated with this file.
* For documentation on the mode string, see the man page of
* fopen.
*
* fails if the file couldn't be opened.
*
* @type String * String -> Stream
*/
fopen =
?(pathname, mode); prim("SSL_fopen", pathname, mode); !Stream(<id>)
/**
* Dissociates the named stream from its underlying file or set of functions.
* If the stream was being used for output, any buffered data is written
* first, using fflush(3).
*
* @type Stream -> ()
*/
fclose =
?Stream(stream); prim("SSL_fclose", stream)
<+ ?stream-old; prim("SSL_fclose", stream-old) // legacy
/**
* Forces a write of all user-space buffered data for the given Stream
*
* @type Stream -> Stream
*/
fflush =
?Stream(stream); prim("SSL_fflush", stream); !Stream(<id>)
<+ ?stream-old; prim("SSL_fflush", stream-old); !Stream(<id>) // legacy
/**
* Character output to stream
*/
strategies
/**
* Writes a String to a Stream
* @type (String, Stream) -> Stream
*/
fputs =
?(str, Stream(stream)); prim("SSL_fputs", str, stream); !Stream(<id>)
/**
* Writes a String to stdout with a trailing newline and returns stdout.
*
* @type String -> Stream
*/
puts =
?str; prim("SSL_puts", str); !Stream(<id>)
/**
* Writes a Char to a Stream
*
* @type (Char, Stream) -> Stream
*/
fputc =
?(c, Stream(stream)); prim("SSL_fputc", c, stream); !Stream(<id>)
/**
* Character input from stream
*/
strategies
/**
* fgetc() reads the next character from the stream and returns the
* ASCII code of the character as an Int. Fails on end of file or error.
*
* @type Stream -> Char
*/
fgetc =
?Stream(stream); prim("SSL_fgetc", stream)
/**
* tmpnam
*/
strategies
tmpnam =
prim("SSL_tmpnam")
/**
* Components of a pathname
*/
strategies
/**
* Returns directory portion of pathname in a POSIX compatible way.
*
* @inc dirname
* @type String -> String
*/
dirname =
string-as-chars(
/* (1) Strip trailing slashes */
try(split-init-last; ?(<id>, '/'))
; /* (2) If string consists entirely of slash characters, string shall be
set to a single slash character. In this case, skip steps (3)
through (8). */
( ?[]
< !['/']
+ ( /* (3) If there are any trailing slash characters in string, they
shall be removed. */
init
/* (4) If there are no slash characters remaining in string, string
shall be set to a single period character. In this case, skip
steps (5) through (8).
(5) If there are any trailing nonslash characters in string,
they shall be removed. */
; repeat(split-init-last; (id, not(?'/')); Fst)
; (?[]
< !['.']
+ ( /* (7) If there are any trailing slash characters in string, they
shall be removed. */
repeat(split-init-last; ?(<id>, '/'))
; (?[] < !['/'] + id))))))
/**
* Succeeds if the input pathname is an absolute path.
*
* A pathname is absolute if it starts with a /.
*
* @type String -> String
* @since 0.9.4
* @inc is-abs-path
*/
is-abspath =
where(explode-string; ?['/' | _])
/**
* Succeeds if the input pathname is a relative path.
*
* A pathname is relative if it does not start with a /.
*
* @type String -> String
* @since 0.9.4
*/
is-relpath =
not(is-abspath)
/**
* Strips the directory from a pathname.
*
* @type String -> String
* @inc base-filename-test
*/
base-filename =
<string-tokenize> (['/'], <id>)
; last
/**
* Strategies for file extensions
*/
strategies
/**
* Drops the current extension and replaces it with the specified extension.
*
* @type String -> String
* @since 0.15
* @inc guarantee-extension
*/
guarantee-extension(|ext) =
remove-extension
; <add-extension> (<id>, ext)
/**
* Checks if the file extension is ext.
*
* @param The required extension (without . )
* @type String -> String
* @since 0.15
* @inc has-extension
*/
has-extension(|ext) =
test-extension(?ext)
/**
* Tests if the file extension (everything after the . satisfies ext.
*
* @param Test for the file extension. Is applied to the plain file extension (without the .)
* @since 0.15
* @inc test-extension
*/
test-extension(ext) =
where(
get-extension
; ext
)
/**
* Adds an extension (second argument) to a path (first argument).
*
* @type (String, String) -> String
*/
add-extension :
(name, ext) -> <concat-strings> [name, ".", ext]
/**
* Remove an extension from a file name.
* Returns the input if the file does not have an extension.
*
* @inc remove-extension
* @type String -> String
*/
remove-extension =
if get-extension; explode-string; !['.' | <id>] => ext then
explode-string
; at-suffix(?ext; ![])
; implode-string
end
/**
* Get extension from filename
*
* @type String -> String
*/
get-extension =
explode-string
; list-tokenize(|['.'])
/**
* There should be at least two elements in the result, otherwise
* there is not extension.
*/
; ?[_, _ | _]
/**
* The match of ?[base, ext] cannot be placed in at-suffix due to
* the lack of unbinding of variables on backtracking.
*/
; at-suffix(?[_, _]; ?lastwo)
; !lastwo => [base, ext]
; where(
/**
* The n-th . part should not contain / \ :
* in that case it is not a real extension
*/
<not(fetch(?'/' + ?'\'))> ext
/**
* The (n-1)th part should not end with a / or \
* in that case, part n is not a real extension.
*/
; <last; not(?'/' + '\')> base
)
; <implode-string> ext