Merge pull request #1188 from rgrinberg/wrapped-transition

Fix #985

CHANGES.md

@@ -38,6 +38,10 @@ next
 
 - Improve message suggesting to remove parentheses (#1196, fix #1173, @emillon)
 
+- Add `(wrapped (transition "..message.."))` as an option that will generate
+  wrapped modules but keep unwrapped modules with a deprecation message to
+  preserve compatibility. (#1188, fix #985, @rgrinberg)
+
 1.1.1 (08/08/2018)
 ------------------
 

doc/dune-files.rst

@@ -96,6 +96,13 @@ to use the :ref:`include_subdirs` stanza.
   only intended for libraries that manually prefix all their modules by the
   library name and to ease porting of existing projects to dune
 
+- ``(wrapped (transition <message>))`` Is the same as ``(wrapped true)`` except
+  that it will also generate unwrapped (not prefixed by the library name)
+  modules to preserve compatibility. This is useful for libraries that would
+  like to transition from ``(wrapped false)`` to ``(wrapped true)`` without
+  breaking compatibility for users. The ``<message>`` will be included in the
+  deprecation notice for the unwrapped modules.
+
 - ``(preprocess <preprocess-spec>)`` specifies how to preprocess files if
   needed. The default is ``no_processing``. Other options are described in the
   `Preprocessing specification`_ section

src/cm_kind.ml

@@ -1,3 +1,5 @@
+open Stdune
+
 type t = Cmi | Cmo | Cmx
 
 let all = [Cmi; Cmo; Cmx]
@@ -35,3 +37,10 @@ module Dict = struct
     ; cmx = x
     }
 end
+
+let to_sexp =
+  let open Sexp.To_sexp in
+  function
+  | Cmi -> string "cmi"
+  | Cmo -> string "cmo"
+  | Cmx -> string "cmx"

src/cm_kind.mli

@@ -1,3 +1,5 @@
+open Stdune
+
 type t = Cmi | Cmo | Cmx
 
 val all : t list
@@ -5,6 +7,8 @@ val all : t list
 val ext : t -> string
 val source : t -> Ml_kind.t
 
+val to_sexp : t Sexp.To_sexp.t
+
 module Dict : sig
   type cm_kind = t
 

src/compilation_context.ml

@@ -105,3 +105,11 @@ let for_alias_module t =
   ; includes     = Includes.empty
   ; alias_module = None
   }
+
+let for_wrapped_compat t modules =
+  { t with
+    flags = Ocaml_flags.default ~profile:(SC.profile t.super_context)
+  ; includes = Includes.empty
+  ; alias_module = None
+  ; modules
+  }

src/compilation_context.mli

@@ -48,3 +48,5 @@ val includes             : t -> string list Arg_spec.t Cm_kind.Dict.t
 val preprocessing        : t -> Preprocessing.t
 val no_keep_locs         : t -> bool
 val opaque               : t -> bool
+
+val for_wrapped_compat : t -> Module.t Module.Name.Map.t -> t

src/dir_contents.ml

@@ -168,6 +168,7 @@ module Library_modules : sig
     { modules          : Module.t Module.Name.Map.t
     ; alias_module     : Module.t option
     ; main_module_name : Module.Name.t
+    ; wrapped_compat   : Module.t Module.Name.Map.t
     }
 
   val make : Library.t -> dir:Path.t -> Module.t Module.Name.Map.t -> t
@@ -176,25 +177,33 @@ end = struct
     { modules          : Module.t Module.Name.Map.t
     ; alias_module     : Module.t option
     ; main_module_name : Module.Name.t
+    ; wrapped_compat   : Module.t Module.Name.Map.t
     }
 
   let make (lib : Library.t) ~dir (modules : Module.t Module.Name.Map.t) =
     let main_module_name =
       Module.Name.of_string (Lib_name.Local.to_string lib.name) in
-    let modules =
-      if not lib.wrapped then
-        modules
-      else
+    let (modules, wrapped_compat) =
+      let wrap_modules modules =
         let open Module.Name.Infix in
