Allow top-level libraries in old_public_name

CHANGES.md

@@ -164,6 +164,13 @@
   stanza as well as the `(foreign_stubs ...)` and `(foreign_archives ...)` fields.
   (#2659, RFC #2650, @snowleopard)
 
+- Add (deprecated_package_names) field to (package) declaration in
+  dune-project. The names declared here can be used in the (old_public_name)
+  field of (deprecated_library_name) stanza. These names are interpreted as
+  library names (not prefixed by a package name) and appropiate redirections are
+  setup in their META files. This feaure is meant to migrate old libraries which
+  do not follow Dune's convention of prefixing libraries with the package
+  name. (#2696, @nojb)
 
 1.11.4 (09/10/2019)
 -------------------

doc/dune-files.rst

@@ -237,6 +237,11 @@ It contains the following fields:
 
 - ``(tags <tags>)`` are the list of tags for the package
 
+- ``(deprecated_package_names <name list>)`` is a list of names that can be used
+  with the :ref:`deprecated-library-name` stanza to migrate legacy libraries
+  from other build systems which do not follow Dune's convention of prefixing
+  the public name of the library with the package name.
+
 The list of dependencies ``<dep-specification>`` is modeled after opam's own
 language: The syntax is as a list of the following elements:
 
@@ -494,6 +499,8 @@ JavaScript output.
 
 See :ref:`jsoo` for more information.
 
+.. _deprecated-library-name:
+
 deprecated_library_name
 -----------------------
 
@@ -512,6 +519,13 @@ dependencies, it will be transparently replaced by the new name. Note
 that it is not necessary for the new name to exist at definition time
 as it is only resolved at the point where the old name is used.
 
+The ``old_public_name`` can also be one of the names declared in the
+``deprecated_package_names`` field of the package declaration in
+``dune-project`` file. In this case, the "old" library is understood to be a
+library whose name is not prefixed by the package name. Such a library cannot be
+defined in Dune, but other build systems allow it and this feature is meant to
+help migration from those systems.
+
 executable
 ----------
 

src/dune/dialect.ml

@@ -14,10 +14,11 @@ module File_kind = struct
       [ ("kind", Ml_kind.to_dyn kind)
       ; ("extension", string extension)
       ; ( "preprocess"
-        , option (pair Loc.to_dyn Action_dune_lang.to_dyn) preprocess )
+        , option (fun (_, x) -> Action_dune_lang.to_dyn x) preprocess )
       ; ( "format"
         , option
-            (triple Loc.to_dyn Action_dune_lang.to_dyn (list string))
+            (fun (_, x, y) ->
+              pair Action_dune_lang.to_dyn (list string) (x, y))
             format )
       ]
 end

src/dune/dune_file.ml

@@ -598,27 +598,42 @@ module Public_lib = struct
 
   let name t = snd t.name
 
-  let make project ((_, s) as loc_name) =
+  let package t = t.package
+
+  let make ?(allow_deprecated_names = false) project ((_, s) as loc_name) =
     let pkg, rest = Lib_name.split s in
-    Result.map (Pkg.resolve project pkg) ~f:(fun pkg ->
-        { package = pkg
-        ; sub_dir =
-            ( if rest = [] then
-              None
+    let x =
+      if not allow_deprecated_names then
+        None
+      else
+        List.find_map
+          (Package.Name.Map.values (Dune_project.packages project))
+          ~f:(fun ({ deprecated_package_names; _ } as package) ->
+            if Package.Name.Map.mem deprecated_package_names pkg then
+              Some { package; sub_dir = None; name = loc_name }
             else
-              Some (String.concat rest ~sep:"/") )
-        ; name = loc_name
-        })
-
-  let public_name_field =
+              None)
+    in
+    match x with
+    | Some x -> Ok x
+    | None ->
+      Result.map (Pkg.resolve project pkg) ~f:(fun pkg ->
+          { package = pkg
+          ; sub_dir =
+              ( if rest = [] then
+                None
+              else
+                Some (String.concat rest ~sep:"/") )
+          ; name = loc_name
+          })
+
+  let decode ?allow_deprecated_names () =
     map_validate
       (let+ project = Dune_project.get_exn ()
-       and+ loc_name = field_o "public_name" (located Lib_name.decode) in
+       and+ loc_name = located Lib_name.decode in
        (project, loc_name))
       ~f:(fun (project, loc_name) ->
-        match loc_name with
-        | None -> Ok None
-        | Some x -> Result.map (make project x) ~f:Option.some)
+        make ?allow_deprecated_names project loc_name)
 end
 
 module Mode_conf = struct
