Move dev-tool lock dirs into hidden folder (#12671)

* Move dev-tool lock dirs from source into into build folder

Signed-off-by: Marek Kubica <[email protected]>

* Use `Path` type

Signed-off-by: Marek Kubica <[email protected]>

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

Signed-off-by: Marek Kubica <[email protected]>

* Fix after rebase

Signed-off-by: Marek Kubica <[email protected]>

* Remove unused indirection

Signed-off-by: Marek Kubica <[email protected]>

* Rewrite absolute external paths into relative paths

Signed-off-by: Marek Kubica <[email protected]>

* Bring back `Fs_memo`

Signed-off-by: Marek Kubica <[email protected]>

* Improve implementation of external to source mapping

Signed-off-by: Marek Kubica <[email protected]>

* Closer to style of `main`

Signed-off-by: Marek Kubica <[email protected]>

* Add validation that path to be deleted is in fact managed

Signed-off-by: Marek Kubica <[email protected]>

* Use `try_localize` instead of rolling my own version of it

Signed-off-by: Marek Kubica <[email protected]>

* Do not assume build dir name

Signed-off-by: Marek Kubica <[email protected]>

* Add cram test to show that custom build dirs work

Signed-off-by: Marek Kubica <[email protected]>

* use fs_memo to scan lock directories

Signed-off-by: Ali Caglayan <[email protected]>

* Switch from untracked path checking to compile-time flag

Signed-off-by: Marek Kubica <[email protected]>

---------

Signed-off-by: Marek Kubica <[email protected]>
Signed-off-by: Ali Caglayan <[email protected]>
Co-authored-by: Ali Caglayan <[email protected]>

Author: Leonidas-from-XIV

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)
@@ -493,7 +504,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,22 @@ 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" as prefix) :: dev_tool :: components ->
+          let build_as_source =
+            Path.build_dir |> Path.to_string |> Path.Source.of_string
+          in
+          Path.Source.L.relative build_as_source (prefix :: 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 +870,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 +885,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 +1390,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 +1495,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,20 @@ 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" as prefix) :: dev_tool_name :: components ->
+       let build_as_source = Path.build_dir |> Path.to_string |> Path.Source.of_string in
+       Path.Source.L.relative build_as_source (prefix :: 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,12 @@ 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
+    (* we assume that if lock_dev_tools is set, then the lock dir was created
+       via locking and can expect it to exist. If it doesn't, it's a bug
+    *)
+    match Config.get Compile_time.lock_dev_tools with
+    | `Enabled -> true
+    | `Disabled -> false
   ;;
 
   (* Config files for ocamlformat. When these are changed, running
@@ -129,7 +133,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
@@ -239,20 +246,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

@@ -411,8 +411,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
@@ -425,8 +424,40 @@ let copy_lock_dir ~target ~lock_dir ~deps ~files =
             ~dirs:(Path.Build.Set.singleton target))
 ;;
 
+let scan_lock_directory =
+  let rec scan dir =
+    let open Memo.O in
+    Fs_memo.dir_contents (Path.as_outside_build_dir_exn dir)
+    >>= function
+    | Error (ENOENT, _, _) -> Memo.return Path.Set.empty
+    | Error unix_error ->
+      User_error.raise
+        [ Pp.textf "Failed to read directory %s:" (Path.to_string_maybe_quoted dir)
+        ; Unix_error.Detailed.pp unix_error
+        ]
+    | Ok entries ->
+      Fs_cache.Dir_contents.to_list entries
+      |> Memo.parallel_map ~f:(fun (entry, kind) ->
+        let path = Path.relative dir entry in
+        match (kind : File_kind.t) with
+        | S_REG -> Memo.return (Path.Set.singleton path)
+        | S_DIR -> scan path
+        | kind ->
+          User_error.raise
+            [ Pp.textf
+                "Lock directory contains file %S with unsupported kind %S"
+                (Path.to_string_maybe_quoted path)
+                (File_kind.to_string kind)
+            ])
+      >>| Path.Set.union_all
+  in
+  fun lock_dir_path ->
+    let+ files = scan lock_dir_path in
+    Dep.Set.of_source_files ~files ~empty_directories:Path.Set.empty, files
+;;
+
 let setup_copy_rules ~dir:target ~lock_dir =
-  let+ deps, files = Source_deps.files (Path.source lock_dir) in
+  let+ deps, files = scan_lock_directory lock_dir in
   let directory_targets, rules =
     match Path.Set.is_empty files with
     | true -> Path.Build.Map.empty, Rules.empty
@@ -452,15 +483,15 @@ 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 ~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
+  let lock_dir = dev_tool |> Lock_dir.dev_tool_external_lock_dir |> Path.external_ in
   setup_copy_rules ~dir ~lock_dir
 ;;