refactor(stdune): introduce [Env_path]

To avoid the [Env] depending on [Path]

Signed-off-by: Rudi Grinberg <[email protected]>

ps-id: ebe0f05f-9cff-4c9b-a617-508242f44830

bench/micro/dune_bench/scheduler_bench.ml

@@ -17,7 +17,7 @@ let setup =
     (Path.set_root (Path.External.cwd ());
      Path.Build.set_build_dir (Path.Outside_build_dir.of_string "_build"))
 
-let prog = Option.value_exn (Bin.which ~path:(Env.path Env.initial) "true")
+let prog = Option.value_exn (Bin.which ~path:(Env_path.path Env.initial) "true")
 
 let run () = Process.run ~env:Env.initial Strict prog []
 

otherlibs/stdune/env.ml

@@ -95,13 +95,4 @@ let of_string_map m =
 
 let iter t = Map.iteri t.vars
 
-let cons_path t ~dir =
-  make
-    (Map.update t.vars "PATH" ~f:(fun _PATH -> Some (Bin.cons_path dir ~_PATH)))
-
-let path env =
-  match get env "PATH" with
-  | None -> []
-  | Some s -> Bin.parse_path s
-
 let to_map t = t.vars

otherlibs/stdune/env.mli

@@ -48,7 +48,3 @@ val of_string_map : string String.Map.t -> t
 val to_map : t -> string Map.t
 
 val iter : t -> f:(string -> string -> unit) -> unit
-
-val cons_path : t -> dir:Path.t -> t
-
-val path : t -> Path.t list

otherlibs/stdune/env_path.ml

@@ -0,0 +1,9 @@
+let var = "PATH"
+
+let cons env ~dir =
+  Env.update env ~var ~f:(fun _PATH -> Some (Bin.cons_path dir ~_PATH))
+
+let path env =
+  match Env.get env var with
+  | None -> []
+  | Some s -> Bin.parse_path s

otherlibs/stdune/env_path.mli

