feat(pkg): allow lock dir pkgs to dep on workspace pkgs (in&out)

Signed-off-by: Ali Caglayan <alizter@gmail.com>

Author: Alizter

bin/describe/describe_pkg.ml

@@ -5,14 +5,18 @@ module Local_package = Dune_pkg.Local_package
 module Show_lock = struct
   let print_lock lock_dir_arg () =
     let open Fiber.O in
-    let* lock_dir_paths =
-      Memo.run (Workspace.workspace ())
-      >>| Pkg.Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dir_arg
+    let* lock_dir_paths, external_packages =
+      Memo.run
+        (let open Memo.O in
+         let* workspace = Workspace.workspace () in
+         let+ local_packages = Pkg.Pkg_common.find_local_packages in
+         ( Pkg.Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dir_arg workspace
+         , Package_name.Map.keys local_packages |> Package_name.Set.of_list ))
     in
     Fiber.parallel_map lock_dir_paths ~f:(fun lock_dir_path ->
       let lock_dir_path = Path.source lock_dir_path in
       let+ platform = Pkg.Pkg_common.solver_env_from_system_and_context ~lock_dir_path in
-      let lock_dir = Lock_dir.read_disk_exn lock_dir_path in
+      let lock_dir = Lock_dir.read_disk_exn lock_dir_path ~external_packages in
       let packages =
         Lock_dir.Packages.pkgs_on_platform_by_name lock_dir.packages ~platform
         |> Package_name.Map.values
@@ -121,14 +125,14 @@ module List_locked_dependencies = struct
     |> Pp.vbox
   ;;
 
-  let enumerate_lock_dirs_by_path workspace ~lock_dirs =
+  let enumerate_lock_dirs_by_path workspace ~lock_dirs ~external_packages =
     let lock_dirs =
       Pkg.Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs workspace
     in
     List.filter_map lock_dirs ~f:(fun lock_dir_path ->
       if Fpath.exists (Path.Source.to_string lock_dir_path)
       then (
-        match Lock_dir.read_disk_exn (Path.source lock_dir_path) with
+        match Lock_dir.read_disk_exn (Path.source lock_dir_path) ~external_packages with
         | lock_dir -> Some (lock_dir_path, lock_dir)
         | exception User_error.E e ->
           User_warning.emit
@@ -144,11 +148,17 @@ module List_locked_dependencies = struct
   let list_locked_dependencies ~transitive ~lock_dirs () =
     let open Fiber.O in
     let* lock_dirs_by_path, local_packages =
-      let open Memo.O in
-      Memo.both
-        (Workspace.workspace () >>| enumerate_lock_dirs_by_path ~lock_dirs)
-        Pkg.Pkg_common.find_local_packages
-      |> Memo.run
+      Memo.run
+        (let open Memo.O in
+         let* local_packages = Pkg.Pkg_common.find_local_packages in
+         let external_packages =
+           Package_name.Map.keys local_packages |> Package_name.Set.of_list
+         in
+         let+ lock_dirs_by_path =
+           Workspace.workspace ()
+           >>| enumerate_lock_dirs_by_path ~lock_dirs ~external_packages
+         in
+         lock_dirs_by_path, local_packages)
     in
     let+ pp =
       Fiber.parallel_map lock_dirs_by_path ~f:(fun (lock_dir_path, lock_dir) ->

bin/lock_dev_tool.ml

@@ -169,7 +169,11 @@ let lockdir_status dev_tool =
   | 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
+    (* Dev tool lockdirs are produced by the solver running over a single
+       package and never reference workspace packages, so validate strictly. *)
+    (match
+       Lock_dir.read_disk dev_tool_lock_dir ~external_packages:Package_name.Set.empty
+     with
      | Error _ -> Memo.return `No_lockdir
      | Ok { packages; _ } ->
        let* platform =

bin/pkg/outdated.ml

@@ -15,7 +15,10 @@ let find_outdated_packages ~transitive ~lock_dirs_arg () =
           ~repositories:(repositories_of_lock_dir workspace ~lock_dir_path)
       and+ local_packages = Memo.run find_local_packages
       and+ platform = solver_env_from_system_and_context ~lock_dir_path in
-      let lock_dir = Dune_pkg.Lock_dir.read_disk_exn lock_dir_path in
+      let external_packages =
+        Package_name.Map.keys local_packages |> Package_name.Set.of_list
+      in
+      let lock_dir = Dune_pkg.Lock_dir.read_disk_exn lock_dir_path ~external_packages in
       let packages =
         Dune_pkg.Lock_dir.Packages.pkgs_on_platform_by_name lock_dir.packages ~platform
       in

bin/pkg/validate_lock_dir.ml

@@ -15,15 +15,15 @@ let info =
 (* CR-someday alizter: The logic here is a little more complicated than it needs
    to be and can be simplified. *)
 
-let enumerate_lock_dirs_by_path ~lock_dirs () =
+let enumerate_lock_dirs_by_path ~lock_dirs ~external_packages () =
   let open Memo.O in
   let+ per_contexts =
     Workspace.workspace () >>| Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs
   in
   List.filter_map per_contexts ~f:(fun lock_dir_path ->
     if Fpath.exists (Path.Source.to_string lock_dir_path)
     then (
-      match Lock_dir.read_disk_exn (Path.source lock_dir_path) with
+      match Lock_dir.read_disk_exn (Path.source lock_dir_path) ~external_packages with
       | lock_dir -> Some (Ok (lock_dir_path, lock_dir))
       | exception User_error.E e -> Some (Error (lock_dir_path, `Parse_error e)))
     else None)
@@ -32,8 +32,16 @@ let enumerate_lock_dirs_by_path ~lock_dirs () =
 let validate_lock_dirs ~lock_dirs () =
   let open Fiber.O in
   let* lock_dirs_by_path, local_packages =
-    Memo.both (enumerate_lock_dirs_by_path ~lock_dirs ()) Pkg_common.find_local_packages
-    |> Memo.run
+    Memo.run
+      (let open Memo.O in
+       let* local_packages = Pkg_common.find_local_packages in
+       let external_packages =
+         Package_name.Map.keys local_packages |> Package_name.Set.of_list
+       in
+       let+ lock_dirs_by_path =
+         enumerate_lock_dirs_by_path ~lock_dirs ~external_packages ()
+       in
+       lock_dirs_by_path, local_packages)
   in
   if List.is_empty lock_dirs_by_path
   then

src/dune_pkg/lock_dir.ml

@@ -1148,11 +1148,14 @@ type missing_dependency =
   ; loc : Loc.t
   }
 
