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
This commit is contained in:
Bryan Bennett 2024-08-12 12:13:53 -04:00
parent 3f5f7a602d
commit 5c01142933
No known key found for this signature in database
GPG key ID: EE149E4215408DE9
11 changed files with 184 additions and 232 deletions

View file

@ -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)))

View file

@ -1,17 +1,14 @@
open Core;
module Unix = Core_unix;
open Lib;
let main = () => {
let argv = Sys.get_argv();
switch (Util.get_args(argv)) {
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(~f=watch => watch.path, watches);
let paths = Array.map(watch => watch.path, watches);
let hash =
switch (Util.hash_files(paths)) {
| Ok(hsh) => hsh
@ -23,12 +20,12 @@ let main = () => {
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) =>
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(~f=watch => watch.modtime, watches)
|> Array.for_all(~f=watch_mtime =>
Array.map(watch => watch.modtime, watches)
|> Array.for_all(watch_mtime =>
watch_mtime <= int_of_float(profile_rc_mtime)
);
if (all_older) {
@ -55,10 +52,11 @@ let main = () => {
| Error () =>
Printf.eprintf(
"%s <layout_directory> <flake specifier> <...args>\n",
argv[0],
Sys.argv[0],
);
exit(1);
};
}
);
};
let () = main();

View file

@ -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

View file

@ -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)))

View file

@ -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
| _ =>
|> Array.to_list
|> List.filter(f =>
Sys.file_exists(f)
? true
: {
Printf.eprintf(
"Cannot find file %s (cwd: %s)\n",
f,
Core_unix.getcwd(),
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()
};

View file

@ -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 = () => {

View file

@ -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",
);

View file

@ -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
};

View file

@ -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))

View file

@ -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",
[

View file

@ -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());
};