Turn the dev-tool path to a Path.External.t

Leonidas-from-XIV · Leonidas-from-XIV · commit e10753af4aa2 · 2025-11-17T14:41:12.000+01:00
Signed-off-by: Marek Kubica &lt;marek@tarides.com&gt;
diff --git a/bin/lock_dev_tool.ml b/bin/lock_dev_tool.ml
@@ -80,7 +80,9 @@ let solve ~dev_tool ~local_packages =
     | `Disabled -> workspace
   in
   (* as we want to write to the source, we're using the source lock dir here *)
-  let lock_dir = Dune_rules.Lock_dir.dev_tool_untracked_lock_dir dev_tool in
+  let lock_dir =
+    Dune_rules.Lock_dir.dev_tool_external_lock_dir dev_tool |> Path.external_
+  in
   Memo.of_reproducible_fiber
   @@ Pkg.Lock.solve
        workspace
@@ -174,11 +176,14 @@ let extra_dependencies dev_tool =
 
 let lockdir_status dev_tool =
   let open Memo.O in
-  let dev_tool_lock_dir = Dune_rules.Lock_dir.dev_tool_untracked_lock_dir dev_tool in
-  let lock_dir_exists = Path.exists dev_tool_lock_dir in
+  let dev_tool_lock_dir = Dune_rules.Lock_dir.dev_tool_external_lock_dir dev_tool in
+  let* lock_dir_exists =
+    Dune_engine.Fs_memo.dir_exists (Path.Outside_build_dir.External dev_tool_lock_dir)
+  in
   match lock_dir_exists with
   | false -> Memo.return `No_lockdir
   | true ->
