Error when multiple dev-repos collide on dir

The duniverse directory of a package is implied by its dev-repo. It's
possible for different dev-repos to map to the same directory. Prior to
this change, one lucky package would be downloaded to the expected place
and the others would be silently ignored. More precisely, each package
would be downloaded and placed in the duniverse dir implied by their
dev-repo, but first any existing duniverse dir of the same name would be
removed.

After this change, the same situation results in an error when running
`opam monorepo lock`.

Signed-off-by: Stephen Sherratt <stephen@sherra.tt>

CHANGES.md

@@ -18,6 +18,9 @@
 
 ### Fixed
 
+- Error in case where multiple packages with different dev-repo fields would be
+  placed in the same duniverse directory (#377, @gridbugs)
+
 ### Removed
 
 ### Security

lib/dev_repo.ml

@@ -5,6 +5,7 @@ type t = string
 let compare = String.compare
 let from_string s = s
 let to_string t = t
+let pp fmt t = Format.fprintf fmt "%s" t
 
 let rec repeat_while_some x ~f =
   match f x with None -> x | Some x -> repeat_while_some x ~f

lib/dev_repo.mli

@@ -4,6 +4,7 @@ type t
 
 val from_string : string -> t
 val to_string : t -> string
+val pp : t Fmt.t
 
 val repo_name : t -> (string, Rresult.R.msg) result
 (** Computes a name for the repo by applying the following method:

lib/duniverse.ml

@@ -231,6 +231,58 @@ let dev_repo_map_from_packages packages =
         | Some pkgs -> Some (pkg :: pkgs)
         | None -> Some [ pkg ]))
 
+(* converts a map from dev-repos to lists of packages to a list of repos after
+   checking for errors *)
+let dev_repo_package_map_to_repos dev_repo_package_map =
+  let open Result.O in
+  let dev_repo_to_repo_result_map =
+    Dev_repo.Map.mapi dev_repo_package_map ~f:(fun dev_repo pkgs ->
+        Repo.from_packages ~dev_repo pkgs)
+  in
+  (* Handle any errors relating to individual repos but maintain the
+     association between dev-repo and repo for further error checking. *)
+  let* repo_by_dev_repo =
+    Dev_repo.Map.bindings dev_repo_to_repo_result_map
+    |> List.map ~f:(fun (dev_repo, repo_result) ->
+           Result.map (fun repo -> (dev_repo, repo)) repo_result)
+    |> Base.Result.all
+  in
+  (* Detect the case where multiple different dev-repos are associated with the
+     same duniverse directory. *)
+  let* () =
+    let dev_repos_by_dir =
+      List.fold_left repo_by_dev_repo ~init:String.Map.empty
+        ~f:(fun acc (dev_repo, (repo : _ Repo.t)) ->
+          String.Map.update acc repo.dir ~f:(function
+            | None -> Some [ dev_repo ]
+            | Some dev_repos -> Some (dev_repo :: dev_repos)))
+      |> String.Map.bindings
+    in
+    match
+      List.find_opt dev_repos_by_dir ~f:(fun (_, dev_repos) ->
+          List.length dev_repos > 1)
+    with
+    | None -> Ok ()
+    | Some (dir, dev_repos) ->
+        let dir_path = Fpath.(Config.vendor_dir / dir) in
+        let message_first_line =
+          Format.asprintf
+            "Multiple dev-repos would be vendored into the directory: %a"
+            Fpath.pp dir_path
+        in
+        let message_dev_repos =
+          Format.sprintf "Dev-repos:\n%s"
+            (List.map dev_repos ~f:(fun dev_repo ->
+                 Format.asprintf "- %a" Dev_repo.pp dev_repo)
+            |> String.concat ~sep:"\n")
+        in
+        let message =
+          [ message_first_line; message_dev_repos ] |> String.concat ~sep:"\n"
+        in
+        Error (`Msg message)
+  in
+  Ok (List.map ~f:snd repo_by_dev_repo)
+
 let from_dependency_entries ~get_default_branch dependencies =
   let open Result.O in
   let summaries =
@@ -247,10 +299,7 @@ let from_dependency_entries ~get_default_branch dependencies =
   let* pkg_opts = Base.Result.all results in
   let pkgs = Base.List.filter_opt pkg_opts in
   let dev_repo_map = dev_repo_map_from_packages pkgs in
-  Dev_repo.Map.fold dev_repo_map ~init:[]
-    ~f:(fun ~key:dev_repo ~data:pkgs acc ->
-      Repo.from_packages ~dev_repo pkgs :: acc)
-  |> Base.Result.all
+  dev_repo_package_map_to_repos dev_repo_map
 
 let resolve ~resolve_ref t =
   Parallel.map ~f:(Repo.resolve ~resolve_ref) t |> Base.Result.all

test/bin/error-on-directory-conflict.t/repo/packages/bar/bar.0.1.0/opam

@@ -0,0 +1,12 @@
+opam-version: "2.0"
+dev-repo: "git+https://github.com/bar/project"
+depends: [
+  "dune"
+]
+build: [ "dune" "build" ]
+url {
+  src: "https://test.com/bar.tbz"
+  checksum: [
+    "sha256=0000000000000000000000000000000000000000000000000000000000000000"
+  ]
+}

test/bin/error-on-directory-conflict.t/repo/packages/foo-branch/foo-branch.0.1.0/opam

@@ -0,0 +1,12 @@
+opam-version: "2.0"
+dev-repo: "git+https://github.com/foo/project.git#branch"
+depends: [
+  "dune"
+]
+build: [ "dune" "build" ]
+url {
+  src: "https://test.com/foo-branch.tbz"
+  checksum: [
+    "sha256=0000000000000000000000000000000000000000000000000000000000000000"
+  ]
+}

test/bin/error-on-directory-conflict.t/repo/packages/foo/foo.0.1.0/opam

@@ -0,0 +1,12 @@
+opam-version: "2.0"
+dev-repo: "git+https://github.com/foo/project"
+depends: [
+  "dune"
+]
+build: [ "dune" "build" ]
+url {
+  src: "https://test.com/foo.tbz"
+  checksum: [
+    "sha256=0000000000000000000000000000000000000000000000000000000000000000"
+  ]
+}

test/bin/error-on-directory-conflict.t/run.t

@@ -0,0 +1,16 @@
+We have a project which depends on multiple packages with different dev-repos
+but which happen to resolve to the same directory under duniverse. This tests
+that such a situation results in an explicit error.
+
+  $ gen-minimal-repo
+  $ opam-monorepo lock
+  ==> Using 1 locally scanned package as the target.
+  ==> Found 11 opam dependencies for the target package.
+  ==> Querying opam database for their metadata and Dune compatibility.
+  ==> Calculating exact pins for each of them.
+  opam-monorepo: [ERROR] Multiple dev-repos would be vendored into the directory: duniverse/project
+  Dev-repos:
+  - git+https://github.com/foo/project.git#branch
+  - git+https://github.com/foo/project
+  - git+https://github.com/bar/project
+  [1]

test/bin/error-on-directory-conflict.t/x.opam

@@ -0,0 +1,10 @@
+opam-version: "2.0"
+depends: [
+  "foo"
+  "foo-branch"
+  "bar"
+]
+x-opam-monorepo-opam-repositories: [
+  "file://$OPAM_MONOREPO_CWD/minimal-repo"
+  "file://$OPAM_MONOREPO_CWD/repo"
+]