-        Module.Name.Map.map modules ~f:(fun m ->
+        Module.Name.Map.map modules ~f:(fun (m : Module.t) ->
           if m.name = main_module_name then
             m
           else
             Module.with_wrapper m ~libname:lib.name)
+      in
+      match lib.wrapped with
+      | Simple false -> (modules, Module.Name.Map.empty)
+      | Simple true -> (wrap_modules modules, Module.Name.Map.empty)
+      | Yes_with_transition _ ->
+        ( wrap_modules modules
+        , Module.Name.Map.remove modules main_module_name
+          |> Module.Name.Map.map ~f:Module.wrapped_compat
+        )
     in
     let alias_module =
       let lib_name = Lib_name.Local.to_string lib.name in
-      if not lib.wrapped ||
+      if not (Library.Wrapped.to_bool lib.wrapped) ||
          (Module.Name.Map.cardinal modules = 1 &&
           Module.Name.Map.mem modules main_module_name) then
         None
@@ -215,7 +224,11 @@ end = struct
                       (Path.relative dir (lib_name ^ ".ml-gen")))
              ~obj_name:lib_name)
     in
-    { modules; alias_module; main_module_name }
+    { modules
+    ; alias_module
+    ; main_module_name
+    ; wrapped_compat
+    }
 end
 
 module Executables_modules = struct

src/dir_contents.mli

@@ -21,6 +21,7 @@ module Library_modules : sig
     { modules          : Module.t Module.Name.Map.t
     ; alias_module     : Module.t option
     ; main_module_name : Module.Name.t
+    ; wrapped_compat   : Module.t Module.Name.Map.t
     }
 end
 

src/dune_file.ml

@@ -859,6 +859,27 @@ module Library = struct
       syntax
   end
 