@@ -808,7 +823,7 @@ module Library = struct
       (let+ buildable = Buildable.decode ~in_library:true ~allow_re_export:true
        and+ loc = loc
        and+ name = field_o "name" Lib_name.Local.decode_loc
-       and+ public = Public_lib.public_name_field
+       and+ public = field_o "public_name" (Public_lib.decode ())
        and+ synopsis = field_o "synopsis" string
        and+ install_c_headers =
          field "install_c_headers" (repeat string) ~default:[]
@@ -1918,7 +1933,7 @@ module Coq = struct
     fields
       (let+ name = field "name" Lib_name.Local.decode_loc
        and+ loc = loc
-       and+ public = Public_lib.public_name_field
+       and+ public = field_o "public_name" (Public_lib.decode ())
        and+ synopsis = field_o "synopsis" string
        and+ flags = Ordered_set_lang.Unexpanded.field "flags"
        and+ modules = modules_field "modules"
@@ -2113,26 +2128,38 @@ module Include_subdirs = struct
 end
 
 module Deprecated_library_name = struct
+  module Old_public_name = struct
+    type t =
+      { deprecated : bool
+      ; public : Public_lib.t
+      }
+
+    let decode =
+      let+ public = Public_lib.decode ~allow_deprecated_names:true () in
+      let deprecated =
+        not
+          (Package.Name.equal
+             (Lib_name.package_name (Public_lib.name public))
+             (Public_lib.package public).name)
+      in
+      { deprecated; public }
+  end
+
   type t =
     { loc : Loc.t
     ; project : Dune_project.t
-    ; old_public_name : Public_lib.t
-    ; new_public_name : Lib_name.t
+    ; old_public_name : Old_public_name.t
+    ; new_public_name : Loc.t * Lib_name.t
     }
 
   let decode =
     fields
       (let+ loc = loc
        and+ project = Dune_project.get_exn ()
-       and+ old_public_name =
-         map_validate
-           (let+ project = Dune_project.get_exn ()
-            and+ loc_name =
-              field "old_public_name" (located Lib_name.decode)
-            in
-            (project, loc_name))
-           ~f:(fun (project, loc_name) -> Public_lib.make project loc_name)
-       and+ new_public_name = field "new_public_name" Lib_name.decode in
+       and+ old_public_name = field "old_public_name" Old_public_name.decode
+       and+ new_public_name =
+         field "new_public_name" (located Lib_name.decode)
+       in
        { loc; project; old_public_name; new_public_name })
 end
 

src/dune/dune_file.mli

@@ -119,6 +119,8 @@ module Public_lib : sig
     }
 
   val name : t -> Lib_name.t
+
+  val package : t -> Package.t
 end
 
 module Mode_conf : sig
@@ -464,11 +466,18 @@ module Include_subdirs : sig
 end
 
 module Deprecated_library_name : sig
+  module Old_public_name : sig
+    type t =
+      { deprecated : bool
+      ; public : Public_lib.t
+      }
+  end
+
   type t =
     { loc : Loc.t
     ; project : Dune_project.t
-    ; old_public_name : Public_lib.t
-    ; new_public_name : Lib_name.t
+    ; old_public_name : Old_public_name.t
+    ; new_public_name : Loc.t * Lib_name.t
     }
 end
 

src/dune/dune_package.ml

@@ -194,6 +194,14 @@ module Lib = struct
   let wrapped t = Option.map t.modules ~f:Modules.wrapped
 
   let info dp = dp.info
+
+  let to_dyn { info; modules; main_module_name } =
+    let open Dyn.Encoder in
+    record
+      [ ("info", Lib_info.to_dyn Path.to_dyn info)
+      ; ("modules", option Modules.to_dyn modules)
+      ; ("main_module_name", option Module_name.to_dyn main_module_name)
+      ]
 end
 
 module Deprecated_library_name = struct
@@ -218,6 +226,13 @@ module Deprecated_library_name = struct
       [ field "old_public_name" Lib_name.encode old_public_name
       ; field "new_public_name" Lib_name.encode new_public_name
       ]
+
+  let to_dyn { loc = _; old_public_name; new_public_name } =
+    let open Dyn.Encoder in
+    record
+      [ ("old_public_name", Lib_name.to_dyn old_public_name)
+      ; ("new_public_name", Lib_name.to_dyn new_public_name)
+      ]
 end
 
 module Entry = struct
@@ -242,6 +257,13 @@ module Entry = struct
       , let+ x = Deprecated_library_name.decode in
         Deprecated_library_name x )
     ]
