diff --git a/library/Fs.re b/library/Fs.re index 1ca5972..c5e114a 100644 --- a/library/Fs.re +++ b/library/Fs.re @@ -43,25 +43,39 @@ let readlink = path => | err => Lwt.return_error(err) }; -// Credit: https://github.com/fastpack/fastpack/blob/9f6aa7d5b83ffef03e73a15679200576ff9dbcb7/FastpackUtil/FS.re#L94 -let rec rmdir = dir => { - let%lwt files = Lwt_unix.files_of_directory(dir) |> Lwt_stream.to_list; - let%lwt () = - Lwt_list.iter_s( - filename => - switch (filename) { - | "." - | ".." => Lwt.return_unit - | _ => - let path = Filename.concat(dir, filename); - switch%lwt (Lwt_unix.stat(path)) { - | {st_kind: Lwt_unix.S_DIR, _} => rmdir(path) - | _ => Lwt_unix.unlink(path) - }; - }, - files, - ); - Lwt_unix.rmdir(dir); +[@deriving show] +type file_type = + | File(string) + | Dir(string); + +// Based on: https://github.com/fastpack/fastpack/blob/9f6aa7d5b83ffef03e73a15679200576ff9dbcb7/FastpackUtil/FS.re#L94 +let rec listDirRecursively = dir => { + switch%lwt (Lwt_unix.lstat(dir)) { + | {st_kind: Lwt_unix.S_DIR, _} => + Lwt_unix.files_of_directory(dir) + |> Lwt_stream.map_list_s( + fun + | "." + | ".." => Lwt.return([]) + | filename => Filename.concat(dir, filename) |> listDirRecursively, + ) + |> Lwt_stream.to_list + |> Lwt.map(xs => List.append(xs, [Dir(dir)])) + | _ => Lwt.return([File(dir)]) + | exception (Unix.Unix_error(Unix.ENOENT, _, _)) => Lwt.return([]) + }; +}; + +let rmdir = dir => { + let%lwt entities = listDirRecursively(dir); + + entities + |> Lwt_list.map_s( + fun + | Dir(dir) => Lwt_unix.rmdir(dir) + | File(file) => Lwt_unix.unlink(file), + ) + |> Lwt.map(_ => ()); }; type path = diff --git a/test/TestFnm.re b/test/TestFnm.re index 99ae29e..d9d0379 100644 --- a/test/TestFnm.re +++ b/test/TestFnm.re @@ -1,4 +1,5 @@ include SmokeTest; include TestSemver; +include TestFs; TestFramework.cli(); diff --git a/test/TestFs.re b/test/TestFs.re new file mode 100644 index 0000000..b292071 --- /dev/null +++ b/test/TestFs.re @@ -0,0 +1,61 @@ +open TestFramework; +open Fnm; + +let get_tempdir = prefix => { + Printf.sprintf( + "fnm-test-%s-%s", + prefix, + Unix.time() |> int_of_float |> string_of_int, + ) + |> Filename.concat(Filename.get_temp_dir_name()); +}; + +describe("TestSemver", ({test, describe, _}) => { + describe("listDirRecursively", ({test, _}) => { + test("list files and directories", ({expect, _}) => { + let xs = Fs.listDirRecursively("feature_tests") |> Lwt_main.run; + expect.list(xs).toContainEqual( + Fs.File("feature_tests/multishell/run.sh"), + ); + expect.list(xs).toContainEqual(Fs.Dir("feature_tests/multishell")); + expect.list(xs).toContainEqual(Fs.Dir("feature_tests")); + }); + + test("works with symlinks", ({expect, _}) => { + let tmpdir = get_tempdir("symlinks"); + let fileDir = Filename.concat(tmpdir, "a/b/c/d/e/f/g"); + let filePath = Filename.concat(fileDir, "file"); + Sys.command("mkdir -p " ++ fileDir) |> ignore; + Sys.command("touch " ++ filePath) |> ignore; + Sys.command("ln -s " ++ filePath ++ " " ++ filePath ++ "_link") + |> ignore; + Sys.command( + "ln -s " ++ filePath ++ "_not_found " ++ filePath ++ "_link_not_found", + ) + |> ignore; + + let xs = Fs.listDirRecursively(tmpdir) |> Lwt_main.run; + expect.list(xs).toContainEqual(Fs.File(filePath ++ "_link")); + expect.list(xs).toContainEqual( + Fs.File(filePath ++ "_link_not_found"), + ); + expect.list(xs).toContainEqual(Fs.File(filePath)); + expect.list(xs).toContainEqual(Fs.Dir(fileDir)); + }); + }); + + test("rmdir", ({expect, _}) => { + let tmpdir = get_tempdir("rmdir"); + let fileDir = Filename.concat(tmpdir, "a/b/c/d/e/f/g"); + let filePath = Filename.concat(fileDir, "file"); + + Sys.command("mkdir -p " ++ fileDir) |> ignore; + Sys.command("touch " ++ filePath) |> ignore; + Unix.symlink(filePath, filePath ++ "_link"); + Fs.rmdir(tmpdir) |> Lwt_main.run; + + let remainingFiles = Fs.listDirRecursively(tmpdir) |> Lwt_main.run; + + expect.list(remainingFiles).toBeEmpty(); + }); +});