Add flake input tracking

and restructure the whole codebase!

Not fully tested due to #4; theoretically resolves #1

bin/dune

@@ -1,5 +1,5 @@
 (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)
+  (libraries core core_unix core_unix.filename_unix core_unix.sys_unix ppx_yojson_conv re sha lib)
-  (preprocess (pps ppx_yojson_conv ppx_jane)))
+  (preprocess (pps ppx_yojson_conv ppx_jane)))

bin/flake_env.re

@@ -1,109 +1,17 @@
 open Core;
 module Unix = Core_unix;
 
-type version_number = {
-  major: int,
-  minor: int,
-  point: int,
-};
-
-[@deriving yojson]
-type watch = {
-  exists: bool,
-  modtime: int,
-  path: string
-};
-
-[@deriving yojson]
-type watches = array<watch>;
-
-let required_direnv_version = {
-  major: 2,
-  minor: 21,
-  point: 3
-};
-
-let required_nix_version = {
-  major: 2,
-  minor: 10,
-  point: 0
-};
-
-// TODO: test this
-let compare_version_number = (a, b) => {
-  switch (a, b) {
-  | (a, b) when a.major == b.major && a.minor == b.minor && a.point == b.point => 0
-  | (a, b) when a.major < b.major => -1
-  | (a, b) when a.major == b.major && a.minor < b.minor => -1
-  | (a, b) when a.major == b.major && a.minor == b.minor && a.point < b.point => -1
-  | _ => 1
-  }
-}
-
-let semver_re = Re.compile(Re.Posix.re({|([0-9]+)\.([0-9]+)\.([0-9]+)|}));
-
-let extract_version_number = (cmd) => {
-  let full_cmd = cmd ++ " --version";
-  switch (Core_unix.open_process_in(full_cmd) |> In_channel.input_line) {
-  | Some(stdout) => {
-      let substrings = Re.exec(semver_re, stdout);
-      let groups = Re.Group.all(substrings);
-      Ok({
-        major: groups[1] |> int_of_string,
-        minor: groups[2] |> int_of_string,
-        point: groups[3] |> int_of_string
-      })
-    }
-  | None => Error(Printf.sprintf("Failed executing '%s'", cmd))
-  }
-};
-
-let is_version_new_enough = (cur, needed) => {
-  switch (cur) {
-    | Ok(cur) => {
-        switch (compare_version_number(cur, needed)) {
-        | x when x < 0 => Ok(false)
-        | _ => Ok(true)
-        }
-      }
-    | Error(e) => Error(e)
-  }
-}
-
-let preflight_versions = () => {
-  let in_direnv = switch (Sys.getenv("direnv")) {
-    | Some(_) => true
-    | None => false
-  };
-
-  let is_nix_new_enough = is_version_new_enough(extract_version_number("nix"), required_nix_version);
-  let is_direnv_new_enough = is_version_new_enough(extract_version_number("direnv"), required_direnv_version);
-
-  switch (in_direnv, is_direnv_new_enough, is_nix_new_enough) {
-    | (false, _, _) => Error("Not in direnv!")
-    | (_, Ok(false), _) => Error("Direnv version is not new enough")
-    | (_, _, Ok(false)) => Error("Nix version is not new enough")
-    | (_, Error(e), _) => Error(e)
-    | (_, _, Error(e)) => Error(e)
-    | (true, Ok(true), Ok(true)) => Ok()
-  }
-};
 
 let preflight = (layout_directory) => {
-  switch (preflight_versions()) {
+  switch (Lib.Versions.preflight_versions(), Sys_unix.is_directory(layout_directory)) {
-  | Ok(_) => {
+    | (Ok(_), `Yes) => Ok()
-      switch (Sys_unix.is_directory(layout_directory)) {
+    | (Ok(_), _) => {
-      | `Yes => Ok()
+      Unix.mkdir_p(layout_directory);
-      | _ => {
+      Ok()
-          Unix.mkdir_p(layout_directory);
-          Ok()
-        }
-      }
     }
-  | err => err
+    | (err, _) => err
   }
-
+}
-};
 
 let hash_files = (filenames) => {
   let ctx = Sha1.init();
@@ -118,16 +26,6 @@ let hash_files = (filenames) => {
   Sha1.finalize(ctx) |> Sha1.to_hex
 };
 
-let get_watches = () => {
-  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);
-  switch (Unix.waitpid(proc_info.pid)) {
-  | Ok() => Ok(watches_of_yojson(Yojson.Safe.from_channel(sub_stdout)))
-  | _ => Error("Failed to parse watches")
-  }
-};
-
 // TODO: Maybe make this more terse?
 let rec rmrf = (path) => {
   switch (Unix.lstat(path).st_kind) {
@@ -155,19 +53,17 @@ let print_cur_cache = (profile_rc) => {
   In_channel.read_all(profile_rc) |> Printf.printf("%s")
 };
 
-let nix = (args) => {
+let add_gcroot = (store_path, symlink) => {
-  let stdout_chan = Unix.open_process_in(
+  switch (Lib.Util.nix(["build", "--out-link", symlink, store_path])) {
-    "nix --extra-experimental-features \"nix-command flakes\" " ++ (args |> String.concat(~sep=" ")))
+  | (Ok(), _) => Ok()
-    
+  | (err, _) => err
-  let stdout_content = stdout_chan |> In_channel.input_all;
+  }
-  let exit_code = Unix.close_process_in(stdout_chan);
-  (exit_code, stdout_content)
 }
 
 let freshen_cache = (layout_dir, hash, flake_specifier) => {
   clean_old_gcroots(layout_dir);
   let tmp_profile = layout_dir ++ "flake-tmp-profile."  ++ Core.Pid.to_string(Core_unix.getpid());
-  let (exit_code, stdout_content) = nix(["print-dev-env", "--profile", tmp_profile, flake_specifier]);
+  let (exit_code, stdout_content) = Lib.Util.nix(["print-dev-env", "--profile", tmp_profile, flake_specifier]);
 
   let profile = layout_dir ++ "/flake-profile-" ++ hash;
   let profile_rc = profile ++ ".rc";
@@ -175,13 +71,20 @@ let freshen_cache = (layout_dir, hash, flake_specifier) => {
   switch (exit_code) {
   | Ok() => {
       Out_channel.with_file(~f=f=> Out_channel.output_string(f, stdout_content), profile_rc);
-      // TODO: flake inputs!
+      switch (add_gcroot(tmp_profile, profile)) {
-      switch (nix(["build", "--out-link", profile, tmp_profile])) {
+        | Ok() => {
-      | (Ok(), _) => {
           Sys_unix.remove(tmp_profile);
+          let flake_input_cache_path = layout_dir ++ "/flake-inputs/"
+          let flake_inputs = Lib.Watches.get_input_paths();
+          flake_inputs |> List.iter(~f=(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));
+            };
+          });
           print_cur_cache(profile_rc);
         }
-      | (err, _) => {
+        | err => {
           Printf.eprintf("Failed creating gcroot: %s\n", Core_unix.Exit_or_signal.to_string_hum(err));
           exit(1);
         }
@@ -204,7 +107,7 @@ let main = () => {
       let layout_directory = argv[2];
       switch (preflight(layout_directory)) {
         | Ok() => {
-            switch (get_watches()) {
+            switch (Lib.Watches.get()) {
             | Ok(watches) => {
                 let paths = Array.map(~f=watch => watch.path, watches);
                 let hash = hash_files(paths);

lib/dune

@@ -0,0 +1,5 @@
+(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)
+  (preprocess (pps ppx_yojson_conv ppx_jane ppx_inline_test)))

lib/flake_env__util.re

@@ -0,0 +1,10 @@
+open Core;
+module Unix = Core_unix;
+
+let nix = (args) => {
+  let stdout_chan = Unix.open_process_in(
+    "nix --extra-experimental-features \"nix-command flakes\" " ++ (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)
+}

lib/flake_env__versions.re

@@ -0,0 +1,82 @@
+open Core;
+module Unix = Core_unix;
+
+type t = {
+  major: int,
+  minor: int,
+  point: int,
+};
+
+let semver_re = Re.compile(Re.Posix.re({|([0-9]+)\.([0-9]+)\.([0-9]+)|}));
+
+let required_direnv_version = {
+  major: 2,
+  minor: 21,
+  point: 3
+};
+
+let required_nix_version = {
+  major: 2,
+  minor: 10,
+  point: 0
+};
+
+// TODO: test this
+let compare_version_number = (a, b) => {
+  switch (a, b) {
+  | (a, b) when a.major == b.major && a.minor == b.minor && a.point == b.point => 0
+  | (a, b) when a.major < b.major => -1
+  | (a, b) when a.major == b.major && a.minor < b.minor => -1
+  | (a, b) when a.major == b.major && a.minor == b.minor && a.point < b.point => -1
+  | _ => 1
+  }
+}
+
+let%test_unit "compare_version_number" = [%test_eq: int](compare_version_number({major: 1, minor: 0, point: 0}, {major: 2, minor: 0, point: 0}), -1);
+
+let extract_version_number = (cmd) => {
+  let full_cmd = cmd ++ " --version";
+  switch (Core_unix.open_process_in(full_cmd) |> In_channel.input_line) {
+  | Some(stdout) => {
+      let substrings = Re.exec(semver_re, stdout);
+      let groups = Re.Group.all(substrings);
+      Ok({
+        major: groups[1] |> int_of_string,
+        minor: groups[2] |> int_of_string,
+        point: groups[3] |> int_of_string
+      })
+    }
+  | None => Error(Printf.sprintf("Failed executing '%s'\n", cmd))
+  }
+};
+
+let is_version_new_enough = (cur, needed) => {
+  switch (cur) {
+    | Ok(cur) => {
+        switch (compare_version_number(cur, needed)) {
+        | x when x < 0 => Ok(false)
+        | _ => Ok(true)
+        }
+      }
+    | Error(e) => Error(e)
+  }
+}
+
+let preflight_versions = () => {
+  let in_direnv = switch (Sys.getenv("direnv")) {
+    | Some(_) => true
+    | None => false
+  };
+
+  let is_nix_new_enough = is_version_new_enough(extract_version_number("nix"), required_nix_version);
+  let is_direnv_new_enough = is_version_new_enough(extract_version_number("direnv"), required_direnv_version);
+
+  switch (in_direnv, is_direnv_new_enough, is_nix_new_enough) {
+    | (false, _, _) => Error("Not in direnv!")
+    | (_, Ok(false), _) => Error("Direnv version is not new enough")
+    | (_, _, Ok(false)) => Error("Nix version is not new enough")
+    | (_, Error(e), _) => Error(e)
+    | (_, _, Error(e)) => Error(e)
+    | (true, Ok(true), Ok(true)) => Ok()
+  }
+};

lib/flake_env__watches.re

@@ -0,0 +1,48 @@
+open Core;
+open Yojson.Safe.Util;
+
+module Unix = Core_unix;
+module StringSet = Set.Make(String);
+module Util = Flake_env__util;
+
+[@deriving yojson]
+type watch = {
+  exists: bool,
+  modtime: int,
+  path: string
+};
+
+[@deriving yojson]
+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);
+
+  switch (Unix.waitpid(proc_info.pid)) {
+    | Ok() => 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 rec get_paths_from_doc = (doc, paths) => {
+  let p = get_path(doc);
+  let sub_paths = List.concat(
+    doc |> member("inputs")
+        |> to_assoc
+        |> List.map(~f=((_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) => 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");
+      []
+    }
+  }
+};

lib/lib.re

@@ -0,0 +1,3 @@
+module Util = Flake_env__util;
+module Watches = Flake_env__watches;
+module Versions = Flake_env__versions;