@@ -0,0 +1,7 @@
+(** Handle the [PATH] environment variable. *)
+
+(* this isn't in [Env] to avoid cycles *)
+
+val cons : Env.t -> dir:Path.t -> Env.t
+
+val path : Env.t -> Path.t list

otherlibs/stdune/stdune.ml

@@ -39,6 +39,7 @@ module Fpath = Fpath
 module Univ_map = Univ_map
 module Loc = Loc
 module Env = Env
+module Env_path = Env_path
 module Proc = Proc
 module Type_eq = Type_eq
 module Nothing = Nothing

src/dune_config/dune_config.ml

@@ -401,7 +401,7 @@ let auto_concurrency =
       let rec loop = function
         | [] -> 1
         | (prog, args) :: rest -> (
-          match Bin.which ~path:(Env.path Env.initial) prog with
+          match Bin.which ~path:(Env_path.path Env.initial) prog with
           | None -> loop rest
           | Some prog -> (
             let prog = Path.to_string prog in

src/dune_engine/action_exec.ml

@@ -203,7 +203,7 @@ let exec_echo stdout_to str =
   Fiber.return (output_string (Process.Io.out_channel stdout_to) str)
 
 let bash_exn =
-  let bin = lazy (Bin.which ~path:(Env.path Env.initial) "bash") in
+  let bin = lazy (Bin.which ~path:(Env_path.path Env.initial) "bash") in
   fun ~loc ~needed_to ->
     match Lazy.force bin with
     | Some path -> path

src/dune_engine/print_diff.ml

@@ -102,7 +102,7 @@ let prepare ~skip_trailing_cr annots path1 path2 =
   in
   let normal_diff () =
     let diff =
-      let which prog = Bin.which ~path:(Env.path Env.initial) prog in
+      let which prog = Bin.which ~path:(Env_path.path Env.initial) prog in
       match which "git" with
       | Some path ->
         let dir =
@@ -158,7 +158,7 @@ let prepare ~skip_trailing_cr annots path1 path2 =
   | None -> (
     if Config.inside_dune then fallback
     else
-      match Bin.which ~path:(Env.path Env.initial) "patdiff" with
+      match Bin.which ~path:(Env_path.path Env.initial) "patdiff" with
       | None -> normal_diff ()
       | Some prog ->
         run prog

src/dune_engine/utils.ml

@@ -4,7 +4,7 @@ let system_shell_exn =
   let cmd, arg, os =
     if Sys.win32 then ("cmd", "/c", "on Windows") else ("sh", "-c", "")
   in
-  let bin = lazy (Bin.which ~path:(Env.path Env.initial) cmd) in
+  let bin = lazy (Bin.which ~path:(Env_path.path Env.initial) cmd) in
   fun ~needed_to ->
     match Lazy.force bin with
     | Some path -> (path, arg)

src/dune_engine/vcs.ml

@@ -41,7 +41,7 @@ include T
 let git, hg =
   let get prog =
     lazy
-      (match Bin.which ~path:(Env.path Env.initial) prog with
+      (match Bin.which ~path:(Env_path.path Env.initial) prog with
       | Some x -> x
       | None -> Utils.program_not_found prog ~loc:None)
   in

src/dune_file_watcher/dune_file_watcher.ml

@@ -341,7 +341,7 @@ let command ~root ~backend =
 let fswatch_backend () =
   let try_fswatch () =
     Option.map
-      (Bin.which ~path:(Env.path Env.initial) "fswatch")
+      (Bin.which ~path:(Env_path.path Env.initial) "fswatch")
       ~f:(fun fswatch -> `Fswatch fswatch)
   in
   match try_fswatch () with

src/dune_rules/context.ml

@@ -181,7 +181,7 @@ module Opam : sig
 end = struct
   let opam =
     Memo.Lazy.create ~name:"context-opam" (fun () ->
-        Bin.which ~path:(Env.path Env.initial) "opam" >>= function
+        Bin.which ~path:(Env_path.path Env.initial) "opam" >>= function
         | None -> Utils.program_not_found "opam" ~loc:None
         | Some opam -> (
           let+ version =
@@ -688,7 +688,7 @@ let extend_paths t ~env =
   let t =
     let f (var, t) =
       let parse ~loc:_ s = s in
-      let standard = Env.path env |> List.map ~f:Path.to_string in
+      let standard = Env_path.path env |> List.map ~f:Path.to_string in
       (var, Ordered_set_lang.eval t ~parse ~standard ~eq:String.equal)
     in
     List.map ~f t
@@ -706,7 +706,7 @@ let extend_paths t ~env =
 
 let default ~merlin ~env_nodes ~env ~targets ~fdo_target_exe
     ~dynamically_linked_foreign_archives ~instrument_with =
-  let path = Env.path env in
+  let path = Env_path.path env in
   create ~kind:Default ~path ~env ~env_nodes ~merlin ~targets ~fdo_target_exe
     ~dynamically_linked_foreign_archives ~instrument_with
 
@@ -724,7 +724,7 @@ let create_for_opam ~loc ~root ~env ~env_nodes ~targets ~profile ~switch ~name
       ];
   let path =
     match Env.Map.find vars "PATH" with
-    | None -> Env.path env
+    | None -> Env_path.path env
     | Some s -> Bin.parse_path s
   in
   let env = Env.extend env ~vars in

src/dune_rules/cram_exec.ml

@@ -94,7 +94,7 @@ let translate_path_for_sh =
   if not Sys.win32 then fun fn -> Fiber.return (Path.to_absolute_filename fn)
   else fun fn ->
     let cygpath =
-      let path = Env.path Env.initial in
+      let path = Env_path.path Env.initial in
       Bin.which ~path "cygpath"
     in
     match cygpath with
@@ -411,7 +411,7 @@ let run ~env ~script lexbuf : string Fiber.t =
   let open Fiber.O in
   let+ () =
     let sh =
-      let path = Env.path Env.initial in
+      let path = Env_path.path Env.initial in
       Option.value_exn (Bin.which ~path "sh")
     in
     let metadata =

src/dune_rules/env_node.ml

@@ -105,7 +105,7 @@ let make ~dir ~inherit_from ~scope ~config_stanza ~profile ~expander
         @@
         if have_binaries then
           let dir = Artifacts.Bin.local_bin dir |> Path.build in
-          Env.cons_path env ~dir
+          Env_path.cons env ~dir
         else env)
   in
   let bin_artifacts =

src/dune_stats/dune_stats.ml

@@ -144,7 +144,7 @@ module Fd_count = struct
     | This of int
 
   let lsof =
-    let prog = lazy (Bin.which ~path:(Env.path Env.initial) "lsof") in
+    let prog = lazy (Bin.which ~path:(Env_path.path Env.initial) "lsof") in
     (* note: we do not use the Process module here, because it would create a
        circular dependency *)
     fun () ->

test/blackbox-tests/test-cases/github3766.t/test.ml

@@ -20,7 +20,7 @@ let descr s f =
   res
 
 let sh =
-  let path = Env.path Env.initial in
+  let path = Env_path.path Env.initial in
   Option.value_exn (Bin.which ~path "sh")
 
 let in_dir name f =

test/expect-tests/dune_rpc_e2e/dune_rpc_e2e.ml

@@ -15,7 +15,7 @@ let () = if debug then Dune_util.Log.init ~file:(Out_channel stderr) ()
 
 let dune_prog =
   lazy
-    (let path = Env.path Env.initial in
+    (let path = Env_path.path Env.initial in
      Bin.which ~path "dune" |> Option.value_exn |> Path.to_absolute_filename)
 
 let init_chan ~root_dir =

test/expect-tests/process_tests.ml

@@ -13,7 +13,8 @@ let go =
   in
   Scheduler.Run.go config ~file_watcher:No_watcher ~on_event:(fun _ _ -> ())
 
-let true_ = Bin.which "true" ~path:(Env.path Env.initial) |> Option.value_exn
+let true_ =
+  Bin.which "true" ~path:(Env_path.path Env.initial) |> Option.value_exn
 
 let%expect_test "null input" =
   let stdin_from = Process.(Io.null In) in

test/expect-tests/scheduler_tests.ml

@@ -18,7 +18,8 @@ let go ?(timeout = 0.3) ?(config = default) f =
       f
   with Scheduler.Run.Shutdown.E Requested -> ()
 
-let true_ = Bin.which "true" ~path:(Env.path Env.initial) |> Option.value_exn
+let true_ =
+  Bin.which "true" ~path:(Env_path.path Env.initial) |> Option.value_exn
 
 let cell = Memo.lazy_cell Memo.return