+  module Wrapped = struct
+    type t =
+      | Simple of bool
+      | Yes_with_transition of string
+
+    let dparse =
+      sum
+        [ "true", return (Simple true)
+        ; "false", return (Simple false)
+        ; "transition",
+          Syntax.since Stanza.syntax (1, 2) >>= fun () ->
+          string >>| fun x -> Yes_with_transition x
+        ]
+
+    let field = field "wrapped" ~default:(Simple true) dparse
+
+    let to_bool = function
+      | Simple b -> b
+      | Yes_with_transition _ -> true
+  end
+
   type t =
     { name                     : Lib_name.Local.t
     ; public                   : Public_lib.t option
@@ -875,7 +896,7 @@ module Library = struct
     ; c_library_flags          : Ordered_set_lang.Unexpanded.t
     ; self_build_stubs_archive : string option
     ; virtual_deps             : (Loc.t * Lib_name.t) list
-    ; wrapped                  : bool
+    ; wrapped                  : Wrapped.t
     ; optional                 : bool
     ; buildable                : Buildable.t
     ; dynlink                  : Dynlink_supported.t
@@ -908,7 +929,7 @@ module Library = struct
          field "virtual_deps" (list (located Lib_name.dparse)) ~default:[]
        and modes = field "modes" Mode_conf.Set.dparse ~default:Mode_conf.Set.default
        and kind = field "kind" Kind.dparse ~default:Kind.Normal
-       and wrapped = field "wrapped" bool ~default:true
+       and wrapped = Wrapped.field
        and optional = field_b "optional"
        and self_build_stubs_archive =
          field "self_build_stubs_archive" (option string) ~default:None
@@ -932,7 +953,7 @@ module Library = struct
          let open Syntax.Version.Infix in
          match name, public with
          | Some n, _ ->
-           Lib_name.Local.validate n ~wrapped
+           Lib_name.Local.validate n ~wrapped:(Wrapped.to_bool wrapped)
          | None, Some { name = (loc, name) ; _ }  ->
            if dune_version >= (1, 1) then
              match Lib_name.to_local name with

src/dune_file.mli

@@ -216,6 +216,14 @@ module Library : sig
       | Ppx_rewriter
   end
 
+  module Wrapped : sig
+    type t =
+      | Simple of bool
+      | Yes_with_transition of string
+
+    val to_bool : t -> bool
+  end
+
   type t =
     { name                     : Lib_name.Local.t
     ; public                   : Public_lib.t option
@@ -232,7 +240,7 @@ module Library : sig
     ; c_library_flags          : Ordered_set_lang.Unexpanded.t
     ; self_build_stubs_archive : string option
     ; virtual_deps             : (Loc.t * Lib_name.t) list
-    ; wrapped                  : bool
+    ; wrapped                  : Wrapped.t
     ; optional                 : bool
     ; buildable                : Buildable.t
     ; dynlink                  : Dynlink_supported.t

src/install_rules.ml

@@ -138,7 +138,11 @@ module Gen(P : Params) = struct
     let if_ cond l = if cond then l else [] in
     let files =
       let modules =
-        let { Dir_contents.Library_modules.modules; alias_module; _ } =
+        let { Dir_contents.Library_modules.
+              modules
+            ; alias_module
+            ; wrapped_compat
+            ; main_module_name = _ } =
           Dir_contents.modules_of_library dir_contents
             ~name:(Library.best_name lib)
         in
@@ -147,7 +151,9 @@ module Gen(P : Params) = struct
           | None -> modules
           | Some m -> Module.Name.Map.add modules m.name m
         in
-        Module.Name.Map.values modules
+        List.rev_append
+          (Module.Name.Map.values modules)
+          (Module.Name.Map.values wrapped_compat)
       in
       let virtual_library = Library.is_virtual lib in
       List.concat

src/js_of_ocaml_rules.ml

@@ -113,15 +113,15 @@ let link_rule cc ~runtime ~target =
     ; Arg_spec.Dyn get_all
     ]
 
-let build_cm cc ~(js_of_ocaml:Dune_file.Js_of_ocaml.t) ~src ~target =
-  let sctx = Compilation_context.super_context cc in
-  let dir = Compilation_context.dir cc in
+let build_cm cctx ~(js_of_ocaml:Dune_file.Js_of_ocaml.t) ~src ~target =
+  let sctx = Compilation_context.super_context cctx in
+  let dir = Compilation_context.dir cctx in
   if separate_compilation_enabled sctx
   then
     let itarget = Path.extend_basename src ~suffix:".js" in
     let spec = Arg_spec.Dep src in
     let flags =
-      let scope = Compilation_context.scope cc in
+      let scope = Compilation_context.scope cctx in
       SC.expand_and_eval_set sctx ~scope ~dir js_of_ocaml.flags
         ~standard:(Build.return (standard sctx))
     in

src/lib_rules.ml

@@ -120,6 +120,36 @@ module Gen (P : Install_rules.Params) = struct
       ~sandbox:alias_module_build_sandbox
       ~dep_graphs:(Ocamldep.Dep_graphs.dummy m)
 
+  let build_wrapped_compat_modules (lib : Library.t)
+        cctx
+        ~modules
+        ~js_of_ocaml
+        ~dynlink
+        ~(wrapped_compat : Module.t Module.Name.Map.t) =
+    let lib_name = String.capitalize (Lib_name.Local.to_string lib.name) in
+    let transition_message =
+      match lib.wrapped with
+      | Simple _ -> "" (* will never be accessed anyway *)
+      | Yes_with_transition r -> r
+    in
+    Module.Name.Map.iteri wrapped_compat ~f:(fun name m ->
+      let contents =
+        let name = Module.Name.to_string name in
+        let hidden_name = sprintf "%s__%s" lib_name name in
+        let real_name = sprintf "%s.%s" lib_name name in
+        sprintf {|[@@@deprecated "%s. Use %s instead."] include %s|}
+          transition_message real_name hidden_name
+      in
+      let source_path = Option.value_exn (Module.file m Impl) in
+      Build.return contents
+      >>> Build.write_file_dyn source_path
+      |> SC.add_rule sctx
+    );
+    let dep_graphs =
+      Ocamldep.Dep_graphs.wrapped_compat ~modules ~wrapped_compat in
+    let cctx = Compilation_context.for_wrapped_compat cctx wrapped_compat in
+    Module_compilation.build_modules cctx ~js_of_ocaml ~dynlink ~dep_graphs
+
   let build_c_file (lib : Library.t) ~scope ~dir ~includes (src, dst) =
     SC.add_rule sctx
       (SC.expand_and_eval_set sctx ~scope ~dir lib.c_flags
@@ -293,7 +323,7 @@ module Gen (P : Install_rules.Params) = struct
     in
     let flags = SC.ocaml_flags sctx ~scope ~dir lib.buildable in
     let { Dir_contents.Library_modules.
-          modules; main_module_name; alias_module } =
+          modules; main_module_name; alias_module ; wrapped_compat } =
       Dir_contents.modules_of_library dir_contents ~name:(Library.best_name lib)
     in
     let source_modules = modules in
@@ -318,7 +348,7 @@ module Gen (P : Install_rules.Params) = struct
     in
 
     let lib_interface_module =
-      if lib.wrapped then
+      if Library.Wrapped.to_bool lib.wrapped then
         Module.Name.Map.find modules main_module_name
       else
         None
@@ -340,12 +370,16 @@ module Gen (P : Install_rules.Params) = struct
         ~opaque
     in
 
-    let dep_graphs = Ocamldep.rules cctx in
-
     let dynlink =
       Dynlink_supported.get lib.dynlink ctx.supports_shared_libraries
     in
     let js_of_ocaml = lib.buildable.js_of_ocaml in
+
+    build_wrapped_compat_modules lib cctx ~dynlink ~js_of_ocaml
+      ~wrapped_compat ~modules;
+
+    let dep_graphs = Ocamldep.rules cctx in
+
     Module_compilation.build_modules cctx ~js_of_ocaml ~dynlink ~dep_graphs;
 
     Option.iter alias_module
@@ -355,15 +389,17 @@ module Gen (P : Install_rules.Params) = struct
     if Library.has_stubs lib then
       build_stubs lib ~dir ~scope ~requires ~dir_contents;
 
+    let add_cms ~cm_kind ~init = Module.Name.Map.fold ~init ~f:(fun m acc ->
+      match Module.cm_file m ~obj_dir cm_kind with
+      | None -> acc
+      | Some fn -> Path.Set.add acc fn)
+    in
     List.iter Cm_kind.all ~f:(fun cm_kind ->
-      let files =
-        Module.Name.Map.fold modules ~init:Path.Set.empty ~f:(fun m acc ->
-          match Module.cm_file m ~obj_dir cm_kind with
-          | None -> acc
-          | Some fn -> Path.Set.add acc fn)
-      in
+      let files = add_cms ~cm_kind ~init:Path.Set.empty modules in
+      let files = add_cms ~cm_kind ~init:files wrapped_compat in
       SC.Libs.setup_file_deps_alias sctx ~dir lib ~ext:(Cm_kind.ext cm_kind)
         files);
+
     SC.Libs.setup_file_deps_group_alias sctx ~dir lib ~exts:[".cmi"; ".cmx"];
     SC.Libs.setup_file_deps_alias sctx ~dir lib ~ext:".h"
       (List.map lib.install_c_headers ~f:(fun header ->
@@ -377,12 +413,18 @@ module Gen (P : Install_rules.Params) = struct
          else
            acc)
      in
+     let wrapped_compat = Module.Name.Map.values wrapped_compat in
+     (* Compatibility modules have implementations so we can just append them.
+        We append the modules at the end as no library modules depend on
+        them. *)
      let top_sorted_modules =
        Ocamldep.Dep_graph.top_closed_implementations dep_graphs.impl modules
+       >>^ fun modules -> modules @ wrapped_compat
      in
-     List.iter Mode.all ~f:(fun mode ->
+     (let modules = modules @ wrapped_compat in
+        List.iter Mode.all ~f:(fun mode ->
        build_lib lib ~scope ~flags ~dir ~obj_dir ~mode ~top_sorted_modules
-         ~modules));
+         ~modules)));
     (* Build *.cma.js *)
     SC.add_rules sctx (
       let src = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in

src/module.ml

@@ -32,6 +32,12 @@ end
 
 module Syntax = struct
   type t = OCaml | Reason
+
+  let to_sexp =
+    let open Sexp.To_sexp in
+    function
+    | OCaml -> string "OCaml"
+    | Reason -> string "Reason"
 end
 
 module File = struct
@@ -41,6 +47,13 @@ module File = struct
     }
 
   let make syntax path = { syntax; path }
