Make dev-tools aware of context name to lock in right place

Author: Leonidas-from-XIV

bin/fmt.ml

@@ -13,7 +13,7 @@ let man =
   ]
 ;;
 
-let lock_ocamlformat () =
+let lock_ocamlformat ctx_name =
   if Lazy.force Lock_dev_tool.is_enabled
   then
     (* Note that generating the ocamlformat lockdir here means
@@ -22,15 +22,23 @@ let lock_ocamlformat () =
        this logic remain outside of `dune build`, as `dune
        build` is intended to only build targets, and generating
        a lockdir is not building a target. *)
-    Lock_dev_tool.lock_dev_tool Ocamlformat |> Memo.run
-  else Fiber.return ()
+    (* TODO: adjust the above comment as with this PR it is no
+       longer true *)
+    Action_builder.of_memo (Lock_dev_tool.lock_dev_tool ctx_name Ocamlformat)
+  else Action_builder.return ()
 ;;
 
 let run_fmt_command ~(common : Common.t) ~config =
   let open Fiber.O in
   let once () =
-    let* () = lock_ocamlformat () in
     let request (setup : Import.Main.build_system) =
+      let ctx_name =
+        setup.contexts
+        |> List.find_exn ~f:(fun ctx -> ctx |> Context.name |> Context_name.is_default)
+        |> Context.name
+      in
+      let open Action_builder.O in
+      let* () = lock_ocamlformat ctx_name in
       let dir = Path.(relative root) (Common.prefix_target common ".") in
       Alias.in_dir ~name:Dune_rules.Alias.fmt ~recursive:true ~contexts:setup.contexts dir
       |> Alias.request

bin/lock_dev_tool.ml

@@ -66,7 +66,7 @@ let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version ~extra_depe
   }
 ;;
 
-let solve ~dev_tool ~local_packages =
+let solve ctx_name ~dev_tool ~local_packages =
   let open Memo.O in
   let* solver_env_from_current_system =
     Pkg_common.poll_solver_env_from_current_system ()
@@ -79,7 +79,7 @@ let solve ~dev_tool ~local_packages =
       Workspace.add_repo workspace Dune_pkg.Pkg_workspace.Repository.binary_packages
     | `Disabled -> workspace
   in
-  let lock_dir = Lock_dir.dev_tool_lock_dir_path dev_tool in
+  let lock_dir = Lock_dir.dev_tool_lock_dir_path ctx_name dev_tool in
   Memo.of_reproducible_fiber
   @@ Lock.solve
        workspace
@@ -171,9 +171,9 @@ let extra_dependencies dev_tool =
     [ constraint_ ]
 ;;
 
-let lockdir_status dev_tool =
+let lockdir_status ctx_name dev_tool =
   let open Memo.O in
-  let dev_tool_lock_dir = Lock_dir.dev_tool_lock_dir_path dev_tool in
+  let dev_tool_lock_dir = Lock_dir.dev_tool_lock_dir_path ctx_name dev_tool in
   match Lock_dir.read_disk dev_tool_lock_dir with
   | Error _ -> Memo.return `No_lockdir
   | Ok { packages; _ } ->
@@ -205,14 +205,14 @@ let lockdir_status dev_tool =
                   ]))))
 ;;
 
-(* [lock_dev_tool_at_version dev_tool version] generates the lockdir for the
-   dev tool [dev_tool]. If [version] is [Some v] then version [v] of the tool
-   will be chosen by the solver. Otherwise the solver is free to choose the
-   appropriate version of the tool to install. *)
-let lock_dev_tool_at_version dev_tool version =
+(* [lock_dev_tool_at_version ctx_name dev_tool version] generates the lockdir
+   for the dev tool [dev_tool]. If [version] is [Some v] then version [v] of
+   the tool will be chosen by the solver. Otherwise the solver is free to
+   choose the appropriate version of the tool to install. *)
+let lock_dev_tool_at_version ctx_name dev_tool version =
   let open Memo.O in
   let* need_to_solve =
-    lockdir_status dev_tool
+    lockdir_status ctx_name dev_tool
     >>| function
     | `Lockdir_ok -> false
     | `No_lockdir -> true
@@ -238,17 +238,17 @@ let lock_dev_tool_at_version dev_tool version =
         ~extra_dependencies
     in
     let local_packages = Package_name.Map.singleton local_pkg.name local_pkg in
-    solve ~dev_tool ~local_packages
+    solve ctx_name ~dev_tool ~local_packages
   else Memo.return ()
 ;;
 
-let lock_ocamlformat () =
+let lock_ocamlformat ctx_name () =
   let version = Dune_pkg.Ocamlformat.version_of_current_project's_ocamlformat_config () in