-(* [validate_packages packages] returns
+(* [validate_packages packages ~external_packages] returns
    [Error (`Missing_dependencies missing_dependencies)] where
    [missing_dependencies] is a non-empty list with an element for each package
-   dependency which doesn't have a corresponding entry in [packages]. *)
-let validate_packages packages =
+   dependency which doesn't have a corresponding entry in [packages] and is
+   not in [external_packages]. The [external_packages] set names dependency
+   targets that callers vouch for outside the lockdir (e.g. workspace
+   packages whose install entries are materialised by the build path). *)
+let validate_packages packages ~external_packages =
   let missing_dependencies =
     Packages.to_pkg_list packages
     |> List.concat_map ~f:(fun (dependant_package : Pkg.t) ->
@@ -1163,6 +1166,7 @@ let validate_packages packages =
           if
             Package_name.Map.mem packages depend.name
             || Package_name.equal depend.name Dune_dep.name
+            || Package_name.Set.mem external_packages depend.name
           then None
           else Some { dependant_package; dependency = depend.name; loc = depend.loc })))
   in
@@ -1184,7 +1188,11 @@ let create_latest_version
     Package_name.Map.map packages ~f:(fun (pkg : Pkg.t) ->
       Package_version.Map.singleton pkg.info.version pkg)
   in
-  (match validate_packages packages with
+  (* The solver rejects workspace dependencies, so a well-formed solver
+     output should never contain references to packages outside the
+     lockdir. We pass [external_packages:empty] here so this assert catches
+     any solver bug that lets such a reference slip through. *)
+  (match validate_packages packages ~external_packages:Package_name.Set.empty with
    | Ok () -> ()
    | Error (`Missing_dependencies missing_dependencies) ->
      List.map missing_dependencies ~f:(fun { dependant_package; dependency; loc = _ } ->
@@ -1658,40 +1666,6 @@ struct
       package_name
   ;;
 
-  let check_packages packages ~lock_dir_path =
-    match validate_packages packages with
-    | Ok () -> Ok ()
-    | Error (`Missing_dependencies missing_dependencies) ->
-      List.iter missing_dependencies ~f:(fun { dependant_package; dependency; loc } ->
-        User_message.prerr
-          (User_message.make
-             ~loc
-             [ Pp.textf
-                 "The package %S depends on the package %S, but %S does not appear in \
-                  the lockdir %s."
-                 (Package_name.to_string dependant_package.info.name)
-                 (Package_name.to_string dependency)
-                 (Package_name.to_string dependency)
-                 (Path.to_string_maybe_quoted lock_dir_path)
-             ]));
-      Error
-        (User_error.make
-           ~hints:
-             [ Pp.concat
-                 ~sep:Pp.space
-                 [ Pp.text
-                     "This could indicate that the lockdir is corrupted. Delete it and \
-                      then regenerate it by running:"
-                 ; User_message.command "dune pkg lock"
-                 ]
-             ]
-           [ Pp.textf
-               "At least one package dependency is itself not present as a package in \
-                the lockdir %s."
-               (Path.to_string_maybe_quoted lock_dir_path)
-           ])
-  ;;
-
   let load lock_dir_path =
     let event =
       Dune_trace.(
@@ -1735,25 +1709,15 @@ struct
         pkg)
       >>| Packages.of_pkg_list
     in
-    let result =
-      check_packages packages ~lock_dir_path
-      |> Result.map ~f:(fun () ->
-        { version
-        ; dependency_hash
-        ; packages
-        ; ocaml
-        ; repos
-        ; expanded_solver_variable_bindings
-        ; solved_for_platforms
-        })
-    in
     Option.iter (Dune_trace.global ()) ~f:(fun trace -> Dune_trace.Out.finish trace event);
-    result
-  ;;
-
-  let load_exn lock_dir_path =
-    let open Io.O in
-    load lock_dir_path >>| User_error.ok_exn
+    { version
+    ; dependency_hash
+    ; packages
+    ; ocaml
+    ; repos
+    ; expanded_solver_variable_bindings
+    ; solved_for_platforms
+    }
   ;;
 end
 
@@ -1771,8 +1735,53 @@ module Load_immediate = Make_load (struct
     let with_lexbuf_from_file = Io.with_lexbuf_from_file
   end)
 
-let read_disk = Load_immediate.load
-let read_disk_exn = Load_immediate.load_exn
+(* Verify every dependency edge in [packages] resolves to a known target:
+   either another package in the lockdir, dune itself, or a name in
+   [external_packages] (typically workspace packages whose install entries
+   are materialised outside the lockdir). *)
+let check_packages packages ~lock_dir_path ~external_packages =
+  match validate_packages packages ~external_packages with
+  | Ok () -> Ok ()
+  | Error (`Missing_dependencies missing_dependencies) ->
+    List.iter missing_dependencies ~f:(fun { dependant_package; dependency; loc } ->
+      User_message.prerr
+        (User_message.make
+           ~loc
+           [ Pp.textf
+               "The package %S depends on the package %S, but %S does not appear in the \
+                lockdir %s."
+               (Package_name.to_string dependant_package.info.name)
+               (Package_name.to_string dependency)
+               (Package_name.to_string dependency)
+               (Path.to_string_maybe_quoted lock_dir_path)
+           ]));
+    Error
+      (User_error.make
+         ~hints:
+           [ Pp.concat
+               ~sep:Pp.space
+               [ Pp.text
+                   "This could indicate that the lockdir is corrupted. Delete it and \
+                    then regenerate it by running:"
+               ; User_message.command "dune pkg lock"
+               ]
+           ]
+         [ Pp.textf
+             "At least one package dependency is itself not present as a package in the \
+              lockdir %s."
+             (Path.to_string_maybe_quoted lock_dir_path)
+         ])
+;;
+
+let read_disk lock_dir_path ~external_packages =
+  let t = Load_immediate.load lock_dir_path in
+  check_packages t.packages ~lock_dir_path ~external_packages
+  |> Result.map ~f:(fun () -> t)
+;;
+
+let read_disk_exn lock_dir_path ~external_packages =
+  read_disk lock_dir_path ~external_packages |> User_error.ok_exn
+;;
 
 let transitive_dependency_closure t ~platform start =
   let missing_packages =

src/dune_pkg/lock_dir.mli

@@ -157,8 +157,27 @@ module Write_disk : sig
   val commit : t -> unit
 end
 
-val read_disk : Path.t -> (t, User_message.t) result
-val read_disk_exn : Path.t -> t
+(** Read a lockdir from disk and verify that every dependency edge resolves
+    to either another package in the lockdir, dune itself, or a name in
+    [external_packages]. Pass [external_packages:Package_name.Set.empty]
+    to require the lockdir to be self-contained; pass workspace package
+    names to permit hand-written lockdirs that reference them. *)
+val read_disk
+  :  Path.t
+  -> external_packages:Package_name.Set.t
+  -> (t, User_message.t) result
+
+val read_disk_exn : Path.t -> external_packages:Package_name.Set.t -> t
+
+(** Verify the dependency graph of a loaded lockdir against an
+    [external_packages] set. Reports each missing edge with its source
+    location and returns a single [User_message.t] describing the overall
+    failure. *)
+val check_packages
+  :  Packages.t
+  -> lock_dir_path:Path.t
+  -> external_packages:Package_name.Set.t
+  -> (unit, User_message.t) result
 
 module Make_load (Io : sig
     include Monad.S
@@ -167,8 +186,10 @@ module Make_load (Io : sig
     val readdir_with_kinds : Path.t -> (Filename.t * Unix.file_kind) list t
     val with_lexbuf_from_file : Path.t -> f:(Lexing.lexbuf -> 'a) -> 'a t
   end) : sig
-  val load : Path.t -> (t, User_message.t) result Io.t
-  val load_exn : Path.t -> t Io.t
+  (** Load a lockdir from disk without validating its dependency graph.
+      Callers are responsible for running {!check_packages} with the
+      appropriate [external_packages] set. *)
+  val load : Path.t -> t Io.t
 end
 
 (** [transitive_dependency_closure t ~platform names] returns the set of package names