diff --git a/bin/dune b/bin/dune index 186c456..4430073 100644 --- a/bin/dune +++ b/bin/dune @@ -1,14 +1,6 @@ (executable (name flake_env) (public_name flake_env) - (libraries - core - core_unix - core_unix.filename_unix - core_unix.sys_unix - ppx_yojson_conv - re - sha - lib) + (libraries lib ppx_yojson_conv re sha) (preprocess - (pps ppx_yojson_conv ppx_jane))) + (pps ppx_yojson_conv))) diff --git a/bin/flake_env.re b/bin/flake_env.re index 1c147a3..1fb7b5a 100644 --- a/bin/flake_env.re +++ b/bin/flake_env.re @@ -1,64 +1,62 @@ -open Core; -module Unix = Core_unix; - open Lib; let main = () => { - let argv = Sys.get_argv(); - switch (Util.get_args(argv)) { - | Ok((layout_directory, flake_specifier, other_args)) => - switch (preflight(layout_directory)) { - | Ok () => - switch (Lib.Watches.get()) { - | Ok(watches) => - let paths = Array.map(~f=watch => watch.path, watches); - let hash = - switch (Util.hash_files(paths)) { - | Ok(hsh) => hsh - | Error(msg) => - Printf.eprintf("%s\n", msg); - exit(1); - }; + Lib.Watches.( + switch (Util.get_args(Sys.argv)) { + | Ok((layout_directory, flake_specifier, other_args)) => + switch (preflight(layout_directory)) { + | Ok () => + switch (Lib.Watches.get()) { + | Ok(watches) => + let paths = Array.map(watch => watch.path, watches); + let hash = + switch (Util.hash_files(paths)) { + | Ok(hsh) => hsh + | Error(msg) => + Printf.eprintf("%s\n", msg); + exit(1); + }; - let profile = layout_directory ++ "/flake-profile-" ++ hash; - let profile_rc = profile ++ ".rc"; + let profile = layout_directory ++ "/flake-profile-" ++ hash; + let profile_rc = profile ++ ".rc"; - switch (Sys_unix.is_file(profile_rc), Sys_unix.is_file(profile)) { - | (`Yes, `Yes) => - let profile_rc_mtime = Unix.stat(profile_rc).st_mtime; - let all_older = - Array.map(~f=watch => watch.modtime, watches) - |> Array.for_all(~f=watch_mtime => - watch_mtime <= int_of_float(profile_rc_mtime) - ); - if (all_older) { - print_cur_cache(profile_rc); - } else { - freshen_cache( - layout_directory, - hash, - flake_specifier, - other_args, - ); + switch (Lib.Util.is_file(profile_rc), Lib.Util.is_file(profile)) { + | (true, true) => + let profile_rc_mtime = Unix.stat(profile_rc).st_mtime; + let all_older = + Array.map(watch => watch.modtime, watches) + |> Array.for_all(watch_mtime => + watch_mtime <= int_of_float(profile_rc_mtime) + ); + if (all_older) { + print_cur_cache(profile_rc); + } else { + freshen_cache( + layout_directory, + hash, + flake_specifier, + other_args, + ); + }; + | _ => + freshen_cache(layout_directory, hash, flake_specifier, other_args) }; - | _ => - freshen_cache(layout_directory, hash, flake_specifier, other_args) - }; + | Error(e) => + Printf.eprintf("%s\n", e); + exit(1); + } | Error(e) => Printf.eprintf("%s\n", e); exit(1); } - | Error(e) => - Printf.eprintf("%s\n", e); + | Error () => + Printf.eprintf( + "%s <...args>\n", + Sys.argv[0], + ); exit(1); } - | Error () => - Printf.eprintf( - "%s <...args>\n", - argv[0], - ); - exit(1); - }; + ); }; let () = main(); diff --git a/default.nix b/default.nix index 9f3d381..a29b816 100644 --- a/default.nix +++ b/default.nix @@ -2,8 +2,7 @@ , bintools , bisect_ppx , buildDunePackage -, core -, core_unix +, fileutils , lib , nix-filter , ppx_yojson_conv @@ -51,8 +50,7 @@ buildDunePackage { install -m444 -D direnvrc $out/share/flake_env/direnvrc ''; buildInputs = [ - core - core_unix + fileutils ppx_yojson_conv ppx_yojson_conv_lib re diff --git a/lib/dune b/lib/dune index 168d405..80d3a26 100644 --- a/lib/dune +++ b/lib/dune @@ -1,15 +1,8 @@ (library (name lib) (public_name flake_env.lib) - (libraries - core - core_unix - core_unix.filename_unix - core_unix.sys_unix - ppx_yojson_conv - re - sha) + (libraries fileutils ppx_yojson_conv re sha) (instrumentation (backend bisect_ppx)) (preprocess - (pps ppx_yojson_conv ppx_jane))) + (pps ppx_yojson_conv))) diff --git a/lib/flake_env__util.re b/lib/flake_env__util.re index 454870d..fbd899c 100644 --- a/lib/flake_env__util.re +++ b/lib/flake_env__util.re @@ -1,10 +1,8 @@ -open Core; -module Unix = Core_unix; - +// TODO: Make this more robust to failure by returning stderr content too /*** Run a process [name] with args [args], returning (exit_code, stdout text) */ let run_process = (name, args) => { let stdout_chan = - Unix.open_process_in(name ++ " " ++ (args |> String.concat(~sep=" "))); + Unix.open_process_in(name ++ " " ++ (args |> String.concat(" "))); let stdout_content = stdout_chan |> In_channel.input_all; let exit_code = Unix.close_process_in(stdout_chan); (exit_code, stdout_content); @@ -17,6 +15,28 @@ let nix = args => ["--extra-experimental-features", "\"nix-command flakes\" ", ...args], ); +let is_file = pth => { + switch (FileUtil.stat(pth)) { + | exception (FileUtil.FileDoesntExist(_)) => false + | stat => + switch (stat.kind) { + | File => true + | _ => false + } + }; +}; + +let is_directory = pth => { + switch (FileUtil.stat(pth)) { + | exception (FileUtil.FileDoesntExist(_)) => false + | stat => + switch (stat.kind) { + | Dir => true + | _ => false + } + }; +}; + let hash_files = filenames => { /*** Hash all entries in [filenames] which represent existing files. Returns Some(hex-string) or None if no filenames are found. @@ -24,27 +44,28 @@ let hash_files = filenames => { let ctx = Sha1.init(); let files_to_hash = filenames - |> Array.filter(~f=f => - switch (Sys_unix.file_exists(f)) { - | `Yes => true - | _ => - Printf.eprintf( - "Cannot find file %s (cwd: %s)\n", - f, - Core_unix.getcwd(), - ); - false; - } + |> Array.to_list + |> List.filter(f => + Sys.file_exists(f) + ? true + : { + Printf.eprintf( + "Cannot find file %s (cwd: %s)\n", + f, + Sys.getcwd(), + ); + false; + } ); - switch (files_to_hash |> Array.length) { + switch (files_to_hash |> List.length) { | 0 => Error("No files found to hash") | _ => let () = files_to_hash - |> Array.iter(~f=f => { + |> List.iter(f => { f - |> In_channel.create + |> In_channel.open_bin |> In_channel.input_all |> Sha1.update_string(ctx) }); @@ -52,29 +73,13 @@ let hash_files = filenames => { }; }; -let rec rmrf = path => { - /*** Remove [path] recursively */ - switch (Unix.lstat(path).st_kind) { - | exception (Unix.Unix_error(_, _, _)) => () - | S_REG - | S_LNK => Unix.unlink(path) - | S_DIR => - Sys_unix.readdir(path) - |> Array.iter(~f=name => rmrf(Filename.concat(path, name))); - Unix.rmdir(path); - | _ => - Printf.eprintf( - "Unsupported file type (Chr or Block device, FIFO, or Socket)\n", - ) - }; -}; - let get_args = argv => { - switch (Array.length(argv)) { + let argc = Array.length(argv); + switch (argc) { | x when x >= 3 => let layout_directory = argv[1]; let flake_specifier = argv[2]; - let other_args = snd(List.split_n(List.of_array(argv), 3)); + let other_args = Array.sub(argv, 3, argc - 3) |> Array.to_list; Ok((layout_directory, flake_specifier, other_args)); | _ => Error() }; diff --git a/lib/flake_env__versions.re b/lib/flake_env__versions.re index a74c98f..f55ec17 100644 --- a/lib/flake_env__versions.re +++ b/lib/flake_env__versions.re @@ -1,6 +1,3 @@ -open Core; -module Unix = Core_unix; - module Util = Flake_env__util; type t = { @@ -33,7 +30,7 @@ let compare = (a, b) => { let extract_version_number = cmd => { switch (Util.run_process(cmd, ["--version"])) { - | (Ok (), stdout) when String.length(stdout) > 0 => + | (WEXITED(0), stdout) when String.length(stdout) > 0 => switch (Re.exec(semver_re, stdout)) { | exception Stdlib.Not_found => Error( @@ -66,9 +63,14 @@ let is_new_enough = (cur, needed) => { }; let in_direnv = () => + /* direnv sets `$direnv` to the executable's full path + If it is empty - we're running tests (ocaml's stdlib doesn't offer unsetenv...) + If it isn't found, we're running outside direnv + */ switch (Sys.getenv("direnv")) { - | Some(_) => true - | None => false + | exception Not_found => false + | "" => false + | _ => true }; let preflight_versions = () => { diff --git a/lib/flake_env__watches.re b/lib/flake_env__watches.re index 5f0ee3e..cabfdfc 100644 --- a/lib/flake_env__watches.re +++ b/lib/flake_env__watches.re @@ -1,7 +1,5 @@ -open Core; open Yojson.Safe.Util; -module Unix = Core_unix; module StringSet = Set.Make(String); module Util = Flake_env__util; @@ -16,24 +14,30 @@ type watch = { type watches = array(watch); let get = () => { - let direnv_watch_str = - Sys.getenv("DIRENV_WATCHES") - |> Option.value_exn(~message="Environment missing DIRENV_WATCHES"); - let proc_info = - Unix.create_process( - ~prog="direnv", - ~args=["show_dump", direnv_watch_str], - ); - let sub_stdout = Unix.in_channel_of_descr(proc_info.stdout); + let direnv_watch_str = Sys.getenv("DIRENV_WATCHES"); - switch (Unix.waitpid(proc_info.pid)) { - | Ok () => Ok(watches_of_yojson(Yojson.Safe.from_channel(sub_stdout))) + let (read_p, write_p) = Unix.pipe(); + let pid = + Unix.create_process( + "direnv", + [|"direnv", "show_dump", direnv_watch_str|], + Unix.stdin, + write_p, + Unix.stderr, + ); + let sub_stdout = Unix.in_channel_of_descr(read_p); + + switch (Unix.waitpid([], pid)) { + | (reported_pid, WEXITED(0)) when reported_pid == pid => + Ok(watches_of_yojson(Yojson.Safe.from_channel(sub_stdout))) | _ => Error("Failed to parse watches") }; }; -let get_path = doc => - String.drop_prefix(doc |> member("path") |> to_string, 11); +let get_path = doc => { + let pth = doc |> member("path") |> to_string; + String.sub(pth, 11, String.length(pth) - 11); +}; let rec get_paths_from_doc = (doc, paths) => { let p = get_path(doc); @@ -42,16 +46,16 @@ let rec get_paths_from_doc = (doc, paths) => { doc |> member("inputs") |> to_assoc - |> List.map(~f=((_k, v)) => get_paths_from_doc(v, paths)), + |> List.map(((_k, v)) => get_paths_from_doc(v, paths)), ); List.concat([[p], sub_paths]); }; let get_input_paths = () => { switch (Util.nix(["flake", "archive", "--json", "--no-write-lock-file"])) { - | (Ok (), output) => + | (WEXITED(0), output) => get_paths_from_doc(Yojson.Safe.from_string(output), []) - | (Error(_), _) => + | _ => Printf.eprintf( "Failed to parse output of `nix flake archive --json`. Ignorning flake inputs. \n", ); diff --git a/lib/lib.re b/lib/lib.re index e411503..acee4e7 100644 --- a/lib/lib.re +++ b/lib/lib.re @@ -1,33 +1,34 @@ -open Core; -module Unix = Core_unix; - module Util = Flake_env__util; module Watches = Flake_env__watches; module Versions = Flake_env__versions; +let read_file = f_path => + In_channel.with_open_bin(f_path, In_channel.input_all); +let write_file = (f_path, content) => + Out_channel.with_open_bin(f_path, c => + Out_channel.output_string(c, content) + ); + let print_cur_cache = profile_rc => { - In_channel.read_all(profile_rc) |> Printf.printf("%s"); + read_file(profile_rc) |> Printf.printf("%s"); }; let clean_old_gcroots = layout_dir => { - Util.rmrf(layout_dir ++ "/flake-inputs/"); - Util.rmrf(layout_dir); - Unix.mkdir_p(layout_dir ++ "/flake-inputs/"); + FileUtil.rm([layout_dir], ~recurse=true); + FileUtil.mkdir(~parent=true, layout_dir ++ "/flake-inputs/"); }; let add_gcroot = (store_path, symlink) => { switch (Util.nix(["build", "--out-link", symlink, store_path])) { - | (Ok (), _) => Ok() - | (err, _) => err + | (WEXITED(0), _) => Ok() + | (_, _) => Error("Failed to run `nix build`!") }; }; let freshen_cache = (layout_dir, hash, flake_specifier, other_args) => { - clean_old_gcroots(layout_dir); + let () = clean_old_gcroots(layout_dir); let tmp_profile = - layout_dir - ++ "flake-tmp-profile." - ++ Core.Pid.to_string(Core_unix.getpid()); + layout_dir ++ "flake-tmp-profile." ++ string_of_int(Unix.getpid()); let pde_args = [ "print-dev-env", @@ -42,54 +43,40 @@ let freshen_cache = (layout_dir, hash, flake_specifier, other_args) => { let profile_rc = profile ++ ".rc"; switch (exit_code) { - | Ok () => - Out_channel.with_file( - ~f=f => Out_channel.output_string(f, stdout_content), - profile_rc, - ); + | WEXITED(0) => + write_file(profile_rc, stdout_content); + switch (add_gcroot(tmp_profile, profile)) { | Ok () => - Sys_unix.remove(tmp_profile); + let () = FileUtil.rm([tmp_profile]); let flake_input_cache_path = layout_dir ++ "/flake-inputs/"; let flake_inputs = Watches.get_input_paths(); flake_inputs - |> List.iter(~f=inpt => { + |> List.iter(inpt => { switch ( add_gcroot("/nix/store/" ++ inpt, flake_input_cache_path ++ inpt) ) { | Ok () => () - | err => - Printf.eprintf( - "Failed creating flake-input gcroot: %s\n", - Core_unix.Exit_or_signal.to_string_hum(err), - ) + | Error(err) => + Printf.eprintf("Failed creating flake-input gcroot: %s\n", err) } }); print_cur_cache(profile_rc); - | err => - Printf.eprintf( - "Failed creating gcroot: %s\n", - Core_unix.Exit_or_signal.to_string_hum(err), - ); + | Error(err) => + Printf.eprintf("Failed creating gcroot: %s\n", err); exit(1); }; - | err => - Printf.eprintf( - "Failed evaluating flake: %s\n", - Core_unix.Exit_or_signal.to_string_hum(err), - ); + | _ => + Printf.eprintf("Failed evaluating flake\n"); exit(1); }; }; let preflight = layout_directory => { - switch ( - Versions.preflight_versions(), - Sys_unix.is_directory(layout_directory), - ) { - | (Ok(_), `Yes) => Ok() - | (Ok(_), _) => - Unix.mkdir_p(layout_directory); + switch (Versions.preflight_versions(), Util.is_directory(layout_directory)) { + | (Ok(_), true) => Ok() + | (Ok(_), false) => + FileUtil.mkdir(~parent=true, layout_directory); Ok(); | (err, _) => err }; diff --git a/tests/dune b/tests/dune index dce3e4c..254adf2 100644 --- a/tests/dune +++ b/tests/dune @@ -1,10 +1,4 @@ (tests (names flake_env_test_versions flake_env_test_watches flake_env_test_util) (deps spit_version.sh spit_gibberish.sh) - (libraries - lib - alcotest - core - core_unix - core_unix.sys_unix - core_unix.filename_unix)) + (libraries lib alcotest)) diff --git a/tests/flake_env_test_util.re b/tests/flake_env_test_util.re index dd4b889..3dc691c 100644 --- a/tests/flake_env_test_util.re +++ b/tests/flake_env_test_util.re @@ -1,21 +1,32 @@ -open Core; -module Unix = Core_unix; - open Lib.Util; +open Unix; -let _pp_exit_or_signal = (pp_fmt, e) => - Fmt.pf(pp_fmt, "%s", Unix.Exit_or_signal.to_string_hum(e)); -let _exit_or_signal_eq = (a, b) => Unix.Exit_or_signal.compare(a, b) == 0; -let testable_exit_or_signal = - Alcotest.testable(_pp_exit_or_signal, _exit_or_signal_eq); +let _pp_process_status = (pp_fmt, proc_stat) => + switch (proc_stat) { + | WEXITED(i) => Fmt.pf(pp_fmt, "Exited normally with status %d", i) + | WSIGNALED(i) => Fmt.pf(pp_fmt, "Killed by signal %d", i) + | WSTOPPED(i) => Fmt.pf(pp_fmt, "Stopped by signal %d", i) + }; + +let _process_status_eq = (a, b) => { + switch (a, b) { + | (WEXITED(a_i), WEXITED(b_i)) when a_i == b_i => true + | (WSIGNALED(a_i), WSIGNALED(b_i)) when a_i == b_i => true + | (WSTOPPED(a_i), WSTOPPED(b_i)) when a_i == b_i => true + | _ => false + }; +}; + +let testable_process_status = + Alcotest.testable(_pp_process_status, _process_status_eq); let _syst_to_bool = fun | `Yes => true | _ => false; -let check_exit_or_signal = - Alcotest.(check(Alcotest.pair(testable_exit_or_signal, string))); +let check_process_status = + Alcotest.(check(Alcotest.pair(testable_process_status, string))); let testable_result_string = Alcotest.testable( (pp_fmt, elem) => { @@ -32,7 +43,6 @@ let testable_result_string = }, ); let check_result_string = Alcotest.(check(testable_result_string)); -let check_bool = Alcotest.(check(bool)); let check_get_args = Alcotest.( check( @@ -41,23 +51,23 @@ let check_get_args = ); let test_run_process_success = () => - check_exit_or_signal( + check_process_status( "Returns expected", - (Ok(), ""), + (WEXITED(0), ""), run_process("true", []), ); let test_run_process_failure = () => - check_exit_or_signal( + check_process_status( "Returns expected", - (Error(`Exit_non_zero(1)), ""), + (WEXITED(1), ""), run_process("false", []), ); let test_run_process_stdout = () => - check_exit_or_signal( + check_process_status( "Returns expected", - (Ok(), "echoed\n"), + (WEXITED(0), "echoed\n"), run_process("echo", ["echoed"]), ); @@ -85,30 +95,6 @@ let test_hash_filters_nonexistent = () => { ); }; -let test_rmrf_file = () => { - let tmp_file_name = Filename_unix.temp_file("test", "txt"); - rmrf(tmp_file_name); - - check_bool( - "File removed", - false, - _syst_to_bool(Sys_unix.is_file(tmp_file_name)), - ); -}; - -let test_rmrf_dir = () => { - let temp_dir_name = Filename_unix.temp_dir("test", "d"); - let _ = Filename_unix.temp_file(~in_dir=temp_dir_name, "test", "txt"); - - rmrf(temp_dir_name); - - check_bool( - "File removed", - false, - _syst_to_bool(Sys_unix.file_exists(temp_dir_name)), - ); -}; - let test_get_args_simple = () => { check_get_args( "Parses successfully", @@ -158,13 +144,6 @@ let () = ), ], ), - ( - "rmrf helper", - [ - test_case("Removes file", `Quick, test_rmrf_file), - test_case("Removes dir", `Quick, test_rmrf_dir), - ], - ), ( "get_args", [ diff --git a/tests/flake_env_test_versions.re b/tests/flake_env_test_versions.re index ad90ff5..7b39ec8 100644 --- a/tests/flake_env_test_versions.re +++ b/tests/flake_env_test_versions.re @@ -78,12 +78,12 @@ let test_ine_error = () => { }; let test_in_direnv_true = () => { - Core_unix.putenv(~key="direnv", ~data="direnv"); + Unix.putenv("direnv", "direnv"); Alcotest.(check(bool))("In direnv", true, Versions.in_direnv()); }; let test_in_direnv_false = () => { - Core_unix.unsetenv("direnv"); + Unix.putenv("direnv", ""); Alcotest.(check(bool))("Not in direnv", false, Versions.in_direnv()); };