+
+  let to_sexp { path; syntax } =
+    let open Sexp.To_sexp in
+    record
+      [ "path", Path.to_sexp path
+      ; "syntax", Syntax.to_sexp syntax
+      ]
 end
 
 type t =
@@ -140,3 +153,28 @@ let dir t =
   Path.parent_exn file.path
 
 let set_pp t pp = { t with pp }
+
+let to_sexp { name; impl; intf; obj_name ; pp } =
+  let open Sexp.To_sexp in
+  record
+    [ "name", Name.to_sexp name
+    ; "obj_name", string obj_name
+    ; "impl", (option File.to_sexp) impl
+    ; "intf", (option File.to_sexp) intf
+    ; "pp", (option string) (Option.map ~f:(fun _ -> "has pp") pp)
+    ]
+
+let wrapped_compat t =
+  { t with
+    intf = None
+  ; impl =
+      Some (
+        { syntax = OCaml
+        ; path =
+          Path.L.relative (dir t)
+            [ ".wrapped_compat"
+            ; Name.to_string t.name ^ ".ml-gen"
+            ]
+        }
+      )
+  }

src/module.mli

@@ -92,3 +92,7 @@ val with_wrapper : t -> libname:Lib_name.Local.t -> t
 val map_files : t -> f:(Ml_kind.t -> File.t -> File.t) -> t
 
 val set_pp : t -> (unit, string list) Build.t option -> t