-  lock_dev_tool_at_version Ocamlformat version
+  lock_dev_tool_at_version ctx_name Ocamlformat version
 ;;
 
-let lock_dev_tool dev_tool =
+let lock_dev_tool ctx_name dev_tool =
   match (dev_tool : Dune_pkg.Dev_tool.t) with
-  | Ocamlformat -> lock_ocamlformat ()
-  | other -> lock_dev_tool_at_version other None
+  | Ocamlformat -> lock_ocamlformat ctx_name ()
+  | other -> lock_dev_tool_at_version ctx_name other None
 ;;

bin/lock_dev_tool.mli

@@ -1,4 +1,4 @@
 open! Import
 
 val is_enabled : bool Lazy.t
-val lock_dev_tool : Dune_pkg.Dev_tool.t -> unit Memo.t
+val lock_dev_tool : Context_name.t -> Dune_pkg.Dev_tool.t -> unit Memo.t

bin/ocaml/doc.ml

@@ -13,29 +13,28 @@ let man =
 
 let info = Cmd.info "doc" ~doc ~man
 
-let lock_odoc_if_dev_tool_enabled () =
+let lock_odoc_if_dev_tool_enabled ctx_name =
   match Lazy.force Lock_dev_tool.is_enabled with
   | false -> Action_builder.return ()
-  | true -> Action_builder.of_memo (Lock_dev_tool.lock_dev_tool Odoc)
+  | true -> Action_builder.of_memo (Lock_dev_tool.lock_dev_tool ctx_name Odoc)
 ;;
 
 let term =
   let+ builder = Common.Builder.term in
   let common, config = Common.init builder in
   let request (setup : Main.build_system) =
     let dir = Path.(relative root) (Common.prefix_target common ".") in
+    let is_default ctx = ctx |> Context.name |> Dune_engine.Context_name.is_default in
+    let doc_ctx = List.find_exn setup.contexts ~f:is_default in
+    let ctx_name = Context.name doc_ctx in
     let open Action_builder.O in
-    let* () = lock_odoc_if_dev_tool_enabled () in
+    let* () = lock_odoc_if_dev_tool_enabled ctx_name in
     let+ () =
       Alias.in_dir ~name:Dune_rules.Alias.doc ~recursive:true ~contexts:setup.contexts dir
       |> Alias.request
     in
     let relative_toplevel_index_path =
-      let toplevel_index_path =
-        let is_default ctx = ctx |> Context.name |> Dune_engine.Context_name.is_default in
-        let doc_ctx = List.find_exn setup.contexts ~f:is_default in
-        Dune_rules.Odoc.Paths.toplevel_index doc_ctx
-      in
+      let toplevel_index_path = Dune_rules.Odoc.Paths.toplevel_index doc_ctx in
       Path.(toplevel_index_path |> build |> to_string_maybe_quoted)
     in
     Console.print

bin/ocaml/utop.ml

@@ -12,10 +12,10 @@ let man =
 
 let info = Cmd.info "utop" ~doc ~man
 
-let lock_utop_if_dev_tool_enabled () =
+let lock_utop_if_dev_tool_enabled ctx_name =
   match Lazy.force Lock_dev_tool.is_enabled with
   | false -> Memo.return ()
-  | true -> Lock_dev_tool.lock_dev_tool Utop
+  | true -> Lock_dev_tool.lock_dev_tool ctx_name Utop
 ;;
 
 let term =
@@ -50,7 +50,7 @@ let term =
             [ Pp.textf "no library is defined in %s" (String.maybe_quoted dir) ]
         | true ->
           let* () = Build_system.build_file utop_exe in
-          let* () = lock_utop_if_dev_tool_enabled () in
+          let* () = lock_utop_if_dev_tool_enabled ctx_name in
           let* lock_dir_enabled = Dune_rules.Lock_dir.enabled in
           let* () =
             if lock_dir_enabled

bin/tools/tools_common.ml

@@ -26,16 +26,16 @@ let build_dev_tool_via_rpc dev_tool =
   Build.build_via_rpc_server ~print_on_success:false ~targets:[ target ]
 ;;
 
-let lock_and_build_dev_tool ~common ~config dev_tool =
+let lock_and_build_dev_tool ctx_name ~common ~config dev_tool =
   let open Fiber.O in
   match Dune_util.Global_lock.lock ~timeout:None with
   | Error _lock_held_by ->
     Scheduler.go_without_rpc_server ~common ~config (fun () ->
-      let* () = Lock_dev_tool.lock_dev_tool dev_tool |> Memo.run in
+      let* () = Lock_dev_tool.lock_dev_tool ctx_name dev_tool |> Memo.run in
       build_dev_tool_via_rpc dev_tool)
   | Ok () ->
     Scheduler.go_with_rpc_server ~common ~config (fun () ->
-      let* () = Lock_dev_tool.lock_dev_tool dev_tool |> Memo.run in
+      let* () = Lock_dev_tool.lock_dev_tool ctx_name dev_tool |> Memo.run in
       build_dev_tool_directly common dev_tool)
 ;;
 
