WIP: disable deduplication

cli/lock.ml

@@ -61,11 +61,12 @@ let opam_to_git_remote remote =
   | Some ("git", remote) -> remote
   | _ -> remote
 
-let compute_duniverse ~dependency_entries =
+let compute_duniverse ~deduplicate_packages ~dependency_entries =
   let get_default_branch remote =
     D.Exec.git_default_branch ~remote:(opam_to_git_remote remote) ()
   in
-  D.Duniverse.from_dependency_entries ~get_default_branch dependency_entries
+  D.Duniverse.from_dependency_entries ~deduplicate_packages ~get_default_branch
+    dependency_entries
 
 let resolve_ref deps =
   let resolve_ref ~repo ~ref =
@@ -545,7 +546,10 @@ let run (`Root root) (`Recurse_opam recurse) (`Build_only build_only)
       ~local_opam_files:opam_files ~target_packages
   in
   Common.Logs.app (fun l -> l "Calculating exact pins for each of them.");
-  let* duniverse = compute_duniverse ~dependency_entries >>= resolve_ref in
+  let deduplicate_packages = true in
+  let* duniverse =
+    compute_duniverse ~deduplicate_packages ~dependency_entries >>= resolve_ref
+  in
   let target_depexts = target_depexts opam_files target_packages in
   let lockfile =
     D.Lockfile.create ~source_config ~root_packages:target_packages

lib/duniverse.ml

@@ -146,41 +146,49 @@ module Repo = struct
     Dev_repo.repo_name dev_repo
     |> Base.Result.map ~f:(function "dune" -> "dune_" | name -> name)
 
-  let from_packages ~dev_repo (packages : Package.t list) =
-    let open Result.O in
-    let provided_packages = List.map packages ~f:(fun p -> p.Package.opam) in
-    let dune_packages =
-      List.map packages ~f:(fun p -> p.Package.dune_packages) |> List.concat
-    in
-    let* dir = dir_name_from_dev_repo dev_repo in
-    let urls =
-      let add acc p =
-        Unresolved_url_map.set acc p.Package.url p.Package.hashes
-      in
-      List.fold_left packages ~init:Unresolved_url_map.empty ~f:add
-      |> Unresolved_url_map.bindings
-    in
-    match urls with
-    | [ (url, hashes) ] ->
-        Ok { dir; url; hashes; provided_packages; dune_packages }
-    | _ ->
-        (* If packages from the same repo were resolved to different URLs, we need to pick
-           a single one. Here we decided to go with the one associated with the package
-           that has the higher version. We need a better long term solution as this won't
-           play nicely with pins for instance.
-           The best solution here would be to use source trimming, so we can pull each individual
-           package to its own directory and strip out all the unrelated source code but we would
-           need dune to provide that feature. *)
-        let* highest_version_package =
-          Base.List.max_elt packages ~compare:(fun p p' ->
-              OpamPackage.Version.compare p.Package.opam.version p'.opam.version)
-          |> Base.Result.of_option
-               ~error:(Rresult.R.msg "No packages to compare, internal failure")
+  let from_packages ~deduplicate_packages ~dev_repo (packages : Package.t list)
+      =
+    match deduplicate_packages with
+    | false -> failwith "TODO"
+    | true -> (
+        let open Result.O in
+        let provided_packages =
+          List.map packages ~f:(fun p -> p.Package.opam)
+        in
+        let dune_packages =
+          List.map packages ~f:(fun p -> p.Package.dune_packages) |> List.concat
+        in
+        let* dir = dir_name_from_dev_repo dev_repo in
+        let urls =
+          let add acc p =
+            Unresolved_url_map.set acc p.Package.url p.Package.hashes
+          in
+          List.fold_left packages ~init:Unresolved_url_map.empty ~f:add
+          |> Unresolved_url_map.bindings
         in
-        log_url_selection ~dev_repo ~packages ~highest_version_package;
-        let url = highest_version_package.url in
-        let hashes = highest_version_package.hashes in
-        Ok { dir; url; hashes; provided_packages; dune_packages }
+        match urls with
+        | [ (url, hashes) ] ->
+            Ok { dir; url; hashes; provided_packages; dune_packages }
+        | _ ->
+            (* If packages from the same repo were resolved to different URLs, we need to pick
+               a single one. Here we decided to go with the one associated with the package
+               that has the higher version. We need a better long term solution as this won't
+               play nicely with pins for instance.
+               The best solution here would be to use source trimming, so we can pull each individual
+               package to its own directory and strip out all the unrelated source code but we would
+               need dune to provide that feature. *)
+            let* highest_version_package =
+              Base.List.max_elt packages ~compare:(fun p p' ->
+                  OpamPackage.Version.compare p.Package.opam.version
+                    p'.opam.version)
+              |> Base.Result.of_option
+                   ~error:
+                     (Rresult.R.msg "No packages to compare, internal failure")
+            in
+            log_url_selection ~dev_repo ~packages ~highest_version_package;
+            let url = highest_version_package.url in
+            let hashes = highest_version_package.hashes in
+            Ok { dir; url; hashes; provided_packages; dune_packages })
 
   let equal equal_ref t t' =
     let { dir; url; hashes; provided_packages; dune_packages } = t in
@@ -232,7 +240,8 @@ let dev_repo_map_from_packages packages =
         | Some pkgs -> Some (pkg :: pkgs)
         | None -> Some [ pkg ]))
 
-let from_dependency_entries ~get_default_branch dependencies =
+let from_dependency_entries ~deduplicate_packages ~get_default_branch
+    dependencies =
   let open Result.O in
   let summaries =
     List.filter_map
@@ -250,7 +259,7 @@ let from_dependency_entries ~get_default_branch dependencies =
   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)
+      Repo.from_packages ~deduplicate_packages ~dev_repo pkgs :: acc)
   |> Base.Result.all
 
 let resolve ~resolve_ref t =

lib/duniverse.mli

@@ -51,6 +51,7 @@ module Repo : sig
   end
 
   val from_packages :
+    deduplicate_packages:bool ->
     dev_repo:Dev_repo.t ->
     Package.t list ->
     (unresolved t, Rresult.R.msg) result
@@ -64,6 +65,7 @@ type t = resolved Repo.t list
 val equal : t -> t -> bool
 
 val from_dependency_entries :
+  deduplicate_packages:bool ->
   get_default_branch:(string -> (string, Rresult.R.msg) result) ->
   Opam.Dependency_entry.t list ->
   (unresolved Repo.t list, [ `Msg of string ]) result

test/lib/test_duniverse.ml

@@ -131,7 +131,7 @@ module Repo = struct
       let test_name = Printf.sprintf "Repo.from_packages: %s" name in
       let test_fun () =
         let dev_repo = Dev_repo.from_string dev_repo in
-        let actual = Duniverse.Repo.from_packages ~dev_repo packages in
+        let actual = Duniverse.Repo.from_packages ~deduplicate_packages:true ~dev_repo packages in
         Alcotest.(check (result Testable.Repo.unresolved Testable.r_msg))
           test_name expected actual
       in
@@ -248,7 +248,7 @@ let test_from_dependency_entries =
     let test_name = Printf.sprintf "from_dependency_entries: %s" name in
     let test_fun () =
       let actual =
-        Duniverse.from_dependency_entries ~get_default_branch dependency_entries
+        Duniverse.from_dependency_entries ~deduplicate_packages:true ~get_default_branch dependency_entries
       in
       Alcotest.(check (result (list Testable.Repo.unresolved) Testable.r_msg))
         test_name expected actual