From 5c011429335736b8b1a5af0b9ebeb6410b834c36 Mon Sep 17 00:00:00 2001 From: Bryan Bennett Date: Mon, 12 Aug 2024 12:13:53 -0400 Subject: [PATCH] Remove dependency on Janestreet Core Core doubles the closure size and adds 8mb to the binary size for dubious benefit. This adds FileUtils to do the file interaction bits that aren't in the stdlib and removes Core in preference to the bundled Stdlib. Tests are passing, but I want to investigate the nix build before I commit to this approach --- bin/dune | 12 +--- bin/flake_env.re | 96 ++++++++++++++++---------------- default.nix | 6 +- lib/dune | 11 +--- lib/flake_env__util.re | 79 ++++++++++++++------------ lib/flake_env__versions.re | 14 +++-- lib/flake_env__watches.re | 40 +++++++------ lib/lib.re | 71 ++++++++++------------- tests/dune | 8 +-- tests/flake_env_test_util.re | 75 +++++++++---------------- tests/flake_env_test_versions.re | 4 +- 11 files changed, 184 insertions(+), 232 deletions(-) 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()); };