Use Path type

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

Author: Leonidas-from-XIV

bin/lock_dev_tool.ml

@@ -80,7 +80,7 @@ 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_untracked_lock_dir dev_tool in
   Memo.of_reproducible_fiber
   @@ Pkg.Lock.solve
        workspace
@@ -174,14 +174,11 @@ 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* lock_dir_exists =
-    Dune_engine.Fs_memo.dir_exists (In_source_dir dev_tool_lock_dir)
-  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
   match lock_dir_exists with
   | false -> Memo.return `No_lockdir
   | true ->
-    let dev_tool_lock_dir = Path.source dev_tool_lock_dir in
     (match Lock_dir.read_disk dev_tool_lock_dir with
      | Error _ -> Memo.return `No_lockdir
      | Ok { packages; _ } ->

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 =
-            Memo.Lazy.force Utop.utop_dev_tool_lock_dir_exists
+          let utop_dev_tool_lock_dir_exists =
+            Lazy.force Utop.utop_dev_tool_lock_dir_exists
           in
           let* () =
             if utop_dev_tool_lock_dir_exists

src/dune_pkg/lock_dir.ml

@@ -524,10 +524,20 @@ 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 ])
+     | 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 ->
     Code_error.raise
       "External path returned when loading a lock dir"
@@ -1789,7 +1799,7 @@ let loc_in_source_tree loc =
   loc
   |> Loc.map_pos ~f:(fun ({ pos_fname; _ } as pos) ->
     let path = Path.of_string pos_fname in
-    match Path.of_string pos_fname with
+    match path with
     | External _ | In_source_tree _ -> pos
     | In_build_dir b ->
       (match Path.Build.explode b with

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_untracked_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 dir
             in
             match exists with
             | false -> Memo.return acc

src/dune_rules/format_rules.ml

@@ -33,7 +33,7 @@ end
 
 module Ocamlformat = struct
   let dev_tool_lock_dir_exists () =
-    Lock_dir.dev_tool_source_lock_dir Ocamlformat |> Path.source |> Path.Untracked.exists
+    Lock_dir.dev_tool_untracked_lock_dir Ocamlformat |> Path.Untracked.exists
   ;;
 
   (* Config files for ocamlformat. When these are changed, running

src/dune_rules/lock_dir.ml

@@ -147,14 +147,16 @@ 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.L.relative Path.Source.root [ "_build"; ".dev-tools.locks" ]
-  in
+(* 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_segment = dev_tool_to_path_segment dev_tool in
-  Path.Source.append_local dev_tools_path dev_tool_segment
+  Path.Build.append_local dev_tools_path dev_tool_segment |> Path.build
 ;;
 
+(* 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
@@ -228,20 +230,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_untracked_lock_dir dev_tool 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_untracked_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 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_untracked_lock_dir : Dune_pkg.Dev_tool.t -> Path.t
 
 (** Returns the path to the lock_dir that will be used to lock the
     given dev tool *)

src/dune_rules/lock_rules.ml

@@ -394,11 +394,10 @@ let copy_lock_dir ~target ~lock_dir ~deps ~files =
   let open Action_builder.O in
   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
-         in
-         Action.progn [ Action.mkdir (Path.Build.parent_exn dst); Action.copy src dst ])
+         let suffix = Path.drop_prefix_exn src ~prefix:lock_dir in
+         let dst = Path.Build.append_local target suffix in
+         let parent = Path.Build.parent_exn dst in
+         Action.progn [ Action.mkdir parent; Action.copy src dst ])
        |> Action.concurrent
        |> Action.Full.make
        |> Action_builder.return)
@@ -453,7 +452,7 @@ let files dir =
 
 let setup_copy_rules ~dir:target ~assume_src_exists ~lock_dir =
   let+ () = Memo.return () in
-  let deps, files = files (Path.source lock_dir) 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
@@ -484,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 ~assume_src_exists:false ~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
+  let lock_dir = Lock_dir.dev_tool_untracked_lock_dir dev_tool 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

src/dune_rules/merlin/ocaml_index.ml

@@ -9,7 +9,7 @@ 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_untracked_lock_dir Ocaml_index |> Path.Untracked.exists
 ;;
 
 let ocaml_index sctx ~dir =

src/dune_rules/pkg_rules.ml

@@ -86,11 +86,7 @@ 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_source_lock_dir
-      |> Path.source
-      |> Option.some
-      |> Memo.return
+      dev_tool |> Lock_dir.dev_tool_untracked_lock_dir |> Option.some |> Memo.return
   ;;
 end