+    let dev_tool_lock_dir = Path.external_ dev_tool_lock_dir in
     (match Lock_dir.read_disk dev_tool_lock_dir with
      | Error _ -> Memo.return `No_lockdir
      | Ok { packages; _ } ->
diff --git a/bin/ocaml/utop.ml b/bin/ocaml/utop.ml
@@ -58,8 +58,8 @@ let term =
             [ Pp.textf "no library is defined in %s" (String.maybe_quoted dir) ]
         | true ->
           let* () = Build_system.build_file utop_exe in
-          let utop_dev_tool_lock_dir_exists =
-            Lazy.force Utop.utop_dev_tool_lock_dir_exists
+          let* utop_dev_tool_lock_dir_exists =
+            Memo.Lazy.force Utop.utop_dev_tool_lock_dir_exists
           in
           let* () =
             if utop_dev_tool_lock_dir_exists
diff --git a/bin/pkg/lock.ml b/bin/pkg/lock.ml
@@ -197,6 +197,13 @@ let solve_multiple_platforms
           |> Platforms_by_message.all_solver_errors_raising_if_any_manifest_errors )
 ;;
 
+let user_lock_dir_path path =
+  match (path : Path.t) with
+  | In_source_tree _ -> path
+  | In_build_dir _ -> path
+  | External e -> Dune_pkg.Pkg_workspace.dev_tool_path_to_source_dir e |> Path.source
+;;
+
 let summary_message
       ~portable_lock_dir
       ~lock_dir_path
@@ -259,7 +266,9 @@ let summary_message
     in
     (Pp.tag
        User_message.Style.Success
-       (Pp.textf "Solution for %s" (Path.to_string_maybe_quoted lock_dir_path))
+       (Pp.textf
+          "Solution for %s"
+          (Path.to_string_maybe_quoted (user_lock_dir_path lock_dir_path)))
      :: Pp.nop
      :: Pp.text "Dependencies common to all supported platforms:"
      :: pp_package_set common_packages
@@ -268,7 +277,9 @@ let summary_message
   else
     (Pp.tag
        User_message.Style.Success
-       (Pp.textf "Solution for %s:" (Path.to_string_maybe_quoted lock_dir_path))
+       (Pp.textf
+          "Solution for %s:"
+          (Path.to_string_maybe_quoted (user_lock_dir_path lock_dir_path)))
      :: (match Lock_dir.Packages.to_pkg_list lock_dir.packages with
          | [] -> Pp.tag User_message.Style.Warning @@ Pp.text "(no dependencies to lock)"
          | packages -> pp_packages packages)
@@ -491,7 +502,9 @@ let solve
         ([ Pp.text "Unable to solve dependencies for the following lock directories:" ]
          @ List.concat_map errors ~f:(fun (path, errors) ->
            let messages = List.map errors ~f:fst in
-           [ Pp.textf "Lock directory %s:" (Path.to_string_maybe_quoted path)
+           [ Pp.textf
+               "Lock directory %s:"
+               (Path.to_string_maybe_quoted (user_lock_dir_path path))
            ; Pp.vbox (Pp.concat ~sep:Pp.cut messages)
            ]))
   | Ok write_disks_with_summaries ->
diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml
@@ -538,10 +538,7 @@ let in_source_tree path =
             ; "source_components", Dyn.(list string) source_components
             ; "build_components", Dyn.(list string) build_components
             ]))
-  | External e ->
-    Code_error.raise
-      "External path returned when loading a lock dir"
-      [ "path", Path.External.to_dyn e ]
+  | External e -> Workspace.dev_tool_path_to_source_dir e
 ;;
 
 module Pkg = struct
@@ -887,14 +884,9 @@ module Pkg = struct
          ^ extension)
   ;;
 
+  (* TODO remove *)
   let files_dir package_name maybe_package_version ~lock_dir =
-    match files_dir_generic package_name maybe_package_version ~lock_dir with
-    | In_source_tree _ as path -> path
-    | In_build_dir _ as path -> path
-    | External e ->
-      Code_error.raise
-        "file_dir is an external path, this is unsupported"
-        [ "path", Path.External.to_dyn e ]
+    files_dir_generic package_name maybe_package_version ~lock_dir
   ;;
 
   let source_files_dir package_name maybe_package_version ~lock_dir =
@@ -1402,7 +1394,11 @@ module Write_disk = struct
   let safely_remove_lock_dir_if_exists_thunk path =
     match check_existing_lock_dir path with
     | Ok `Non_existant -> Fun.const ()
-    | Ok `Is_existing_lock_dir -> fun () -> Path.rm_rf path
+    | Ok `Is_existing_lock_dir ->
+      fun () ->
+        (* dev-tool lock dirs are external paths despite living in _build, they're
+           safe to remove *)
+        Path.rm_rf ~allow_external:true path
     | Error e -> raise_user_error_on_check_existance path e
   ;;
 
diff --git a/src/dune_pkg/workspace.ml b/src/dune_pkg/workspace.ml
@@ -70,3 +70,37 @@ module Repository = struct
 
   let opam_url { name = _; url } = url
 end
+
+let dev_tool_path_to_source_dir path =
+  let of_ =
+    Path.Build.relative Path.Build.root ".dev-tools.locks"
+    |> Path.build
+    |> Path.to_absolute_filename
+    |> Path.External.of_string
+  in
+  let in_dev_tool_dir = Path.External.is_descendant ~of_ path in
+  match in_dev_tool_dir with
+  | false ->
+    Code_error.raise
+      "External lock dir path is unsupported"
+      [ "dir", Path.External.to_dyn path ]
+  | true ->
+    let prefix = Path.External.to_string of_ in
+    let as_string = Path.External.to_string path in
+    let relative =
+      String.sub
+        as_string
+        ~pos:(String.length prefix)
+        ~len:(String.length as_string - String.length prefix)
+    in
+    let exploded = String.split ~on:'/' relative in
+    (match exploded with
+     | "" :: dev_tool_name :: components ->
+       Path.Source.L.relative
+         Path.Source.root
+         ([ "_build"; ".dev-tools.locks"; dev_tool_name ] @ components)
+     | components ->
+       Code_error.raise
+         "Unexpected external path"
+         [ "dir", Path.External.to_dyn path; "components", Dyn.(list string) components ])
+;;
diff --git a/src/dune_pkg/workspace.mli b/src/dune_pkg/workspace.mli
@@ -25,3 +25,5 @@ module Repository : sig
 
   val name : t -> Name.t
 end
+
+val dev_tool_path_to_source_dir : Path.External.t -> Path.Source.t
diff --git a/src/dune_rules/fetch_rules.ml b/src/dune_rules/fetch_rules.ml
@@ -189,11 +189,11 @@ let find_checksum, find_url =
           Dune_pkg.Dev_tool.all
           ~init:(Checksum.Map.empty, Digest.Map.empty)
           ~f:(fun acc dev_tool ->
-            let dir = Lock_dir.dev_tool_untracked_lock_dir dev_tool in
+            let dir = Lock_dir.dev_tool_external_lock_dir dev_tool in
             let exists =
               (* Note we use [Path.Untracked] here rather than [Fs_memo] because a tool's
                  lockdir may be generated part way through a build. *)
-              Path.Untracked.exists dir
+              Path.Untracked.exists (Path.external_ dir)
             in
             match exists with
             | false -> Memo.return acc
diff --git a/src/dune_rules/format_rules.ml b/src/dune_rules/format_rules.ml
@@ -33,7 +33,9 @@ end
 
 module Ocamlformat = struct
   let dev_tool_lock_dir_exists () =
-    Lock_dir.dev_tool_untracked_lock_dir Ocamlformat |> Path.Untracked.exists
+    Lock_dir.dev_tool_external_lock_dir Ocamlformat
+    |> Path.external_
+    |> Path.Untracked.exists
   ;;
 
   (* Config files for ocamlformat. When these are changed, running
diff --git a/src/dune_rules/lock_dir.ml b/src/dune_rules/lock_dir.ml
@@ -148,10 +148,13 @@ let dev_tool_to_path_segment dev_tool =
 ;;
 
 (* This function returns the lock dir that is created outside the build system. *)
-let dev_tool_untracked_lock_dir dev_tool =
-  let dev_tools_path = Path.Build.relative Path.Build.root ".dev-tools.locks" in
+let dev_tool_external_lock_dir dev_tool =
+  let external_root =
+    Path.Build.root |> Path.build |> Path.to_absolute_filename |> Path.External.of_string
+  in
+  let dev_tools_path = Path.External.relative external_root ".dev-tools.locks" in
   let dev_tool_segment = dev_tool_to_path_segment dev_tool in
-  Path.Build.append_local dev_tools_path dev_tool_segment |> Path.build
+  Path.External.append_local dev_tools_path dev_tool_segment
 ;;
 
 (* This function returns the lock dir location where the build system can create
@@ -230,12 +233,12 @@ let get ctx = get_with_path ctx >>| Result.map ~f:snd
 let get_exn ctx = get ctx >>| User_error.ok_exn
 
 let of_dev_tool dev_tool =
-  let path = dev_tool_untracked_lock_dir dev_tool in
+  let path = dev_tool |> dev_tool_external_lock_dir |> Path.external_ in
   Load.load_exn path
 ;;
 
 let of_dev_tool_if_lock_dir_exists dev_tool =
-  let path = dev_tool_untracked_lock_dir dev_tool in
+  let path = dev_tool |> dev_tool_external_lock_dir |> Path.external_ in
   let exists =
     (* Note we use [Path.Untracked] here rather than [Fs_memo] because a tool's
        lockdir may be generated part way through a build. *)
diff --git a/src/dune_rules/lock_dir.mli b/src/dune_rules/lock_dir.mli
@@ -21,7 +21,7 @@ val default_path : Path.t
 val default_source_path : Path.Source.t
 
 (** The location in the source tree where a dev tool lock dir is expected *)
-val dev_tool_untracked_lock_dir : Dune_pkg.Dev_tool.t -> Path.t
+val dev_tool_external_lock_dir : Dune_pkg.Dev_tool.t -> Path.External.t
 
 (** Returns the path to the lock_dir that will be used to lock the
     given dev tool *)
diff --git a/src/dune_rules/lock_rules.ml b/src/dune_rules/lock_rules.ml
@@ -491,7 +491,7 @@ let setup_dev_tool_lock_rules ~dir dev_tool =
   let package_name = Dev_tool.package_name dev_tool in
   let dev_tool_name = Dune_lang.Package_name.to_string package_name in
   let dir = Path.Build.relative dir dev_tool_name in
-  let lock_dir = Lock_dir.dev_tool_untracked_lock_dir dev_tool in
+  let lock_dir = dev_tool |> Lock_dir.dev_tool_external_lock_dir |> Path.external_ in
   (* dev tool lock files are created in _build outside of the build system
      so we have to tell the build system not to try to create them *)
   setup_copy_rules ~dir ~assume_src_exists:true ~lock_dir
diff --git a/src/dune_rules/merlin/ocaml_index.ml b/src/dune_rules/merlin/ocaml_index.ml
@@ -9,7 +9,9 @@ let ocaml_index_dev_tool_exe_path_building_if_necessary () =
 ;;
 
 let ocaml_index_dev_tool_exists () =
-  Lock_dir.dev_tool_untracked_lock_dir Ocaml_index |> Path.Untracked.exists
+  Lock_dir.dev_tool_external_lock_dir Ocaml_index
+  |> Path.external_
+  |> Path.Untracked.exists
 ;;
 
 let ocaml_index sctx ~dir =
diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml
@@ -86,7 +86,11 @@ module Package_universe = struct
     | Dependencies ctx -> Lock_dir.get_path ctx
     | Dev_tool dev_tool ->
       (* CR-Leonidas-from-XIV: It probably isn't always [Some] *)
-      dev_tool |> Lock_dir.dev_tool_untracked_lock_dir |> Option.some |> Memo.return
+      dev_tool
+      |> Lock_dir.dev_tool_external_lock_dir
+      |> Path.external_
+      |> Option.some
+      |> Memo.return
   ;;
 end
 
@@ -1523,13 +1527,25 @@ end = struct
         |> Option.map ~f:(fun (p : Path.t) ->
           match p with
           | External e ->
-            Code_error.raise
-              "Package files directory is external source directory, this is unsupported"
-              [ "dir", Path.External.to_dyn e ]
+            let source_path = Dune_pkg.Pkg_workspace.dev_tool_path_to_source_dir e in
+            (match Path.Source.explode source_path with
+             | [ "_build"; ".dev-tools.locks"; dev_tool; files_dir ] ->
+               Path.Build.L.relative
+                 Private_context.t.build_dir
+                 [ "default"; ".dev-tool-locks"; dev_tool; files_dir ]
+             | components ->
+               Code_error.raise
+                 "Package files directory is external source directory, this is \
+                  unsupported"
+                 [ "external", Path.External.to_dyn e
+                 ; "source", Path.Source.to_dyn source_path
+                 ; "components", Dyn.(list string) components
+                 ])
           | In_source_tree s ->
             Code_error.raise "Unexpected files_dir path" [ "dir", Path.Source.to_dyn s ]
           | In_build_dir b ->
             (match Path.Build.explode b with
+             (* TODO remove, probably unused *)
              | [ ".dev-tools.locks"; dev_tool; files_dir ] ->
                Path.Build.L.relative
                  Private_context.t.build_dir
diff --git a/src/dune_rules/utop.ml b/src/dune_rules/utop.ml
@@ -146,9 +146,9 @@ let requires ~loc ~db ~libs =
 ;;
 
 let utop_dev_tool_lock_dir_exists =
-  lazy
-    (let path = Lock_dir.dev_tool_untracked_lock_dir Utop in
-     Path.Untracked.exists path)
+  Memo.Lazy.create (fun () ->
+    let path = Lock_dir.dev_tool_external_lock_dir Utop in
+    Fs_memo.dir_exists (Path.Outside_build_dir.External path))
 ;;
 
 let utop_findlib_conf = Filename.concat utop_dir_basename "findlib.conf"
@@ -167,8 +167,8 @@ let utop_ocamlpath = Memo.Lazy.create (fun () -> Pkg_rules.dev_tool_ocamlpath Ut
    we need to tell findlib where to look for libraries by means of a custom
    findlib.conf file. *)
 let findlib_conf sctx ~dir =
-  Lazy.force utop_dev_tool_lock_dir_exists
-  |> function
+  Memo.Lazy.force utop_dev_tool_lock_dir_exists
+  >>= function
   | false ->
     (* If there isn't lockdir don't create the findlib.conf rule. *)
     Memo.return ()
@@ -186,7 +186,7 @@ let findlib_conf sctx ~dir =
 
 let lib_db sctx ~dir =
   let* scope = Scope.DB.find_by_dir dir in
-  let lock_dir_exists = Lazy.force utop_dev_tool_lock_dir_exists in
+  let* lock_dir_exists = Memo.Lazy.force utop_dev_tool_lock_dir_exists in
   match lock_dir_exists with
   | false -> Memo.return (Scope.libs scope)
   | true ->
diff --git a/src/dune_rules/utop.mli b/src/dune_rules/utop.mli
@@ -8,7 +8,7 @@ val utop_exe : Filename.t
 
 val utop_dir_basename : Filename.t
 val utop_findlib_conf : Filename.t
-val utop_dev_tool_lock_dir_exists : bool Lazy.t
+val utop_dev_tool_lock_dir_exists : bool Memo.Lazy.t
 val libs_under_dir : Super_context.t -> db:Lib.DB.t -> dir:Path.t -> Lib.t list Memo.t
 val setup : Super_context.t -> dir:Path.Build.t -> unit Memo.t
 
diff --git a/src/source/workspace.ml b/src/source/workspace.ml
@@ -742,18 +742,11 @@ let source_path_of_lock_dir_path path =
   | In_build_dir b ->
     (match Path.Build.explode b with
      | [ _; _; ".lock"; lock_dir ] -> Path.Source.of_string lock_dir
-     | [ ".dev-tools.locks"; dev_tool_name ] ->
-       Path.Source.L.relative
-         Path.Source.root
-         [ "_build"; ".dev-tools.locks"; dev_tool_name ]
      | components ->
        Code_error.raise
          "Unsupported build path"
          [ "dir", Path.Build.to_dyn b; "components", Dyn.(list string) components ])
-  | External e ->
-    Code_error.raise
-      "External lock dir path is unsupported"
-      [ "dir", Path.External.to_dyn e ]
+  | External e -> Dune_pkg.Pkg_workspace.dev_tool_path_to_source_dir e
 ;;
 
 let find_lock_dir t path =
diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-dev-tool-fails-to-build.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-dev-tool-fails-to-build.t
@@ -15,7 +15,7 @@ It fails during the build because of missing OCamlFormat module.
   $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt
   Solution for _build/.dev-tools.locks/ocamlformat:
   - ocamlformat.0.26.4
-  File "_build/.dev-tools.locks/ocamlformat/ocamlformat.pkg", line 4, characters 6-10:
+  File "$TESTCASE_ROOT/_build/.dev-tools.locks/ocamlformat/ocamlformat.pkg", line 4, characters 6-10:
   4 |  (run dune build -p %{pkg-self:name} @install))
             ^^^^
   Error: Logs for package ocamlformat
@@ -24,4 +24,9 @@ It fails during the build because of missing OCamlFormat module.
                     ^^^^^^^^^^^
   Error: Module "Ocamlformat" doesn't exist.
   
+  -> required by
+     _build/_private/default/.dev-tool/ocamlformat/target/bin/ocamlformat
+  -> required by _build/default/.formatted/foo.ml
+  -> required by alias .formatted/fmt
+  -> required by alias fmt
   [1]
