Move dev-tool lock dirs into hidden folder

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_source_lock_dir dev_tool |> Path.source 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,14 +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_source_lock_dir dev_tool 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 (In_source_dir dev_tool_lock_dir)
+    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.source dev_tool_lock_dir in
+    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; _ } ->

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

src/dune_pkg/lock_dir.ml

@@ -524,14 +524,21 @@ let in_source_tree path =
     (match Path.Source.explode in_source with
      | "default" :: ".lock" :: components ->
        Path.Source.L.relative Path.Source.root components
-     | _otherwise ->
-       Code_error.raise
-         "Unexpected location of lock directory in build directory"
-         [ "path", Path.Build.to_dyn b; "in_source", Path.Source.to_dyn in_source ])
-  | External e ->
-    Code_error.raise
-      "External path returned when loading a lock dir"
-      [ "path", Path.External.to_dyn e ]
+     | source_components ->
+       (match Path.Build.explode b with
+        | ".dev-tools.locks" :: dev_tool :: components ->
+          Path.Source.L.relative
+            Path.Source.root
+            ([ "_build"; ".dev-tools.locks"; dev_tool ] @ components)
+        | build_components ->
+          Code_error.raise
+            "Unexpected location of lock directory in build directory"
+            [ "path", Path.Build.to_dyn b
+            ; "in_source", Path.Source.to_dyn in_source
+            ; "source_components", Dyn.(list string) source_components
+            ; "build_components", Dyn.(list string) build_components
+            ]))
+  | External e -> Workspace.dev_tool_path_to_source_dir e
 ;;
 
 module Pkg = struct
@@ -862,7 +869,7 @@ module Pkg = struct
   ;;
 
   (* More general version of [files_dir] which works on generic paths *)
-  let files_dir_generic package_name maybe_package_version ~lock_dir =
+  let files_dir package_name maybe_package_version ~lock_dir =
     (* TODO(steve): Once portable lockdirs are enabled by default, make the
        package version non-optional *)
     let extension = ".files" in
@@ -877,16 +884,6 @@ module Pkg = struct
          ^ extension)
   ;;
 
-  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 ]
-  ;;
-
   let source_files_dir package_name maybe_package_version ~lock_dir =
     let source = in_source_tree lock_dir in
     let package_name = Package_name.to_string package_name in
@@ -1392,7 +1389,16 @@ 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 () ->
+        let path =
+          match path with
+          | In_source_tree _ | In_build_dir _ -> path
+          | External e ->
+            (* it might be a dev-tool path, try to convert *)
+            Workspace.dev_tool_path_to_source_dir e |> Path.source
+        in
+        Path.rm_rf path
     | Error e -> raise_user_error_on_check_existance path e
   ;;
 
@@ -1488,10 +1494,7 @@ module Write_disk = struct
               let maybe_package_version =
                 if portable_lock_dir then Some package_version else None
               in
-              Pkg.files_dir_generic
-                package_name
-                maybe_package_version
-                ~lock_dir:lock_dir_path
+              Pkg.files_dir package_name maybe_package_version ~lock_dir:lock_dir_path
             in
             Path.mkdir_p files_dir;
             List.iter files ~f:(fun { File_entry.original; local_file } ->

src/dune_pkg/workspace.ml

@@ -70,3 +70,21 @@ module Repository = struct
 
   let opam_url { name = _; url } = url
 end
+
+let dev_tool_path_to_source_dir path =
+  match Path.Expert.try_localize_external (Path.external_ path) with
+  | External _ | In_source_tree _ ->
+    Code_error.raise
+      "External path is not pointing to lock dir location"
+      [ "external", Path.External.to_dyn path ]
+  | In_build_dir b ->
+    (match Path.Build.explode b with
+     | ".dev-tools.locks" :: 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 ])
+;;

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

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_source_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 (Path.source dir)
+              Path.Untracked.exists (Path.external_ dir)
             in
             match exists with
             | false -> Memo.return acc

src/dune_rules/format_rules.ml

@@ -33,8 +33,9 @@ end
 
 module Ocamlformat = struct
   let dev_tool_lock_dir_exists () =
-    let path = Lock_dir.dev_tool_source_lock_dir Ocamlformat in
-    Source_tree.find_dir path >>| Option.is_some
+    Lock_dir.dev_tool_external_lock_dir Ocamlformat
+    |> Path.external_
+    |> Path.Untracked.exists
   ;;
 
   (* Config files for ocamlformat. When these are changed, running
@@ -129,7 +130,7 @@ let gen_rules_output
   let loc = Format_config.loc config in
   let dir = Path.Build.parent_exn output_dir in
   let alias_formatted = Alias.fmt ~dir:output_dir in
-  let* ocamlformat_is_locked = Ocamlformat.dev_tool_lock_dir_exists () in
+  let ocamlformat_is_locked = Ocamlformat.dev_tool_lock_dir_exists () in
   let setup_formatting file =
     (let input_basename = Path.Source.basename file in
      let input = Path.Build.relative dir input_basename in

src/dune_rules/lock_dir.ml

@@ -147,12 +147,19 @@ let dev_tool_to_path_segment dev_tool =
   dev_tool |> Dev_tool.package_name |> Package_name.to_string |> Path.Local.of_string
 ;;
 
-let dev_tool_source_lock_dir dev_tool =
-  let dev_tools_path = Path.Source.(relative root "dev-tools.locks") in
+(* This function returns the lock dir that is created outside the build system. *)
+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.Source.append_local dev_tools_path dev_tool_segment
+  Path.External.append_local dev_tools_path dev_tool_segment
 ;;
 
+(* This function returns the lock dir location where the build system can create
+   the lock directory. This is where lock files should be loaded from and it
+   is populated either by copy rules or the solver running. *)
 let dev_tool_lock_dir dev_tool =
   (* dev tools always live in default *)
   let ctx_name = Context_name.default |> Context_name.to_string in
@@ -226,20 +233,20 @@ 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 source_path = dev_tool_source_lock_dir dev_tool in
-  Load.load_exn (Path.source source_path)
+  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 source_path = dev_tool_source_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. *)
-    Path.Untracked.exists (Path.source source_path)
+    Path.Untracked.exists path
   in
   if exists
   then
-    let+ t = Load.load_exn (Path.source source_path) in
+    let+ t = Load.load_exn path in
     Some t
   else Memo.return None
 ;;

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_source_lock_dir : Dune_pkg.Dev_tool.t -> Path.Source.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 *)