+
+  let to_dyn x =
+    let open Dyn.Encoder in
+    match x with
+    | Library lib -> constr "Library" [ Lib.to_dyn lib ]
+    | Deprecated_library_name lib ->
+      constr "Deprecated_library_name" [ Deprecated_library_name.to_dyn lib ]
 end
 
 type t =
@@ -304,6 +326,15 @@ let encode ~dune_version { entries; name; version; dir } =
   in
   prepend_version ~dune_version (List.concat [ sexp; entries ])
 
+let to_dyn { entries; name; version; dir } =
+  let open Dyn.Encoder in
+  record
+    [ ("entries", list Entry.to_dyn entries)
+    ; ("name", Package.Name.to_dyn name)
+    ; ("version", option string version)
+    ; ("dir", Path.to_dyn dir)
+    ]
+
 module Or_meta = struct
   type nonrec t =
     | Use_meta
@@ -326,4 +357,16 @@ module Or_meta = struct
 
   let load p =
     Vfile.load p ~f:(fun lang -> decode ~lang ~dir:(Path.parent_exn p))
+
+  let pp ~dune_version ppf t =
+    let t = encode ~dune_version t in
+    Format.fprintf ppf "%a@."
+      (Fmt.list ~pp_sep:Fmt.nl Dune_lang.Deprecated.pp)
+      t
+
+  let to_dyn x =
+    let open Dyn.Encoder in
+    match x with
+    | Use_meta -> constr "Use_meta" []
+    | Dune_package t -> constr "Dune_package" [ to_dyn t ]
 end

src/dune/dune_package.mli

@@ -22,6 +22,8 @@ module Lib : sig
     -> main_module_name:Module_name.t option
     -> modules:Modules.t option
     -> t
+
+  val to_dyn : t Dyn.Encoder.t
 end
 
 module Deprecated_library_name : sig
@@ -30,6 +32,8 @@ module Deprecated_library_name : sig
     ; old_public_name : Lib_name.t
     ; new_public_name : Lib_name.t
     }
+
+  val to_dyn : t Dyn.Encoder.t
 end
 
 module Entry : sig
@@ -40,6 +44,8 @@ module Entry : sig
   val name : t -> Lib_name.t
 
   val version : t -> string option
+
+  val to_dyn : t Dyn.Encoder.t
 end
 
 type t =
@@ -49,12 +55,19 @@ type t =
   ; dir : Path.t
   }
 
+val to_dyn : t Dyn.Encoder.t
+
 module Or_meta : sig
   type nonrec t =
     | Use_meta
     | Dune_package of t
 
   val encode : dune_version:Dune_lang.Syntax.Version.t -> t -> Dune_lang.t list
 
+  val pp :
+    dune_version:Dune_lang.Syntax.Version.t -> Format.formatter -> t -> unit
+
   val load : Dpath.t -> t
+
+  val to_dyn : t Dyn.Encoder.t
 end

src/dune/dune_project.ml

@@ -725,6 +725,26 @@ let parse ~dir ~lang ~opam_packages ~file =
                    name
                ]
          | _, _ -> () );
+         let package_defined_twice name loc1 loc2 =
+           User_error.raise
+             [ Pp.textf "Package name %s is defined twice:"
+                 (Package.Name.to_string name)
+             ; Pp.textf "- %s" (Loc.to_file_colon_line loc1)
+             ; Pp.textf "- %s" (Loc.to_file_colon_line loc2)
+             ]
+         in
+         let deprecated_package_names =
+           List.fold_left packages ~init:Package.Name.Map.empty
+             ~f:(fun acc { Package.deprecated_package_names; _ } ->
+               Package.Name.Map.union acc deprecated_package_names
+                 ~f:package_defined_twice)
+         in
+         List.iter packages ~f:(fun p ->
+             match
+               Package.Name.Map.find deprecated_package_names p.Package.name
+             with
+             | None -> ()
+             | Some loc -> package_defined_twice p.Package.name loc p.loc);
          match
            Package.Name.Map.of_list_map packages ~f:(fun p -> (p.name, p))
          with
@@ -870,6 +890,7 @@ let load ~dir ~files ~infer_from_opam_files =
                ; description = None
                ; kind = Opam
                ; tags = []
+               ; deprecated_package_names = Package.Name.Map.empty
                })
           in
           (name, (loc, pkg)) :: acc)