+
+val to_sexp : t Sexp.To_sexp.t
+
+val wrapped_compat : t -> t

src/ocamldep.ml

@@ -51,6 +51,20 @@ module Dep_graph = struct
     { dir = Path.root
     ; per_module = Module.Name.Map.singleton m.name (Build.return [])
     }
+
+  let wrapped_compat ~modules ~wrapped_compat =
+    { dir = Path.root
+    ; per_module = Module.Name.Map.merge wrapped_compat modules ~f:(fun _ d m ->
+        match d, m with
+        | None, None -> assert false
+        | Some wrapped_compat, None ->
+          Exn.code_error "deprecated module needs counterpart"
+            [ "deprecated", Module.to_sexp wrapped_compat
+            ]
+        | None, Some _ -> None
+        | Some _, Some m -> Some (Build.return [m])
+      )
+    }
 end
 
 module Dep_graphs = struct
@@ -58,6 +72,9 @@ module Dep_graphs = struct
 
   let dummy m =
     Ml_kind.Dict.make_both (Dep_graph.dummy m)
+
+  let wrapped_compat ~modules ~wrapped_compat =
+    Ml_kind.Dict.make_both (Dep_graph.wrapped_compat ~modules ~wrapped_compat)
 end
 
 let parse_module_names ~(unit : Module.t) ~modules words =

src/ocamldep.mli

@@ -18,6 +18,11 @@ module Dep_graphs : sig
   type t = Dep_graph.t Ml_kind.Dict.t
 
   val dummy : Module.t -> t
+
+  val wrapped_compat
+    :  modules:Module.t Module.Name.Map.t
+    -> wrapped_compat:Module.t Module.Name.Map.t
+    -> t
 end
 
 (** Generate ocamldep rules for all the modules in the context. *)

src/stanza.ml

@@ -9,7 +9,7 @@ end
 let syntax =
   Syntax.create ~name:"dune" ~desc:"the dune language"
     [ (0, 0) (* Jbuild syntax *)
-    ; (1, 1)
+    ; (1, 2)
     ]
 
 module File_kind = struct

src/stdune/path.ml

@@ -943,3 +943,8 @@ module Internal = struct
     | In_source_tree l -> Local l
     | External l -> External l
 end
+
+module L = struct
+  (* TODO more efficient implementation *)
+  let relative t = List.fold_left ~init:t ~f:relative
+end

src/stdune/path.mli

@@ -169,3 +169,7 @@ val set_root : External.t -> unit
 module Internal : sig
   val raw_kind : t -> Kind.t
 end
+
+module L : sig
+  val relative : t -> string list -> t
+end

test/blackbox-tests/dune.inc

@@ -836,6 +836,14 @@
    test-cases/workspaces
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name wrapped-transition)
+ (deps (package dune) (source_tree test-cases/wrapped-transition))
+ (action
+  (chdir
+   test-cases/wrapped-transition
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name runtest)
  (deps
@@ -938,7 +946,8 @@
   (alias utop-default)
   (alias variants)
   (alias windows-diff)
-  (alias workspaces)))
+  (alias workspaces)
+  (alias wrapped-transition)))
 
 (alias
  (name runtest-no-deps)
@@ -1029,7 +1038,8 @@
   (alias utop-default)
   (alias variants)
   (alias windows-diff)
-  (alias workspaces)))
+  (alias workspaces)
+  (alias wrapped-transition)))
 
 (alias (name runtest-disabled) (deps (alias envs-and-contexts)))
 