src/dune_rules/lock_rules.ml

@@ -437,8 +437,7 @@ let copy_lock_dir ~target ~lock_dir ~deps ~files =
   Action_builder.deps deps
   >>> (Path.Set.to_list_map files ~f:(fun src ->
          let dst =
-           Path.drop_prefix_exn src ~prefix:(Path.source lock_dir)
-           |> Path.Build.append_local target
+           Path.drop_prefix_exn src ~prefix:lock_dir |> Path.Build.append_local target
          in
          Action.progn [ Action.mkdir (Path.Build.parent_exn dst); Action.copy src dst ])
        |> Action.concurrent
@@ -451,12 +450,60 @@ let copy_lock_dir ~target ~lock_dir ~deps ~files =
             ~dirs:(Path.Build.Set.singleton target))
 ;;
 
-let setup_copy_rules ~dir:target ~lock_dir =
-  let+ deps, files = Source_deps.files (Path.source lock_dir) in
+let files dir =
+  let rec recurse dir =
+    match Path.Untracked.readdir_unsorted_with_kinds dir with
+    | Ok entries ->
+      entries
+      |> List.fold_left
+           ~init:(Path.Set.empty, Path.Set.empty)
+           ~f:(fun (files, empty_directories) (entry, kind) ->
+             let path = Path.relative dir entry in
+             match (kind : Unix.file_kind) with
+             | S_REG ->
+               let files = Path.Set.add files path in
+               files, empty_directories
+             | S_DIR ->
+               let files', empty_directories' = recurse path in
+               (match Path.Set.is_empty files', Path.Set.is_empty empty_directories' with
+                | true, true ->
+                  let empty_directories = Path.Set.add empty_directories path in
+                  files, empty_directories
+                | _, _ ->
+                  let files = Path.Set.union files files' in
+                  let empty_directories =
+                    Path.Set.union empty_directories empty_directories'
+                  in
+                  files, empty_directories)
+             | otherwise ->
+               Code_error.raise
+                 "unsupported kind of file in folder"
+                 [ "path", Path.to_dyn path; "kind", File_kind.to_dyn otherwise ])
+    | Error (ENOENT, _, _) -> Path.Set.empty, Path.Set.empty
+    | Error unix_error ->
+      User_error.raise
+        [ Pp.textf
+            "Failed to read lock dir files of %s:"
+            (Path.to_string_maybe_quoted dir)
+        ; Pp.text (Unix_error.Detailed.to_string_hum unix_error)
+        ]
+  in
+  let files, empty_directories = recurse dir in
+  Dep.Set.of_source_files ~files ~empty_directories, files
+;;
+
+let setup_copy_rules ~dir:target ~assume_src_exists ~lock_dir =
+  let+ () = Memo.return () in
+  let deps, files = files lock_dir in
   let directory_targets, rules =
     match Path.Set.is_empty files with
     | true -> Path.Build.Map.empty, Rules.empty
     | false ->
+      let deps =
+        match assume_src_exists with
+        | false -> deps
+        | true -> Dep.Set.empty
+      in
       let directory_targets = Path.Build.Map.singleton target Loc.none in
       let { Action_builder.With_targets.build; targets } =
         copy_lock_dir ~target ~lock_dir ~deps ~files
@@ -478,16 +525,18 @@ let setup_lock_rules_with_source (workspace : Workspace.t) ~dir ~lock_dir =
   match source with
   | `Source_tree lock_dir ->
     let dir = Path.Build.append_source dir lock_dir in
-    setup_copy_rules ~dir ~lock_dir
+    setup_copy_rules ~assume_src_exists:false ~dir ~lock_dir:(Path.source lock_dir)
   | `Generated -> Memo.return (setup_lock_rules ~dir ~lock_dir)
 ;;
 
 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_source_lock_dir dev_tool in
-  setup_copy_rules ~dir ~lock_dir
+  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
 ;;
 
 let setup_rules ~components ~dir =

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_source_lock_dir Ocaml_index |> Path.source |> Path.Untracked.exists
+  Lock_dir.dev_tool_external_lock_dir Ocaml_index
+  |> Path.external_
+  |> Path.Untracked.exists
 ;;
 
 let ocaml_index sctx ~dir =