Rewrite unused package names

CHANGES.md

@@ -7,6 +7,10 @@
 - Add option `--keep-symlinked-dir` to preserve symlinks in `duniverse/`, which
   can be useful for local development. (#348, #366, @hannesm,
   @Leonidas-from-XIV)
+- Add option `--deduplicate-packages` which can be set to `false` to disable
+  the deduplication of packages, instead it will attempt to rewrite vendored
+  `dune` files to resolve conflicts between multiple identical `public_names`.
+  (#367, @Leonidas-from-XIV)
 
 ### Changed
 

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 =
@@ -522,7 +523,8 @@ let run (`Root root) (`Recurse_opam recurse) (`Build_only build_only)
     (`Allow_jbuilder allow_jbuilder) (`Ocaml_version ocaml_version)
     (`Require_cross_compile require_cross_compile)
     (`Minimal_update minimal_update) (`Config_adjustment adjustment)
-    (`Target_packages specified_packages) (`Lockfile explicit_lockfile) () =
+    (`Target_packages specified_packages) (`Lockfile explicit_lockfile)
+    (`Deduplicate_packages deduplicate_packages) () =
   let open Result.O in
   let* local_packages = local_packages ~versions:specified_packages root in
   let* target_packages =
@@ -545,7 +547,9 @@ 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* 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
@@ -600,6 +604,18 @@ let allow_jbuilder =
     (fun x -> `Allow_jbuilder x)
     Arg.(value & flag & info ~doc [ "allow-jbuilder" ])
 
+let deduplicate_packages =
+  let doc =
+    "If multiple packages are from the same dev-repo, deduplicate them by \
+     picking the one with the highest version. This setting is to avoid \
+     unpacking the same tarball multiple times and thus potentially causing \
+     the build to fail due to duplicated library names."
+  in
+  let info' = Arg.info ~doc [ "deduplicate-packages" ] in
+  Common.Arg.named
+    (fun x -> `Deduplicate_packages x)
+    Arg.(value & opt ~vopt:true bool true info')
+
 let packages =
   let doc =
     "Explicit list of local packages to compute the lockfile from. These can \
@@ -681,6 +697,6 @@ let term =
       const run $ Common.Arg.root $ recurse_opam $ build_only $ allow_jbuilder
       $ ocaml_version $ require_cross_compile $ minimal_update
       $ config_adjustment $ packages $ Common.Arg.lockfile
-      $ Common.Arg.setup_logs ())
+      $ deduplicate_packages $ Common.Arg.setup_logs ())
 
 let cmd = Cmd.v info term

doc/lock.mld

@@ -196,3 +196,40 @@ opam monorepo lock --add-opam-provided [some-other-package]
 When the field is set in multiple opam files and eventually through the
 [--add-opam-provided] option, they are combinded into a set, removing
 duplicates.
+
+{3 Deduplication}
+
+To build the vendored packages, the vendored solution has to be unambigious.
+That means the dune package names have to be unique and not be repeated in
+multiple vendored libraries, otherwise dune will refuse the compilation as it
+is not clear which package is being referenced.
+
+Duplicate package names can sometimes occur if multiple packages from the same
+repository share a tarball, then unpacking the tarball for every package would
+lead to overlaps.
+
+By default [opam monorepo] deduplicates packages from the same repository
+(using the [dev-repo] field of OPAM) and choses just one of the packages. In
+the case of version conflicts where one package has a newer version than
+another, it will pick the one with the newest version.
+
+While this is a working solution for a lot of cases, this can lead to issues
+where it might seem that the version constraints are not respected.
+
+If this leads to issues, there exists the experimental option
+[--deduplicate-packages=false] to disable the behavior. In such case the
+vendored source code will be duplicated. To rectify this, on [pull] the
+vendored source trees will be rewritten, attempting to deduplicate package
+names in [dune] files.
+
+To use this feature, lock your project with this command:
+
+{[
+opam monorepo lock --deduplicate-packages=false
+]}
+
+The generated lockfile will be slightly different, as it will now include every
+package, so the amount of packages reported as locked might go up slightly.
+
+From there a regular [opam monorepo pull] will make sure to rewrite the pulled
+source trees automatically.

lib/dune_file.ml

@@ -67,6 +67,138 @@ module Lang = struct
   let duniverse_minimum_version = (1, 11)
 end
 
+module Packages = struct
+  open Sexplib0.Sexp
+  module Set = Set.Make (String)
+  module Map = Map.Make (String)
+
+  type t = Digest.t
+
+  let init disambiguation = Digest.string disambiguation
+  let random_valid_identifier t = Digest.to_hex t
+
+  let random_public_name v original =
+    let suffix = random_valid_identifier v in
+    (* needs to start with `old.` to be part of the same package *)
+    Fmt.str "%s.%s" original suffix
+
+  let random_library_name v original =
+    let suffix = random_valid_identifier v in
+    (* needs not to have a dot *)
+    Fmt.str "%s_%s" original suffix
+
+  let find_by_name name stanzas =
+    let matches =
+      List.filter_map stanzas ~f:(function
+        | List [ Atom candidate; Atom value ] -> (
+            match String.equal candidate name with
+            | true -> Some value
+            | false -> None)
+        | _ -> None)
+    in
+    match matches with [] -> None | [ x ] -> Some x | _ -> None
+
+  type 'a rename_result = {
+    changed : bool;
+    stanzas : 'a;
+    renames : string Map.t;
+  }
+
+  (* determine whether the package should be kept or not, handles [pkg.name] and [pkg] *)
+  let should_keep ~keep name =
+    let test_against =
+      match Base.String.lsplit2 name ~on:'.' with
+      | Some (package, _name) -> package
+      | None -> name
+    in
+    Set.mem test_against keep
+
+  let rename_library t ~keep renames stanzas =
+    let public_name = find_by_name "public_name" stanzas in
+    let name = find_by_name "name" stanzas in
+    match public_name with
+    | None -> { changed = false; stanzas; renames }
+    | Some public_name -> (
+        match should_keep ~keep public_name with
+        | true -> { changed = false; stanzas; renames }
+        | false ->
+            let stanzas =
+              List.filter stanzas ~f:(function
+                | List (Atom "public_name" :: _) -> false
+                | _ -> true)
+            in
+            let new_public_name = random_public_name t public_name in
+            let stanzas =
+              List [ Atom "public_name"; Atom new_public_name ] :: stanzas
+            in
+
+            let stanzas, renames =
+              match name with
+              | Some name ->
+                  let renames = Map.add ~key:public_name ~data:name renames in
+                  (stanzas, renames)
+              | None ->
+                  let new_name = random_library_name t public_name in
+                  let stanzas =
+                    List [ Atom "name"; Atom new_name ] :: stanzas
+                  in
+                  let renames =
+                    Map.add ~key:public_name ~data:new_name renames
+                  in
+                  (stanzas, renames)
+            in
+            { changed = true; stanzas; renames })
+
+  let rename_one t ~keep renames = function
+    | List (Atom "library" :: stanzas) ->
+        let { changed; stanzas; renames } =
+          rename_library t ~keep renames stanzas
+        in
+        { changed; stanzas = List (Atom "library" :: stanzas); renames }
+    | stanzas -> { changed = false; stanzas; renames }
+
+  let translate_lib renames = function
+    | Atom old_name as original -> (
+        match Map.find_opt old_name renames with
+        | Some new_name -> Atom new_name
+        | None -> original)
+    | otherwise -> otherwise
+
+  let rec translate renames = function
+    | Atom _ as original -> original
+    | List ((Atom "libraries" as stanza) :: libs) ->
+        let libs = List.map ~f:(translate_lib renames) libs in
+        List (stanza :: libs)
+    | List sexps ->
+        let sexps = List.map ~f:(translate renames) sexps in
+        List sexps
+
+  let update_references renames = List.map ~f:(translate renames)
+
+  let rename t ~keep renames sexps =
+    let keep = Set.of_list keep in
+    let changed = false in
+    match sexps with
+    | List (Atom "*" :: Atom "-*-" :: Atom "tuareg" :: Atom "-*-" :: _) :: _ ->
+        (* if the first sexp is the tuareg stanza, then it is an ocaml file,
+           do not modify *)
+        { changed; stanzas = sexps; renames }
+    | sexps ->
+        let { changed; stanzas; renames } =
+          List.fold_left
+            ~f:(fun { changed; stanzas = acc; renames } sexp ->
+              let { changed = recursively_changed; stanzas = v; renames } =
+                rename_one t ~keep renames sexp
+              in
+              let changed = changed || recursively_changed in
+              { changed; stanzas = v :: acc; renames })
+            ~init:{ changed; stanzas = []; renames }
+            sexps
+        in
+        let stanzas = List.rev stanzas in
+        { changed; stanzas; renames }
+end
+
 module Raw = struct
   let as_sexps path =
     try Ok (Sexplib.Sexp.load_sexps (Fpath.to_string path)) with
@@ -96,8 +228,6 @@ module Raw = struct
 end
 
 module Project = struct
-  module OV = Ocaml_version
-
   let rec name sexps =
     match (sexps : Sexplib0.Sexp.t list) with
     | [] -> Error (`Msg "Missing a name field in the dune-project file")

lib/dune_file.mli

@@ -29,6 +29,30 @@ module Lang : sig
       Return the string unmodified if there was previously no lang stanza. *)
 end
 
+module Packages : sig
+  module Map : Stdext.Map.S
+
+  type t
+
+  val init : string -> t
+
+  type 'a rename_result = {
+    changed : bool;
+    stanzas : 'a;
+    renames : string Map.t;
+  }
+
+  val rename :
+    t ->
+    keep:string list ->
+    string Map.t ->
+    Sexplib0.Sexp.t list ->
+    Sexplib0.Sexp.t list rename_result
+
+  val update_references :
+    string Map.t -> Sexplib0.Sexp.t list -> Sexplib0.Sexp.t list
+end
+
 module Project : sig
   val name : Sexplib0.Sexp.t list -> (string, [> `Msg of string ]) result
   (** Returns the dune-project's name given the content of the file as a list of S-expressions,