test/blackbox-tests/test-cases/dune-project-edition/run.t

@@ -3,9 +3,9 @@
   $ mkdir src
   $ echo '(alias (name runtest) (action (progn)))' >  src/dune
   $ dune build
-  Info: creating file dune-project with this contents: (lang dune 1.1)
+  Info: creating file dune-project with this contents: (lang dune 1.2)
   $ cat dune-project
-  (lang dune 1.1)
+  (lang dune 1.2)
 
 Test that using menhir automatically update the dune-project file
 
@@ -13,5 +13,5 @@ Test that using menhir automatically update the dune-project file
   $ dune build
   Info: appending this line to dune-project: (using menhir 1.0)
   $ cat dune-project
-  (lang dune 1.1)
+  (lang dune 1.2)
   (using menhir 1.0)

test/blackbox-tests/test-cases/no-name-field/run.t

@@ -37,7 +37,7 @@ there's only a public name which is invalid, but sine the library is unwrapped,
 it's just a warning
 
   $ dune build --root public-name-invalid-wrapped-false
-  Info: creating file dune-project with this contents: (lang dune 1.1)
+  Info: creating file dune-project with this contents: (lang dune 1.2)
   File "dune", line 3, characters 14-21:
    (public_name foo.bar))
                 ^^^^^^^

test/blackbox-tests/test-cases/wrapped-transition/dune

@@ -0,0 +1,7 @@
+(executable
+ (name fooexe)
+ (libraries mylib))
+
+(alias
+ (name default)
+ (action (run ./fooexe.exe)))

test/blackbox-tests/test-cases/wrapped-transition/dune-project

@@ -0,0 +1 @@
+(lang dune 1.2)

test/blackbox-tests/test-cases/wrapped-transition/fooexe.ml

@@ -0,0 +1,7 @@
+Mylib.Bar.run ();;
+Mylib.Foo.run ();;
+Bar.run ();;
+Foo.run ();;
+
+module Y : Mylib.Intf_only.S = struct end
+module X : Intf_only.S = struct end

test/blackbox-tests/test-cases/wrapped-transition/lib/bar.ml

@@ -0,0 +1 @@
+let run () = print_endline "bar"

test/blackbox-tests/test-cases/wrapped-transition/lib/dune

@@ -0,0 +1,4 @@
+(library
+ (name mylib)
+ (modules_without_implementation intf_only)
+ (wrapped (transition "Will be removed past 2020-20-20")))

test/blackbox-tests/test-cases/wrapped-transition/lib/foo.ml

@@ -0,0 +1 @@
+let run () = print_endline "foo"

test/blackbox-tests/test-cases/wrapped-transition/lib/foo.mli

@@ -0,0 +1 @@
+val run : unit -> unit

test/blackbox-tests/test-cases/wrapped-transition/lib/intf_only.mli

@@ -0,0 +1 @@
+module type S = sig end

test/blackbox-tests/test-cases/wrapped-transition/lib/mylib.ml

@@ -0,0 +1,3 @@
+module Bar = Bar
+module Foo = Foo
+module Intf_only = Intf_only

test/blackbox-tests/test-cases/wrapped-transition/run.t

@@ -0,0 +1,10 @@
+  $ dune build 2>&1 | grep -v ocamlc
+  File "fooexe.ml", line 3, characters 0-7:
+  Error (warning 3): deprecated: module Bar
+  Will be removed past 2020-20-20. Use Mylib.Bar instead.
+  File "fooexe.ml", line 4, characters 0-7:
+  Error (warning 3): deprecated: module Foo
+  Will be removed past 2020-20-20. Use Mylib.Foo instead.
+  File "fooexe.ml", line 7, characters 11-22:
+  Error (warning 3): deprecated: module Intf_only
+  Will be removed past 2020-20-20. Use Mylib.Intf_only instead.