@@ -50,8 +50,8 @@ let run_dev_tool workspace_root dev_tool ~args =
   restore_cwd_and_execve workspace_root exe_path_string args Env.initial
 ;;
 
-let lock_build_and_run_dev_tool ~common ~config dev_tool ~args =
-  lock_and_build_dev_tool ~common ~config dev_tool;
+let lock_build_and_run_dev_tool ctx_name ~common ~config dev_tool ~args =
+  lock_and_build_dev_tool ctx_name ~common ~config dev_tool;
   run_dev_tool (Common.root common) dev_tool ~args
 ;;
 
@@ -92,9 +92,10 @@ let which_command dev_tool =
 let install_command dev_tool =
   let exe_name = Pkg_dev_tool.exe_name dev_tool in
   let term =
-    let+ builder = Common.Builder.term in
+    let+ builder = Common.Builder.term
+    and+ ctx_name = Common.context_arg ~doc:"Build context to use." in
     let common, config = Common.init builder in
-    lock_and_build_dev_tool ~common ~config dev_tool
+    lock_and_build_dev_tool ctx_name ~common ~config dev_tool
   in
   let info =
     let doc = sprintf "Install %s as a dev tool" exe_name in
@@ -107,9 +108,10 @@ let exec_command dev_tool =
   let exe_name = Pkg_dev_tool.exe_name dev_tool in
   let term =
     let+ builder = Common.Builder.term
+    and+ ctx_name = Common.context_arg ~doc:"Build_context to use."
     and+ args = Arg.(value & pos_all string [] (info [] ~docv:"ARGS")) in
     let common, config = Common.init builder in
-    lock_build_and_run_dev_tool ~common ~config dev_tool ~args
+    lock_build_and_run_dev_tool ctx_name ~common ~config dev_tool ~args
   in
   let info =
     let doc =

bin/tools/tools_common.mli

@@ -4,7 +4,8 @@ open! Import
     tool. If a step is unnecessary then it is skipped. This function does not
     return, but starts running the dev tool in place of the current process. *)
 val lock_build_and_run_dev_tool
-  :  common:Common.t
+  :  Context_name.t
+  -> common:Common.t
   -> config:Dune_config_file.Dune_config.t
   -> Dune_pkg.Dev_tool.t
   -> args:string list

src/dune_pkg/lock_dir.ml

@@ -1085,11 +1085,14 @@ let create_latest_version
 ;;
 
 let dev_tool_locks_name = "dev-tools.locks"
-let dev_tools_path = Path.Build.(relative root dev_tool_locks_name)
 
-let dev_tool_lock_dir_path dev_tool =
+let dev_tools_path ctx_name =
+  Path.Build.relative (Dune_engine.Context_name.build_dir ctx_name) dev_tool_locks_name
+;;
+
+let dev_tool_lock_dir_path ctx_name dev_tool =
   Path.Build.relative
-    dev_tools_path
+    (dev_tools_path ctx_name)
     (Package_name.to_string (Dev_tool.package_name dev_tool))
 ;;
 

src/dune_pkg/lock_dir.mli

@@ -130,7 +130,7 @@ val create_latest_version
 
 (** Returns the path to the lockdir that will be used to lock the
     given dev tool *)
-val dev_tool_lock_dir_path : Dev_tool.t -> Path.Build.t
+val dev_tool_lock_dir_path : Dune_engine.Context_name.t -> Dev_tool.t -> Path.Build.t
 
 (** Temporary hack to get the path of a dev tool lock directory in the source
     tree. Future versions will probably handle this differently and this

src/dune_rules/fetch_rules.ml

@@ -188,7 +188,9 @@ let find_checksum, find_url =
           Dune_pkg.Dev_tool.all
           ~init:(Checksum.Map.empty, Digest.Map.empty)
           ~f:(fun acc dev_tool ->
-            Lock_dir.of_dev_tool dev_tool >>| add_checksums_and_urls acc)
+            (* TODO: better way to get this value? *)
+            let ctx_name = Context_name.default in
+            Lock_dir.of_dev_tool ctx_name dev_tool >>| add_checksums_and_urls acc)
       in
       Per_context.list ()
       >>= Memo.parallel_map ~f:Lock_dir.get