file_system¶
In [ ]:
open sm'_operators
open rust
open rust_operators
In [ ]:
//// test
open testing
fsharp¶
file_mode¶
In [ ]:
nominal file_mode' = $'System.IO.FileMode'
union file_mode =
| ModeCreateNew
| ModeCreate
| ModeOpen
| ModeOpenOrCreate
| Truncate
| Append
inl file_mode = function
| ModeCreateNew => $'System.IO.FileMode.CreateNew' : file_mode'
| ModeCreate => $'System.IO.FileMode.Create' : file_mode'
| ModeOpen => $'System.IO.FileMode.Open' : file_mode'
| ModeOpenOrCreate => $'System.IO.FileMode.OpenOrCreate' : file_mode'
| Truncate => $'System.IO.FileMode.Truncate' : file_mode'
| Append => $'System.IO.FileMode.Append' : file_mode'
file_access¶
In [ ]:
nominal file_access' = $'System.IO.FileAccess'
union file_access =
| AccessRead
| AccessWrite
| AccessReadWrite
inl file_access = function
| AccessRead => $'System.IO.FileAccess.Read' : file_access'
| AccessWrite => $'System.IO.FileAccess.ReadWrite' : file_access'
| AccessReadWrite => $'System.IO.FileAccess.ReadWrite' : file_access'
file_share¶
In [ ]:
nominal file_share' = $'System.IO.FileShare'
union file_share =
| ShareNone
| ShareRead
| ShareWrite
| ShareReadWrite
| ShareDelete
inl file_share = function
| ShareNone => $'System.IO.FileShare.None' : file_share'
| ShareRead => $'System.IO.FileShare.Read' : file_share'
| ShareWrite => $'System.IO.FileShare.Write' : file_share'
| ShareReadWrite => $'System.IO.FileShare.ReadWrite' : file_share'
| ShareDelete => $'System.IO.FileShare.Delete' : file_share'
file_stream¶
In [ ]:
nominal file_stream' = $'System.IO.FileStream'
inl file_stream (path : string) mode access share : file_stream' =
run_target function
| Fsharp (Native) => fun () =>
inl mode = mode |> file_mode
inl access = access |> file_access
inl share = share |> file_share
$'new System.IO.FileStream (!path, !mode, !access, !share)'
| _ => fun () => null ()
file_info¶
In [ ]:
nominal file_info =
`(
global "#if FABLE_COMPILER\ntype file_info = unit\n#else\ntype file_info = System.IO.FileInfo\n#endif\n"
$'' : $'file_info'
)
inl file_info (path : string) : file_info =
run_target function
| Fsharp (Native) => fun () =>
path |> $'`file_info '
| _ => fun () => null ()
directory_info¶
In [ ]:
nominal directory_info = $'System.IO.DirectoryInfo'
inl directory_info (path : string) : directory_info =
path |> $'`directory_info '
directory_info_exists¶
In [ ]:
inl directory_info_exists (info : directory_info) : bool =
run_target function
| Fsharp (Native) => fun () =>
$'!info.Exists'
| _ => fun () => null ()
directory_info_creation_time¶
In [ ]:
inl directory_info_creation_time (info : directory_info) : date_time.date_time =
run_target function
| Fsharp (Native) => fun () =>
$'!info.CreationTime'
| _ => fun () => null ()
directory_info_name¶
In [ ]:
inl directory_info_name (info : directory_info) : string =
run_target function
| Fsharp (Native) => fun () =>
$'!info.Name'
| _ => fun () => null ()
directory_info_full_name¶
In [ ]:
inl directory_info_full_name (info : directory_info) : string =
run_target function
| Fsharp (Native) => fun () =>
$'!info.FullName'
| _ => fun () => null ()
file_attributes¶
In [ ]:
nominal file_attributes = $'System.IO.FileAttributes'
directory_info_attributes¶
In [ ]:
inl directory_info_attributes (info : directory_info) : file_attributes =
run_target function
| Fsharp (Native) => fun () =>
$'!info.Attributes'
| _ => fun () => null ()
file_attributes_reparse_point¶
In [ ]:
inl file_attributes_reparse_point () : file_attributes =
run_target function
| Fsharp (Native) => fun () =>
$'`file_attributes.ReparsePoint'
| _ => fun () => null ()
file_attributes_has_flag¶
In [ ]:
inl file_attributes_has_flag (flag : file_attributes) (file_attributes : file_attributes) : bool =
run_target function
| Fsharp (Native) => fun () =>
$'!file_attributes.HasFlag !flag '
| _ => fun () => null ()
create_directory¶
In [ ]:
inl create_directory (path : string) : directory_info =
run_target function
| Fsharp (Native) => fun () =>
path |> $'System.IO.Directory.CreateDirectory'
| _ => fun () => null ()
directory_get_files¶
In [ ]:
inl directory_get_files (path : string) : array_base string =
run_target function
| Fsharp (Native) => fun () =>
path |> $'System.IO.Directory.GetFiles'
| _ => fun () => null ()
file_move¶
In [ ]:
inl file_move (new_path : string) (old_path : string) : () =
run_target function
| Fsharp (Native) => fun () =>
$'System.IO.File.Move (!old_path, !new_path)'
| _ => fun () => ()
read_all_text_async¶
In [ ]:
inl read_all_text_async (path : string) : _ string =
run_target function
| Fsharp (Native) => fun () =>
path |> $'System.IO.File.ReadAllTextAsync' |> async.await_task
| _ => fun () => null ()
write_all_text_async¶
In [ ]:
inl write_all_text_async (path : string) (text : string) : _ () =
run_target function
| Fsharp (Native) => fun () =>
$'System.IO.File.WriteAllTextAsync (!path, !text)' |> async.await_task
| _ => fun () => null ()
file_system_info¶
In [ ]:
nominal file_system_info = $'System.IO.FileSystemInfo'
get_source_directory¶
In [ ]:
inl get_source_directory () =
$'__SOURCE_DIRECTORY__' : string
In [ ]:
//// test
get_source_directory ()
|> directory_info
|> directory_info_name
|> _assert_eq "spiral"
__assert_eq / actual: "spiral" / expected: "spiral"
rust¶
display¶
In [ ]:
nominal display =
`(
global "#if FABLE_COMPILER\n[<Fable.Core.Erase; Fable.Core.Emit(\"std::path::Display\")>]\ntype std_path_Display = class end\n#else\ntype std_path_Display = string\n#endif\n"
$'' : $'std_path_Display'
)
path¶
In [ ]:
nominal path =
`(
global "#if FABLE_COMPILER\n[<Fable.Core.Erase; Fable.Core.Emit(\"std::path::Path\")>]\n#endif\ntype std_path_Path = class end"
$'' : $'std_path_Path'
)
path_buf¶
In [ ]:
nominal path_buf =
`(
global "#if FABLE_COMPILER\n[<Fable.Core.Erase; Fable.Core.Emit(\"std::path::PathBuf\")>]\ntype std_path_PathBuf = class end\n#else\ntype std_path_PathBuf = string\n#endif\n"
$'' : $'std_path_PathBuf'
)
new_path_buf¶
In [ ]:
inl new_path_buf (path : sm'.std_string) : path_buf =
run_target function
| Rust _ => fun () => !\\(path, $'"std::path::PathBuf::from($0)"')
| _ => fun () => path |> convert
path_buf_from¶
In [ ]:
inl path_buf_from (path : rust.box path) : path_buf =
!\\(path, $'"std::path::PathBuf::from($0)"')
path_buf_join¶
In [ ]:
inl path_buf_join (s : string) (path_buf : path_buf) : path_buf =
!\\((path_buf, s |> sm'.to_std_string), $'"$0.join($1)"')
path_buf_strip_prefix¶
In [ ]:
inl path_buf_strip_prefix (s : string) (path_buf : path_buf) : path_buf =
!\\((path_buf, s |> sm'.to_std_string), $'"$0.strip_prefix($1).unwrap().to_path_buf()"')
path_display¶
In [ ]:
inl path_display (path : rust.ref path) : display =
!\\(path, $'"$0.display()"')
path_buf_display¶
In [ ]:
inl path_buf_display (path_buf : path_buf) : display =
run_target_args (fun () => path_buf) function
| Rust _ => fun path_buf => !\\(path_buf, $'"$0.display()"')
| _ => fun path_buf => path_buf |> unbox
path_buf_file_name¶
In [ ]:
inl path_buf_file_name (path : path_buf) : optionm'.option' (rust.ref sm'.os_str) =
!\\(path, $'"$0.file_name()"')
path_buf_exists¶
In [ ]:
inl path_buf_exists (path_buf : path_buf) : bool =
!\\(path_buf, $'"$0.exists()"')
path_buf_is_dir¶
In [ ]:
inl path_buf_is_dir (path_buf : path_buf) : bool =
!\\(path_buf, $'"$0.is_dir()"')
path_buf_is_file¶
In [ ]:
inl path_buf_is_file (path_buf : path_buf) : bool =
!\\(path_buf, $'"$0.is_file()"')
path_buf_is_symlink¶
In [ ]:
inl path_buf_is_symlink (path_buf : path_buf) : bool =
!\\(path_buf, $'"$0.is_symlink()"')
path_buf_parent¶
In [ ]:
inl path_buf_parent (path_buf : path_buf) : optionm'.option' path_buf =
!\\(path_buf, $'"$0.parent().map(std::path::PathBuf::from)"')
dir_entry¶
In [ ]:
nominal dir_entry =
`(
global "#if FABLE_COMPILER\n[<Fable.Core.Erase; Fable.Core.Emit(\"async_walkdir::DirEntry\")>]\n#endif\ntype async_walkdir_DirEntry = class end"
$'' : $'async_walkdir_DirEntry'
)
walk_dir¶
In [ ]:
nominal walk_dir =
`(
global "#if FABLE_COMPILER\n[<Fable.Core.Erase; Fable.Core.Emit(\"async_walkdir::WalkDir\")>]\n#endif\ntype async_walkdir_WalkDir = class end"
$'' : $'async_walkdir_WalkDir'
)
async_walkdir_filtering¶
In [ ]:
nominal async_walkdir_filtering =
`(
global "#if FABLE_COMPILER\n[<Fable.Core.Erase; Fable.Core.Emit(\"async_walkdir::Filtering\")>]\n#endif\ntype async_walkdir_Filtering = class end"
$'' : $'async_walkdir_Filtering'
)
filtering¶
In [ ]:
union filtering =
| Ignore
| IgnoreDir
| Continue
async_walkdir_error¶
In [ ]:
nominal async_walkdir_error =
`(
global "#if FABLE_COMPILER\n[<Fable.Core.Erase; Fable.Core.Emit(\"async_walkdir::Error\")>]\n#endif\ntype async_walkdir_Error = class end"
$'' : $'async_walkdir_Error'
)
new_walk_dir¶
In [ ]:
inl new_walk_dir (dir : string) : walk_dir =
!\\(dir, $'"async_walkdir::WalkDir::new(&*$0)"')
// inl walk_dir : walk_dir = walk_dir |> rust.to_mut
// (!\($'"true; let mut !walk_dir = !walk_dir"') : bool) |> ignore
walk_dir_filter¶
In [ ]:
inl walk_dir_filter (fn : dir_entry -> async.future_pin_send filtering) (walk_dir : walk_dir) : walk_dir =
inl fn entry = async.new_future_send fun () =>
inl result = fn entry |> async.await_send
inl filtering : async_walkdir_filtering =
match result with
| Ignore => !\($'"async_walkdir::Filtering::Ignore"')
| IgnoreDir => !\($'"async_walkdir::Filtering::IgnoreDir"')
| Continue => !\($'"async_walkdir::Filtering::Continue"')
filtering
!\\((walk_dir, fn), $'"async_walkdir::WalkDir::filter($0, |x| $1(x))"')
file_type¶
In [ ]:
nominal file_type =
`(
global "#if FABLE_COMPILER\n[<Fable.Core.Erase; Fable.Core.Emit(\"std::fs::FileType\")>]\n#endif\ntype std_fs_FileType = class end"
$'' : $'std_fs_FileType'
)
dir_entry_file_type¶
In [ ]:
inl dir_entry_file_type (dir_entry : dir_entry) : async.future_pin_send (resultm.result' file_type stream.io_error) =
inl dir_entry = join dir_entry
!\($'"Box::pin(async_walkdir::DirEntry::file_type(&!dir_entry))"')
file_type_is_dir¶
In [ ]:
inl file_type_is_dir (file_type : file_type) : bool =
inl file_type = join file_type
!\($'"std::fs::FileType::is_dir(&!file_type)"')
file¶
In [ ]:
nominal file =
`(
global "#if FABLE_COMPILER\n[<Fable.Core.Erase; Fable.Core.Emit(\"std::fs::File\")>]\n#endif\ntype std_fs_File = class end"
$'' : $'std_fs_File'
)
file_open¶
In [ ]:
inl file_open (path : string) : resultm.result' file stream.io_error =
!\($'"std::fs::File::open(&*!path)"')
rename¶
In [ ]:
inl rename (to : string) (path : string) : resultm.result' () stream.io_error =
!\($'"std::fs::rename(&*!path, &*!to)"')
dir_entry_path¶
In [ ]:
inl dir_entry_path (dir_entry : dir_entry) : path_buf =
!\\(dir_entry, $'"async_walkdir::DirEntry::path(&$0)"')
create_dir_all¶
In [ ]:
inl create_dir_all (path : string) : resultm.result' () stream.io_error =
!\\(path, $'"std::fs::create_dir_all(&*$0)"')
file_info_link_target¶
In [ ]:
inl file_info_link_target (file_info : file_info) : string =
run_target function
| Fsharp (Native) => fun () =>
$'!file_info.LinkTarget'
| _ => fun () => null ()
read¶
In [ ]:
inl read (path : string) : resultm.result' (am'.vec u8) stream.io_error =
!\\(path, $'"std::fs::read(&*$0)"')
typescript¶
ts_path_join¶
In [ ]:
inl ts_path_join (b : string) (a : string) : string =
open typescript_operators
global "type IPathJoin = abstract join: [<System.ParamArray>] paths: string[] -> string"
inl path : $'IPathJoin' = typescript.import_all "path"
!\\((join a, join b), $'"!path.join($0, $1)"')
file_system¶
(< />)¶
In [ ]:
let (</>) (a : string) (b : string) : string =
run_target function
| Rust (Contract) => fun () => null ()
| Rust (Native) => fun () =>
a
|> sm'.to_std_string
|> new_path_buf
|> path_buf_join b
|> path_buf_display
|> sm'.format'
|> sm'.from_std_string
| TypeScript (Native) => fun () =>
a |> ts_path_join b
| Fsharp (Native) => fun () =>
$'System.IO.Path.Combine (!a, !b)'
| target => fun () => failwith $'$"file_system.(</>) / target: {!target} / a: {!a} / b: {!b}"'
get_temp_path¶
In [ ]:
let get_temp_path () : string =
run_target function
| Rust (Contract) => fun () => null ()
| Rust (Native) => fun () =>
!\($'"std::env::temp_dir()"')
|> path_buf_display
|> sm'.format'
|> sm'.from_std_string
| Fsharp (Native) => fun () =>
$'System.IO.Path.GetTempPath' ()
| target => fun () => failwith $'$"file_system.get_temp_path / target: {!target}"'
get_file_name¶
In [ ]:
let get_file_name (path : string) : string =
run_target function
| Rust (Contract) => fun () => null ()
| Rust (Native) => fun () =>
path
|> sm'.to_std_string
|> new_path_buf
|> path_buf_file_name
|> optionm'.map' sm'.from_os_str_ref
|> optionm'.unbox
|> optionm'.default_value ""
| Fsharp (Native) => fun () =>
path |> $'System.IO.Path.GetFileName'
| target => fun () => failwith $'$"file_system.get_file_name / target: {!target} / path: {!path}"'
get_file_name_without_extension¶
In [ ]:
let get_file_name_without_extension (path : string) : string =
run_target function
| Rust (Contract) => fun () => null ()
| Rust (Native) => fun () =>
inl path_buf = path |> sm'.to_std_string |> new_path_buf
inl file_stem = !\\(path_buf, $'"$0.file_stem()"')
match file_stem |> optionm'.map' sm'.from_os_str_ref |> optionm'.unbox with
| Some file_stem => file_stem
| None => ""
| _ => fun () =>
path |> $'System.IO.Path.GetFileNameWithoutExtension'
get_directory_name¶
In [ ]:
let get_directory_name (path : string) : string =
run_target function
| Rust (Native) => fun () =>
inl path_buf = path |> sm'.to_std_string |> new_path_buf
inl parent = path_buf |> path_buf_parent
parent
|> optionm'.map' (path_buf_display >> sm'.format' >> sm'.from_std_string)
|> optionm'.default_value' ""
| Fsharp _ => fun () =>
path |> $'System.IO.Path.GetDirectoryName'
| _ => fun () => null ()
get_extension¶
In [ ]:
let get_extension (path : string) : string =
run_target function
| Rust (Contract) => fun () => null ()
| Rust (Native) => fun () =>
inl path_buf = path |> sm'.to_std_string |> new_path_buf
!\\(path_buf, $'"$0.extension()"')
|> optionm'.unwrap
|> sm'.from_os_str_ref
| _ => fun () =>
path |> $'System.IO.Path.GetExtension'
directory_separator_char¶
In [ ]:
let directory_separator_char () : char =
run_target function
| Rust (Native) => fun () =>
!\($'"std::path::MAIN_SEPARATOR"')
| _ => fun () =>
$'System.IO.Path.DirectorySeparatorChar'
get_current_directory¶
In [ ]:
let get_current_directory () : string =
run_target function
| Rust (Contract | Wasm) => fun () => null ()
| Rust (Native) => fun () =>
inl current_dir = !\($'"std::env::current_dir()"') : resultm.result' path_buf stream.io_error
current_dir
|> resultm.unwrap'
|> path_buf_display
|> sm'.format'
|> sm'.from_std_string
| Fsharp (Native) => fun () =>
$'System.IO.Directory.GetCurrentDirectory' ()
| _ => fun () => null ()
In [ ]:
//// test
get_current_directory ()
|> _assert_contains (directory_separator_char ())
__assert_contains / actual: "/home/runner/work/polyglot/polyglot/lib/spiral" / expected: '/'
directory_exists¶
In [ ]:
let directory_exists (path : string) : bool =
run_target function
| Fsharp (Native) => fun () =>
path |> $'System.IO.Directory.Exists'
| Rust (Native) => fun () =>
inl path = path |> sm'.to_std_string |> new_path_buf
path_buf_exists path && path_buf_is_dir path
| TypeScript (Native) => fun () =>
global "type IFsExistsSync = abstract existsSync: path: string -> bool"
open typescript_operators
inl fs : $'IFsExistsSync' = typescript.import_all "fs"
!\\((fs, path), $'"$0.existsSync($1)"')
| _ => fun () => null ()
directory_get_parent¶
In [ ]:
let directory_get_parent (path : string) : optionm'.option' string =
run_target function
| Fsharp (Native) => fun () =>
inl parent : directory_info = path |> $'System.IO.Directory.GetParent'
if parent =. null ()
then None
else parent |> directory_info_full_name |> Some
| Rust (Native) => fun () =>
path
|> get_directory_name
|> Some
| TypeScript _ => fun () =>
open typescript_operators
global "type IPathDirname = abstract dirname: path: string -> string"
inl fs : $'IPathDirname' = typescript.import_all "path"
!\\(path, $'"!fs.dirname($0)"') |> Some
| _ => fun () => null ()
|> optionm'.box
create_temp_path'¶
In [ ]:
let create_temp_path' (guid : guid.guid) =
run_target function
| Rust (Contract) => fun () => null ()
| _ => fun () =>
get_temp_path ()
</> (join "!create_temp_path_")
</> (env.get_entry_assembly_name ())
</> (guid |> sm'.obj_to_string)
create_temp_path¶
In [ ]:
let create_temp_path () =
run_target function
| Rust (Contract) => fun () => null ()
| _ => fun () =>
date_time.now ()
|> date_time.new_guid_from_date_time
|> create_temp_path'
In [ ]:
//// test
///! fsharp
///! rust -d chrono
create_temp_path ()
|> _assert_contains (directory_separator_char ())
.rs output (rust -d chrono): __assert_contains / actual: "/tmp/!create_temp_path_/spiral_builder_71514128aa092e3f286d7b78803157c95d5826eaab4056c0d36ef001cd6a42bb/20241106-0717-4073-8490-00000003d1d0" / expected: '/'
.fsx output: __assert_contains / actual: "/tmp/!create_temp_path_/dotnet-repl/20241106-0717-4111-1121-1000003aa49d" / expected: '/'
file_copy¶
In [ ]:
let file_copy (new_path : string) (old_path : string) : () =
run_target function
| Fsharp (Native) => fun () =>
$'System.IO.File.Copy (!old_path, !new_path, true)'
| Rust (Native) => fun () =>
inl new_path = join new_path
inl result : _ _ stream.io_error = !\\(old_path, $'"std::fs::copy(&*$0, &*!new_path)"')
match result |> resultm.map_error' sm'.format' |> resultm.unbox with
| Ok (result : u64) =>
trace Debug
fun () => "file_system.file_copy"
fun () => { old_path new_path result }
| Error error =>
trace Warning
fun () => "file_system.file_copy"
fun () => { old_path new_path error }
| _ => fun () => ()
file_exists¶
In [ ]:
let file_exists (path : string) : bool =
run_target function
| Fsharp (Native) => fun () =>
path |> $'System.IO.File.Exists'
| Rust (Native) => fun () =>
inl path_buf = path |> sm'.to_std_string |> new_path_buf
path_buf_exists path_buf && path_buf_is_file path_buf
| TypeScript (Native) => fun () =>
open typescript_operators
global "type IFsExistsSync = abstract existsSync: path: string -> bool"
inl fs : $'IFsExistsSync' = typescript.import_all "fs"
!\\((fs, path), $'"$0.existsSync($1)"')
| _ => fun () => null ()
directory_delete¶
In [ ]:
let directory_delete recursive (path : string) : () =
run_target function
| Fsharp (Native) => fun () =>
$'System.IO.Directory.Delete (!path, !recursive)'
| Rust (Native) => fun () =>
inl path = join path
if path |> directory_exists then
if recursive
then !\\(path, $'"std::fs::remove_dir_all(&*$0).unwrap()"')
else !\\(path, $'"std::fs::remove_dir(&*$0).unwrap()"')
| _ => fun () => ()
write_all_text¶
In [ ]:
inl write_all_text (path : string) (text : string) : () =
run_target function
| Fsharp (Native) => fun () =>
inl text = join text
$'System.IO.File.WriteAllText (!path, !text)'
| Rust (Native) => fun () =>
!\\((path, text), $'"std::fs::write(&*$0, &*$1).unwrap()"')
| _ => fun () => ()
read_all_bytes¶
In [ ]:
inl read_all_bytes (path : string) : am'.vec u8 =
run_target function
| Fsharp (Native) => fun () =>
$'!path |> System.IO.File.ReadAllBytes'
|> am'.to_vec
| Rust (Native) => fun () =>
path |> read |> resultm.unwrap'
| _ => fun () => null ()
read_all_text¶
In [ ]:
inl read_all_text (path : string) : string =
run_target function
| Fsharp (Native) => fun () =>
$'!path |> System.IO.File.ReadAllText'
| Rust (Native) => fun () =>
path
|> read_all_bytes
|> sm'.string_from_utf8
|> resultm.unwrap'
|> sm'.from_std_string
| _ => fun () => null ()
directory_create_symbolic_link¶
In [ ]:
inl directory_create_symbolic_link (target : string) (path : string) : () =
run_target function
| Fsharp (Native) => fun () =>
($'System.IO.Directory.CreateSymbolicLink (!path, !target)' : file_system_info)
|> ignore
| Rust (Native) => fun () =>
(!\\((target, path), $'"true; #[cfg(windows)] std::os::windows::fs::symlink_dir(&*$0, &*$1).unwrap()"') : bool) |> ignore
(!\\((target, path), $'"true; #[cfg(unix)] std::os::unix::fs::symlink(&*$0, &*$1).unwrap()"') : bool) |> ignore
| _ => fun () => ()
file_create_symbolic_link¶
In [ ]:
inl file_create_symbolic_link (target : string) (path : string) : () =
run_target function
| Fsharp (Native) => fun () =>
($'System.IO.File.CreateSymbolicLink (!path, !target)' : file_system_info)
|> ignore
| Rust (Native) => fun () =>
(!\\((target, path), $'"true; #[cfg(windows)] std::os::windows::fs::symlink_file(&*$0, &*$1).unwrap()"') : bool) |> ignore
(!\\((target, path), $'"true; #[cfg(unix)] std::os::unix::fs::symlink(&*$0, &*$1).unwrap()"') : bool) |> ignore
| _ => fun () => ()
file_type¶
In [ ]:
union file_type =
| File
| Directory
find_parent¶
In [ ]:
inl find_parent file_type name root_dir =
inl is_file = file_type = File
let rec loop dir =
if dir </> name |> (if is_file then file_exists else directory_exists)
then dir |> Ok
else
inl result = dir |> (join directory_get_parent)
match result |> optionm'.unbox with
| Some parent => parent |> loop
| None => ($'$"""No parent for {if !is_file then "file" else "dir"} \'{!name}\' at \'{!root_dir}\' (until \'{!dir}\')"""' : string) |> Error
loop root_dir
In [ ]:
//// test
a ;[ Directory, ".paket"; File, "paket.dependencies" ]
|> am.map fun file_type, file =>
get_source_directory ()
|> find_parent file_type file
|> resultm.get
|> directory_info
|> directory_info_name
|> am'.distinct
|> fun (a x : _ int _) => x
|> _assert_eq' ;[ "polyglot" ]
__assert_eq' / actual: [|"polyglot"|] / expected: [|"polyglot"|]
In [ ]:
//// test
///! rust
a ;[ Directory, ".paket"; File, "paket.dependencies" ]
|> am.map fun file_type, file =>
fun () =>
join
get_source_directory ()
|> find_parent file_type file
|> resultm.get
|> sm'.to_std_string
|> new_path_buf
|> path_buf_file_name
|> optionm'.try'
|> sm'.from_os_str_ref
|> Some
|> optionm'.box
|> fun x => x () |> optionm'.unbox
|> optionm'.default_value ""
|> am'.distinct
|> fun result =>
result |> am'.length |> _assert_eq 1i32
index result 0i32 |> _assert_eq "polyglot"
__assert_eq / actual: 1 / expected: 1 __assert_eq / actual: "polyglot" / expected: "polyglot"
get_workspace_root¶
In [ ]:
inl get_workspace_root () =
(None, [ get_source_directory; get_current_directory ])
||> listm.fold fun acc path =>
match acc with
| Some path => Some path
| None =>
path ()
|> find_parent Directory ("polyglot" </> ".devcontainer")
|> function
| Ok path => Some path
| Error error =>
trace Warning
fun () => "file_system.get_workspace_root"
fun () => { error }
None
|> optionm.value
|> fun root => root </> "polyglot"
get_workspace_root_external¶
In [ ]:
inl get_workspace_root_external () =
inl workspace_root = get_workspace_root ()
inl current_dir = get_current_directory () |> sm'.to_lower
inl workspace_root = workspace_root |> sm'.to_lower
if current_dir |> sm'.starts_with workspace_root
then Error workspace_root
else Ok workspace_root
In [ ]:
//// test
get_workspace_root_external ()
|> resultm.unwrap_err
|> get_file_name
|> _assert_eq "polyglot"
__assert_eq / actual: "polyglot" / expected: "polyglot"
file_delete¶
In [ ]:
inl file_delete (path : string) : () =
run_target function
| Fsharp (Native) => fun () =>
path |> $'System.IO.File.Delete'
| Rust (Native) => fun () =>
!\\(path, $'"std::fs::remove_file(&*$0).unwrap()"')
| _ => fun () => ()
read_link¶
In [ ]:
inl read_link (path : string) : resultm.result' path_buf stream.io_error =
inl run loop n error path' =
inl name = path' |> get_file_name
inl parent = path' |> directory_get_parent |> optionm'.unbox
match parent with
| _ when n >= 11 =>
($'$"file_system.read_link / path: {!path} / n: {!n} / path\': {!path'} / name: {!name}"' : string)
|> stream.new_io_error
|> resultm.err
| Some parent when path' <>. "" =>
match loop (n + 1) parent |> resultm.map_error' sm'.format |> resultm.unbox with
| Ok parent' =>
(parent' |> path_buf_display |> convert) </> name
|> sm'.to_std_string
|> new_path_buf
|> resultm.ok''
| Error error' =>
($'$"file_system.read_link / error\': {!error'} / error: {!error} / name: {!name}"' : string)
|> stream.new_io_error
|> resultm.err
| _ =>
($'$"file_system.read_link / run / The file or directory is not a reparse point. / path: {!path} / error: {!error} / path\': {!path'} / name: {!name}"' : string)
|> stream.new_io_error
|> resultm.err
run_target function
| Rust _ => fun () =>
if path |> directory_exists
then !\\(path, $'"std::fs::read_link(&*$0)"')
else
inl rec loop n path' =
inl result : _ _ stream.io_error = !\\(path', $'"std::fs::read_link(&*$0)"')
inl result = result |> resultm.map_error' sm'.format |> resultm.unbox
match result with
| Ok x => x |> resultm.ok''
| Error error => path' |> run loop n error
path |> loop 0u8
| TypeScript _ => fun () => null ()
| Fsharp _ => fun () =>
inl rec loop n path' =
inl result =
path'
|> directory_info
|> directory_info_attributes
|> file_attributes_has_flag (file_attributes_reparse_point ())
if result then
path'
|> file_info
|> file_info_link_target
|> convert
|> resultm.ok''
else
inl error = ($'$"file_system.read_link / Fsharp / The file or directory is not a reparse point. / path: {!path} / result: {!result} / path\': {!path'} / n: {!n}"' : string)
inl error = error |> stream.new_io_error
path' |> run loop n error
path |> loop 0u8
| _ => fun () => $'Unchecked.defaultof<_>'
normalize_path¶
In [ ]:
let normalize_path (path : string) : string =
if path = ""
then ""
else
inl path =
match path |> read_link |> resultm.ok' |> optionm'.unbox with
| Some path_buf =>
inl result =
path_buf
|> path_buf_display
|> convert
if result = ""
then path
else result
| None => path
if path = ""
then ""
else
inl path = path |> sm'.replace_regex @"^\\\\\?\\" ""
$'$"{!path.[0] |> string |> _.ToLower()}{!path.[1..]}"' |> sm'.replace "\\" "/"
get_full_path¶
In [ ]:
let get_full_path (path : string) : string =
run_target_args (fun () => path) function
| Fsharp (Native) => fun path =>
path |> $'System.IO.Path.GetFullPath'
| Rust (Native) => fun path =>
inl path_buf = path |> sm'.to_std_string |> new_path_buf
if path_buf |> path_buf_exists |> not then
inl current_dir = get_current_directory ()
current_dir </> path
|> normalize_path
|> sm'.split "/"
|> fun x =>
((a x : _ i32 _), (0i32, (a ;[] : _ i32 _)))
||> am.foldBack fun x level, acc =>
match x, level with
| "..", _ => level + 1, acc
| ".", _ => level, acc
| _, 0 when x |> sm'.ends_with ":" => 0, a ;[ $'$"{!current_dir.[0]}:"' ] ++ acc
| _, 0 => 0, a ;[ x ] ++ acc
| _ => level - 1, acc
|> snd
|> seq.of_array'
|> sm'.concat (directory_separator_char () |> sm'.obj_to_string)
else
inl path = !\\(path, $'"std::fs::canonicalize(&*$0)"') : resultm.result' path_buf stream.io_error
path
|> resultm.unwrap'
|> path_buf_display
|> sm'.format'
|> sm'.from_std_string
| _ => fun _ => null ()
In [ ]:
//// test
"."
|> get_full_path
|> directory_info
|> directory_info_name
|> _assert_eq "spiral"
__assert_eq / actual: "spiral" / expected: "spiral"
In [ ]:
//// test
"dir/.././._file"
|> get_full_path
|> _assert_eq (get_current_directory () </> "._file")
__assert_eq / actual: "/home/runner/work/polyglot/polyglot/lib/spiral/._file" / expected: "/home/runner/work/polyglot/polyglot/lib/spiral/._file"
In [ ]:
//// test
///! rust -d regex
"."
|> get_full_path
|> sm'.to_std_string
|> new_path_buf
|> path_buf_file_name
|> optionm'.unwrap
|> sm'.from_os_str_ref
|> _assert_eq "spiral"
__assert_eq / actual: "spiral" / expected: "spiral"
In [ ]:
//// test
///! rust -d regex
"dir/.././._file"
|> get_full_path
|> _assert_eq (get_current_directory () </> "._file")
__assert_eq / actual: "/home/runner/work/polyglot/polyglot/lib/spiral/._file" / expected: "/home/runner/work/polyglot/polyglot/lib/spiral/._file"
standardize_path¶
In [ ]:
let standardize_path path =
path |> get_full_path |> normalize_path
absolute_path¶
In [ ]:
let absolute_path path =
inl current_dir = get_current_directory ()
current_dir </> path |> standardize_path
new_file_uri¶
In [ ]:
inl new_file_uri (path : string) : string =
inl path = path |> sm'.trim_start [ '/' ]
$'$"file:///{!path}"'
In [ ]:
//// test
@"\\?\C:\test"
|> normalize_path
|> new_file_uri
|> _assert_eq "file:///c:/test"
__assert_eq / actual: "file:///c:/test" / expected: "file:///c:/test"
In [ ]:
//// test
///! rust -d regex
@"\\?\C:\test"
|> normalize_path
|> new_file_uri
|> _assert_eq "file:///c:/test"
__assert_eq / actual: "file:///c:/test" / expected: "file:///c:/test"
fsharp¶
file_exists_content_async¶
In [ ]:
inl file_exists_content_async path content : async.async bool =
run_target function
| Fsharp (Native) => fun () =>
fun () =>
fix_condition
fun () => path |> file_exists |> not
fun () => false |> return
fun () =>
inl existing_content = path |> read_all_text_async |> async.let'
content = existing_content |> return
|> async.new_async_unit
| _ => fun () => null ()
write_all_text_exists_async¶
In [ ]:
inl write_all_text_exists_async path contents =
fun () =>
inl exists' = contents |> file_exists_content_async path |> async.let'
if not exists'
then contents |> write_all_text_async path |> async.do
|> async.new_async
delete_directory_async¶
In [ ]:
inl delete_directory_async path : _ i64 =
run_target function
| Fsharp (Native) => fun () =>
let rec loop (retry : i64) =
fun () =>
try_unit
fun () =>
path |> directory_delete true
retry |> return
fun ex =>
if retry % 100i64 = 0 then
inl ex = ex |> sm'.format_exception
trace Debug
fun () => "file_system.delete_directory_async"
fun () => { ex path = path |> get_file_name }
async.sleep 10i32 |> async.do
loop (retry + 1) |> async.return_await
|> async.new_async
loop 0
| _ => fun () => null ()
trace_file¶
In [ ]:
let rec trace_file text =
run_target function
| Fsharp (Native) => fun () =>
try_unit
fun () =>
inl assembly_name = env.get_entry_assembly_name ()
inl guid = date_time.now () |> date_time.new_guid_from_date_time
inl file_name = $'$"{!assembly_name}_{!guid}.txt"'
inl workspace_root = get_workspace_root ()
inl trace_dir = workspace_root </> "target/trace"
trace_dir |> create_directory |> ignore
inl path = trace_dir </> file_name
text |> write_all_text_async path |> async.run_synchronously
fun ex =>
trace_file $'$"file_system.trace_file / ex: %A{!ex}"'
| _ => fun () => ()
In [ ]:
//// test
inl get_count dir : i64 =
inl files = dir |> directory_get_files
a files |> am'.length
inl trace_dir = get_workspace_root () </> "target/trace"
trace_dir |> create_directory |> ignore
inl count = get_count trace_dir
trace_file "test"
get_count trace_dir
|> _assert_eq (count + 1)
__assert_eq / actual: 1L / expected: 1L
init_trace_file¶
In [ ]:
inl init_trace_file enabled =
inl state_trace_file = get_trace_state_or_init None .trace_file
state_trace_file <- if enabled then trace_file else ignore
file_system¶
create_dir¶
In [ ]:
let create_dir dir =
run_target function
| Rust (Contract | Wasm) => fun () => null ()
| Rust (Native) => fun () =>
inl dir = join dir
match dir |> create_dir_all |> resultm.map_error' sm'.format' |> resultm.unbox with
| Ok () =>
trace Verbose
fun () => "file_system.create_dir"
fun () => { dir }
| Error error =>
trace Critical
fun () => "file_system.create_dir"
fun () => { dir error }
inl disposable : _ () = new_disposable fun () =>
dir
|> directory_delete true
disposable
| _ => fun () =>
inl directory_info = dir |> create_directory
inl exists' = directory_info |> directory_info_exists
if not exists' then
inl creation_time = directory_info |> directory_info_creation_time
inl result = ($'{| Exists = !exists'; CreationTime = !creation_time |}' : infer) |> sm'.format_debug
trace Debug
fun () => "file_system.create_dir"
fun () => { dir result }
inl disposable : _ () = new_disposable fun () =>
dir
|> delete_directory_async
|> async.ignore
|> async.run_synchronously
disposable
create_temp_dir¶
In [ ]:
inl create_temp_dir () =
inl dir = create_temp_path ()
dir, dir |> create_dir
In [ ]:
//// test
inl path, disposable = create_temp_dir ()
disposable |> use |> ignore
path
|> directory_exists
|> _assert_eq true
__assert_eq / actual: true / expected: true
In [ ]:
//// test
///! rust -d chrono
inl path, disposable = create_temp_dir ()
path
|> directory_exists
|> _assert_eq true
disposable |> use |> ignore
path
|> directory_exists
|> _assert_eq false
00:00:00 v #1 file_system.create_dir / { dir = /tmp/!create_temp_path_/spiral_builder_ca86f4d0d5af51fc35a6023bbf9f8aad9630b4a5795edce38f867dd7761eb036/20241106-0718-4709-0493-0000001b6cbf }
__assert_eq / actual: true / expected: true
__assert_eq / actual: false / expected: false
In [ ]:
//// test
inl lock_directory path =
fun () =>
trace Debug (fun () => "_1") id
"0" |> write_all_text_async (path </> "test.txt") |> async.do
file_stream
(path </> "test.txt")
ModeOpen
AccessReadWrite
ShareNone
|> use
|> ignore
trace Debug (fun () => "_2") id
async.sleep 2000 |> async.do
trace Debug (fun () => "_3") id
() |> return
|> async.new_async
inl temp_dir, disposable = create_temp_dir ()
disposable |> use |> ignore
inl path = temp_dir </> "test"
fun () =>
trace Debug (fun () => "1") id
path |> create_directory |> ignore
trace Debug (fun () => "2") id
inl child = path |> lock_directory |> async.start_child |> async.let'
trace Debug (fun () => "3") id
async.sleep 60 |> async.do
trace Debug (fun () => "4") id
inl retries = path |> delete_directory_async |> async.let'
trace Debug (fun () => "5") id
child |> async.do
trace Debug (fun () => "6") id
retries |> return
|> async.new_async_unit
|> async.run_with_timeout 3000
|> fun x => x : _ i64
|> function
| Some (retries : i64) =>
retries
|> _assert_between
(if platform.is_windows () then 50 else 0)
(if platform.is_windows () then 180 else 0)
true
| _ => false
|> _assert_eq true
00:00:00 d #1 1 00:00:00 d #2 2 00:00:00 d #3 3 00:00:00 d #4 _1 00:00:00 d #5 _2 00:00:00 d #6 4 00:00:00 d #7 5 00:00:02 d #8 _3 00:00:02 d #9 6 __assert_between / actual: 0L / expected: struct (0L, 0L) __assert_eq / actual: true / expected: true
create_temp_dir'¶
In [ ]:
inl create_temp_dir' (hash : string) =
inl dir = hash |> guid.hash_guid |> create_temp_path'
dir, dir |> create_dir
link_directory¶
In [ ]:
let link_directory target_path path =
if target_path |> directory_exists |> not
then target_path |> create_dir |> ignore
inl lib_dir_path = path |> get_directory_name
if lib_dir_path |> directory_exists |> not
then lib_dir_path |> create_dir |> ignore
if (path |> directory_exists)
&& (path |> read_link |> resultm.is_err) then
path |> directory_delete true
if path |> directory_exists |> not then
path |> directory_create_symbolic_link target_path
link_file¶
In [ ]:
let link_file target_path path =
if (path |> file_exists)
&& (path |> read_link |> resultm.is_err) then
path |> file_delete
if path |> file_exists |> not then
path |> file_create_symbolic_link target_path
In [ ]:
//// test
///! fsharp
///! rust -d sha2 regex
inl file_name = "LICENSE"
inl text = file_name
inl test_hash =
(file_name, text)
|> sm'.format_debug
|> crypto.hash_text
inl workspace_root = get_workspace_root ()
inl test_dir = workspace_root </> "target/test/file_system" </> test_hash
inl disposable = test_dir |> create_dir
inl dir_path = test_dir </> "dir1"
if dir_path |> directory_exists
then dir_path |> directory_delete true
dir_path |> create_dir |> ignore
inl path = dir_path </> file_name
text |> write_all_text path
inl dir_link_path = test_dir </> "link1"
dir_link_path |> link_directory dir_path
inl link_path = dir_link_path </> file_name
link_path
|> read_all_text
|> _assert_eq text
dir_link_path
|> read_link
|> resultm.unwrap'
|> path_buf_display
|> convert
|> _assert sm'.ends_with "dir1"
link_path
|> read_link
|> resultm.unwrap'
|> path_buf_display
|> convert
|> _assert sm'.ends_with "LICENSE"
inl link_name = "LICENSE_"
inl link_path = dir_path </> link_name
link_path |> link_file path
inl link_path' = dir_link_path </> link_name
link_path'
|> read_all_text
|> _assert_eq text
link_path
|> read_link
|> resultm.unwrap'
|> path_buf_display
|> convert
|> _assert sm'.ends_with "LICENSE"
link_path'
|> read_link
|> resultm.unwrap'
|> path_buf_display
|> convert
|> _assert sm'.ends_with "LICENSE"
disposable |> use |> ignore
.rs output (rust -d sha2 regex): 00:00:00 v #1 file_system.create_dir / { dir = /home/runner/work/polyglot/polyglot/target/test/file_system/17e16cea7984b0e6f403259e33e49592eda85aedd790ed910e9f3e619d9cd257 } 00:00:00 v #2 file_system.create_dir / { dir = /home/runner/work/polyglot/polyglot/target/test/file_system/17e16cea7984b0e6f403259e33e49592eda85aedd790ed910e9f3e619d9cd257/dir1 } __assert_eq / actual: "LICENSE" / expected: "LICENSE" __assert / actual: "dir1" / expected: "/home/runner/work/polyglot/polyglot/target/test/file_system/17e16cea7984b0e6f403259e33e49592eda85aedd790ed910e9f3e619d9cd257/dir1" __assert / actual: "LICENSE" / expected: "/home/runner/work/polyglot/polyglot/target/test/file_system/17e16cea7984b0e6f403259e33e49592eda85aedd790ed910e9f3e619d9cd257/dir1/LICENSE" __assert_eq / actual: "LICENSE" / expected: "LICENSE" __assert / actual: "LICENSE" / expected: "/home/runner/work/polyglot/polyglot/target/test/file_system/17e16cea7984b0e6f403259e33e49592eda85aedd790ed910e9f3e619d9cd257/dir1/LICENSE" __assert / actual: "LICENSE" / expected: "/home/runner/work/polyglot/polyglot/target/test/file_system/17e16cea7984b0e6f403259e33e49592eda85aedd790ed910e9f3e619d9cd257/dir1/LICENSE"
.fsx output: __assert_eq / actual: "LICENSE" / expected: "LICENSE" __assert / actual: "dir1" / expected: "/home/runner/work/polyglot/polyglot/target/test/file_system/8f260c25ec3f6eaaf0d0d1b67ed9c47873a182ca04606835404e641a952871da/dir1" __assert / actual: "LICENSE" / expected: "/home/runner/work/polyglot/polyglot/target/test/file_system/8f260c25ec3f6eaaf0d0d1b67ed9c47873a182ca04606835404e641a952871da/dir1/LICENSE" __assert_eq / actual: "LICENSE" / expected: "LICENSE" __assert / actual: "LICENSE" / expected: "/home/runner/work/polyglot/polyglot/target/test/file_system/8f260c25ec3f6eaaf0d0d1b67ed9c47873a182ca04606835404e641a952871da/dir1/LICENSE" __assert / actual: "LICENSE" / expected: "/home/runner/work/polyglot/polyglot/target/test/file_system/8f260c25ec3f6eaaf0d0d1b67ed9c47873a182ca04606835404e641a952871da/dir1/LICENSE"
rust¶
file_exists_content¶
In [ ]:
let file_exists_content path content : bool =
run_target function
| Rust (Native) => fun () =>
if path |> file_exists |> not
then false
else
inl existing_content = path |> read_all_text
content = existing_content
| _ => fun () => null ()
write_all_text_exists¶
In [ ]:
let write_all_text_exists path contents =
inl exists' = contents |> file_exists_content path
if not exists' then
inl dir = path |> get_directory_name
if dir |> directory_exists |> not
then dir |> create_dir |> ignore
contents |> write_all_text path
fsharp¶
wait_for_file_access¶
In [ ]:
inl wait_for_file_access access path =
run_target function
| Fsharp (Native) => fun () =>
inl file_access, file_share =
access
|> optionm'.default_value (AccessReadWrite, ShareRead)
let rec loop (retry : i64) : _ i64 =
fun () =>
try_unit
fun () =>
file_stream
path
ModeOpen
file_access
file_share
|> use
|> ignore
retry |> return
fun ex =>
if retry > 0 && retry % 100i64 = 0 then
inl ex = ex |> sm'.format_exception
trace Debug
fun () => "file_system.wait_for_file_access"
fun () => { path = path |> get_file_name; retry ex }
async.sleep 10i32 |> async.do
loop (retry + 1) |> async.return_await
|> async.new_async
loop 0
| _ => fun () => null ()
inl wait_for_file_access_read path =
path
|> wait_for_file_access (Some (
AccessRead,
ShareRead
))
In [ ]:
//// test
inl lock_file path =
fun () =>
trace Debug (fun () => "_1") id
inl stream : file_stream' =
file_stream
path
ModeOpen
AccessReadWrite
ShareNone
|> use
trace Debug (fun () => "_2") id
async.sleep 2000 |> async.do
trace Debug (fun () => "_3") id
($'!stream.Seek (0L, System.IO.SeekOrigin.Begin)' : i64) |> ignore
trace Debug (fun () => "_4") id
$'!stream.WriteByte' 49u8
trace Debug (fun () => "_5") id
stream |> $'_.Flush()'
trace Debug (fun () => "_6") id
|> async.new_async
inl file_name = "test.txt"
inl text = "0"
inl temp_dir, disposable =
(file_name, text)
|> sm'.format_debug
|> crypto.hash_text
|> create_temp_dir'
disposable |> use |> ignore
inl path = temp_dir </> file_name
fun () =>
trace Debug (fun () => "1") id
text |> write_all_text_async path |> async.do
trace Debug (fun () => "2") id
inl child = path |> lock_file |> async.start_child |> async.let'
trace Debug (fun () => "3") id
async.sleep 1 |> async.do
trace Debug (fun () => "4") id
inl retries = path |> wait_for_file_access None |> async.let'
trace Debug (fun () => "5") id
inl text = path |> read_all_text_async |> async.let'
trace Debug (fun () => "6") id
child |> async.do
trace Debug (fun () => "7") id
(retries, text) |> return
|> async.new_async_unit
|> async.run_with_timeout 3000
|> function
| Some ((retries : i64), text) =>
retries
|> _assert_between
(if platform.is_windows () then 50 else 100)
(if platform.is_windows () then 180 else 200)
text |> _assert_eq (join "1")
true
| _ => false
|> _assert_eq true
00:00:00 d #1 1 00:00:00 d #2 2 00:00:00 d #3 3 00:00:00 d #4 _1 00:00:00 d #5 _2 00:00:00 d #6 4 00:00:01 d #7 file_system.wait_for_file_access / { path = test.txt; retry = 100; ex = System.IO.IOException: The process cannot access the file '/tmp/!create_temp_path_/dotnet-repl/613830ed-016e-d959-8d21-02dc1c63c252/test.txt' because it is being used by another process. } 00:00:02 d #8 _3 00:00:02 d #9 _4 00:00:02 d #10 _5 00:00:02 d #11 _6 00:00:02 d #12 5 00:00:02 d #13 6 00:00:02 d #14 7 __assert_between / actual: 167L / expected: struct (100L, 200L) __assert_eq / actual: "1" / expected: "1" __assert_eq / actual: true / expected: true
read_all_text_retry_async¶
In [ ]:
inl read_all_text_retry_async full_path : async.async (optionm'.option' string) =
run_target function
| Fsharp (Native) => fun () =>
let rec loop (retry : i64) =
fun () =>
inl retry = join retry
try_unit
fun () =>
if retry > 0
then
full_path
|> wait_for_file_access_read
|> async.run_with_timeout_async 1000
|> async.ignore
|> async.do
full_path |> read_all_text_async |> async.map (Some >> optionm'.box) |> async.return_await
fun ex =>
fix_condition
fun () => retry <> 0
fun () =>
inl ex = ex |> sm'.format_exception
trace Debug
fun () => "file_system.read_all_text_retry_async"
fun () => { retry ex }
(None : _ string) |> optionm'.box |> return
fun () =>
loop (retry + 1) |> async.return_await
|> async.new_async
loop 0
| _ => fun () => null ()
move_file_async¶
In [ ]:
inl move_file_async new_path old_path : _ i64 =
run_target function
| Fsharp (Native) => fun () =>
let rec loop (retry : i64) =
fun () =>
try_unit
fun () =>
old_path |> file_move new_path
return retry
fun ex =>
if retry % 100 = 0 then
trace Warning
fun () => "move_file_async"
fun () => {
old_path = old_path |> get_file_name
new_path = new_path |> get_file_name
ex
}
async.sleep 10 |> async.do
loop (retry + 1) |> async.return_await
|> async.new_async_unit
loop 0
| _ => fun () => null ()
In [ ]:
//// test
inl lock_file path =
fun () =>
trace Debug (fun () => "_1") id
file_stream
path
ModeOpen
AccessReadWrite
ShareNone
|> use
|> ignore
trace Debug (fun () => "_2") id
async.sleep 2000 |> async.do
trace Debug (fun () => "_3") id
|> async.new_async
fun () =>
inl file_name = "test.txt"
inl text = "0"
inl temp_dir, disposable =
(file_name, text)
|> sm'.format_debug
|> crypto.hash_text
|> create_temp_dir'
disposable |> use |> ignore
let path = temp_dir </> file_name
let new_path = temp_dir </> "test2.txt"
trace Debug (fun () => "1") id
text |> write_all_text_async path |> async.do
trace Debug (fun () => "2") id
inl child = lock_file path |> async.start_child |> async.let'
trace Debug (fun () => "3") id
async.sleep 1 |> async.do
trace Debug (fun () => "4") id
inl retries1 = path |> move_file_async new_path |> async.let'
trace Debug (fun () => "5") id
inl retries2 = new_path |> wait_for_file_access None |> async.let'
trace Debug (fun () => "6") id
inl text = new_path |> read_all_text_async |> async.let'
trace Debug (fun () => "7") id
child |> async.do
trace Debug (fun () => "8") id
(retries1, retries2, text) |> return
|> async.new_async_unit
|> async.run_with_timeout 3000
|> function
| Some (retries1, retries2, text) =>
retries1
|> _assert_between
(if platform.is_windows () then 50i64 else 0)
(if platform.is_windows () then 200 else 0)
retries2
|> _assert_between
(if platform.is_windows () then 0i64 else 100)
(if platform.is_windows () then 0 else 200)
text |> _assert_eq (join "0")
true
| _ => false
|> _assert_eq true
00:00:00 d #1 1 00:00:00 d #2 2 00:00:00 d #3 3 00:00:00 d #4 _1 00:00:00 d #5 _2 00:00:00 d #6 4 00:00:00 d #7 5 00:00:01 d #8 file_system.wait_for_file_access / { path = test2.txt; retry = 100; ex = System.IO.IOException: The process cannot access the file '/tmp/!create_temp_path_/dotnet-repl/613830ed-016e-d959-8d21-02dc1c63c252/test2.txt' because it is being used by another process. } 00:00:02 d #9 _3 00:00:02 d #10 6 00:00:02 d #11 7 00:00:02 d #12 8 __assert_between / actual: 0L / expected: struct (0L, 0L) __assert_between / actual: 167L / expected: struct (100L, 200L) __assert_eq / actual: "0" / expected: "0" __assert_eq / actual: true / expected: true
delete_file_async¶
In [ ]:
inl delete_file_async path : _ i64 =
run_target function
| Fsharp (Native) => fun () =>
let rec loop (retry : i64) =
fun () =>
try_unit
fun () =>
path |> file_delete
return retry
fun ex =>
if retry % 100 = 0 then
trace Warning
fun () => "delete_file_async"
fun () => { path = path |> get_file_name; ex = ex |> sm'.format_exception }
async.sleep 10 |> async.do
loop (retry + 1) |> async.return_await
|> async.new_async
loop 0
| _ => fun () => null ()
In [ ]:
//// test
inl lock_file path =
fun () =>
trace Debug (fun () => "_1") id
file_stream
path
ModeOpen
AccessReadWrite
ShareNone
|> use
|> ignore
trace Debug (fun () => "_2") id
async.sleep 2000 |> async.do
trace Debug (fun () => "_3") id
|> async.new_async
fun () =>
inl file_name = "test.txt"
inl text = "0"
inl temp_dir, disposable =
(file_name, text)
|> sm'.format_debug
|> crypto.hash_text
|> create_temp_dir'
disposable |> use |> ignore
inl path = temp_dir </> file_name
trace Debug (fun () => "1") id
text |> write_all_text_async path |> async.do
trace Debug (fun () => "2") id
inl child = lock_file path |> async.start_child |> async.let'
trace Debug (fun () => "3") id
async.sleep 1 |> async.do
trace Debug (fun () => "4") id
inl retries = delete_file_async path |> async.let'
trace Debug (fun () => "5") id
child |> async.do
trace Debug (fun () => "6") id
return retries
|> async.new_async_unit
|> async.run_with_timeout 3000
|> function
| Some (retries : i64) =>
retries
|> _assert_between
(if platform.is_windows () then 50 else 0)
(if platform.is_windows () then 180 else 0)
true
| _ => false
|> _assert_eq true
00:00:00 d #1 1 00:00:00 d #2 2 00:00:00 d #3 3 00:00:00 d #4 _1 00:00:00 d #5 _2 00:00:00 d #6 4 00:00:00 d #7 5 00:00:02 d #8 _3 00:00:02 d #9 6 __assert_between / actual: 0L / expected: struct (0L, 0L) __assert_eq / actual: true / expected: true
main¶
In [ ]:
inl main () =
init_trace_state None
$'let delete_directory_async x = !delete_directory_async x' : ()
$'let wait_for_file_access x = !wait_for_file_access x' : ()
$'let wait_for_file_access_read x = !wait_for_file_access_read x' : ()
$'let read_all_text_async x = !read_all_text_async x' : ()
$'let file_exists_content x = !file_exists_content x' : ()
$'let write_all_text_async x = !write_all_text_async x' : ()
$'let write_all_text_exists x = !write_all_text_exists_async x' : ()
$'let delete_file_async x = !delete_file_async x' : ()
$'let move_file_async x = !move_file_async x' : ()
$'let read_all_text_retry_async x = !read_all_text_retry_async x' : ()
$'let create_temp_path () = !create_temp_path ()' : ()
$'let create_temp_dir () = !create_temp_dir ()' : ()
$'let create_temp_dir\' x = !create_temp_dir' x' : ()
$'let get_source_directory () = !get_source_directory ()' : ()
$'let normalize_path x = !normalize_path x' : ()
$'let new_file_uri x = !new_file_uri x' : ()
$'let get_workspace_root () = !get_workspace_root ()' : ()
$'let init_trace_file x = !init_trace_file x' : ()
$'let link_directory x = !link_directory x' : ()
inl combine x = (</>) x
$'let (</>) x = !combine x' : ()