Keep a namespaced package's dev modules out of its namespace

analysis/src/packages.ml

@@ -12,6 +12,11 @@ let make_paths_for_module ~project_files_and_paths ~dependencies_files_and_paths
       Hashtbl.replace paths_for_module mod_name paths);
   paths_for_module
 
+(* Without "." segments, so that "./test" and "test" compare equal. *)
+let path_components path =
+  Files.split Filename.dir_sep path
+  |> List.filter (fun component -> component <> "" && component <> ".")
+
 let new_bs_package ~root_path =
   let rescript_json = Filename.concat root_path "rescript.json" in
 
@@ -110,6 +115,30 @@ let new_bs_package ~root_path =
                let path = [Find_files.name_space_to_name namespace] in
                [path]
            in
+           (* The package's dev modules are aliased by its dev map, which the
+              compiler opens in dev modules only (get_package). *)
+           let dev_opens =
+             match namespace with
+             | None -> []
+             | Some namespace ->
+               let dev_namespace = namespace ^ "-dev" in
+               let cmt = Filename.concat artifact_dir dev_namespace ^ ".cmt" in
+               if Files.exists cmt then (
+                 Hashtbl.replace paths_for_module dev_namespace
+                   (Namespace {cmt});
+                 [[dev_namespace; "place holder"]])
+               else []
+           in
+           let dev_source_directories =
+             let directories ~include_dev =
+               Find_files.get_source_directories ~include_dev
+                 ~base_dir:root_path config
+               |> List.map path_components
+             in
+             let regular = directories ~include_dev:false in
+             directories ~include_dev:true
+             |> List.filter (fun directory -> not (List.mem directory regular))
+           in
            let bind f x = Option.bind x f in
            let compiler_flags =
              match
@@ -160,6 +189,8 @@ let new_bs_package ~root_path =
              dependencies_files;
              paths_for_module;
              opens;
+             dev_opens;
+             dev_source_directories;
              namespace;
              autocomplete;
            }))
@@ -185,7 +216,20 @@ let find_root ~uri packages_by_root =
   in
   loop (if Sys.is_directory path then path else Filename.dirname path)
 
+(* A dev module also opens its package's dev map. *)
+let for_file ~uri (package : Shared_types.package) =
+  if
+    package.dev_opens <> []
+    && List.mem
+         (Files.relpath package.root_path (Filename.dirname (Uri.to_path uri))
+         |> path_components)
+         package.dev_source_directories
+  then {package with opens = package.opens @ package.dev_opens}
+  else package
+
 let get_package ~state ~uri =
+  Option.map (for_file ~uri)
+  @@
   let open Shared_types in
   if Hashtbl.mem state.root_for_uri uri then
     Some

analysis/src/shared_types.ml

@@ -503,6 +503,11 @@ and package = {
   paths_for_module: (file, paths) Hashtbl.t;
   namespace: string option;
   opens: path list;
+  dev_opens: path list;
+      (** Opened in the files of [dev_source_directories] only, as the compiler
+          opens a package's dev map in its dev modules only *)
+  dev_source_directories: string list list;
+      (** Relative to [root_path], as path components *)
   autocomplete: file list Misc.String_map.t;
 }
 

changes/dev-modules-stay-in-their-package.breaking.md

@@ -0,0 +1 @@
+- Keep a namespaced package's dev modules out of its namespace, so that `open` of a dependency's namespace no longer shadows your own modules. Dev modules are now only visible to the dev modules of their own package; move test helpers that other packages or non-dev code use to a regular source directory.

compiler/bsc/rescript_compiler_driver.ml

@@ -333,6 +333,10 @@ let command_line_flags () : (string * Bsc_args.spec * string) array =
       string_call Js_packages_state.set_package_map,
       "*internal* Set package map, not only set package name but also use it \
        as a namespace" );
+    ( "-bs-open-alias-map",
+      string_call Js_packages_state.open_alias_map,
+      "*internal* <module>  Open the alias map <module> (compiled from an \
+       .mlmap) before typing, without recording its interface CRC" );
     ( "-as-pp",
       unit_call (fun _ ->
           (Js_config.current ()).as_pp := true;

compiler/core/config_util.ml

@@ -30,5 +30,5 @@ let output_prefix name =
   | None ->
     Ext_namespace_encode.make
       (Filename.remove_extension name)
-      ?ns:!((Clflags.current ()).dont_record_crc_unit)
+      ?ns:!((Clflags.current ()).namespace)
   | Some oname -> Filename.remove_extension oname

compiler/core/js_implementation.ml

@@ -178,7 +178,10 @@ let make_structure_item ~ns cunit : Parsetree.structure_item =
 
 (** decoding [.mlmap]
     keep in sync with [namespace_task] in rewatch-ocaml/compiler_process.ml
-*)
+
+    The file name gives the namespace of the alias targets, and [-o] can give
+    the compiled unit another name: rewatch compiles a package's dev modules
+    from [dev/Ns.mlmap] with [-o Ns-dev]. *)
 let implementation_map ppf sourcefile =
   let () = (Js_config.current ()).cmj_only := true in
   let ichan = open_in_bin (Compiler_request_state.resolve_path sourcefile) in

compiler/core/js_packages_state.ml

@@ -46,10 +46,15 @@ let make_runtime () : unit =
   state.making_runtime <- true;
   state.packages_info <- Js_packages_info.runtime_package_specs
 
+(* Opened in flag order, like [-open]. *)
+let open_alias_map module_name =
+  let flags = Clflags.current () in
+  flags.alias_maps := module_name :: !(flags.alias_maps);
+  flags.open_modules := module_name :: !(flags.open_modules)
+
 let set_package_map module_name =
-  (Clflags.current ()).dont_record_crc_unit := Some module_name;
-  (Clflags.current ()).open_modules :=
-    module_name :: !((Clflags.current ()).open_modules)
+  (Clflags.current ()).namespace := Some module_name;
+  open_alias_map module_name
 
 let update_npm_package_path s =
   let state = current () in

compiler/core/js_packages_state.mli

@@ -28,6 +28,8 @@ val make_runtime : unit -> unit
 
 val set_package_map : string -> unit
 
+val open_alias_map : string -> unit
+
 val get_packages_info : unit -> Js_packages_info.t
 
 val update_npm_package_path : string -> unit

compiler/ml/clflags.ml

@@ -23,7 +23,8 @@ type t = {
   keep_locs: bool ref;
   color: Misc.Color.setting option ref;
   assume_no_mli: mli_status ref;
-  dont_record_crc_unit: string option ref;
+  namespace: string option ref;
+  alias_maps: string list ref;
   bs_gentype: bool ref;
   jsx_preserve: bool ref;
   no_assert_false: bool ref;
@@ -54,7 +55,8 @@ let create () =
     keep_locs = ref true (* -keep-locs *);
     color = ref None (* -color *);
     assume_no_mli = ref Mli_non_exists;
-    dont_record_crc_unit = ref None;
+    namespace = ref None (* -bs-ns *);
+    alias_maps = ref [] (* -bs-ns, -bs-open-alias-map *);
     bs_gentype = ref false;
     jsx_preserve = ref false (* -bs-jsx-preserve *);
     no_assert_false = ref false;
@@ -100,7 +102,8 @@ let reset () =
   state.keep_locs := true;
   state.color := Some Misc.Color.Always;
   state.assume_no_mli := Mli_non_exists;
-  state.dont_record_crc_unit := None;
+  state.namespace := None;
+  state.alias_maps := [];
   state.bs_gentype := false;
   state.jsx_preserve := false;
   state.no_assert_false := false;

compiler/ml/clflags.mli

@@ -23,7 +23,12 @@ type t = {
   keep_locs: bool ref;
   color: Misc.Color.setting option ref;
   assume_no_mli: mli_status ref;
-  dont_record_crc_unit: string option ref;
+  namespace: string option ref;
+      (** Appended to the names of the outputs ([-bs-ns]): [Config] becomes
+          [Config-Ns] *)
+  alias_maps: string list ref;
+      (** Opened alias maps, the namespace among them, whose interface CRCs are
+          not recorded ([-bs-ns], [-bs-open-alias-map]) *)
   bs_gentype: bool ref;
   jsx_preserve: bool ref;
       (** Keep JSX in the output ([-bs-jsx-preserve]); read by translcore, and

compiler/ml/env.ml

@@ -1919,17 +1919,16 @@ let read_signature modname filename =
 (* Return the CRC of the interface of the given compilation unit *)
 
 let imports () =
-  let dont_record_crc_unit = !((Clflags.current ()).dont_record_crc_unit) in
-  match dont_record_crc_unit with
-  | None ->
-    Consistbl.extract (String_set.elements !(imported_units ())) (crc_units ())
-  | Some x ->
-    Consistbl.extract
-      (String_set.fold
-         (fun m acc -> if m = x then acc else m :: acc)
-         !(imported_units ())
-         [])
-      (crc_units ())
+  (* An alias map, such as a namespace, only holds module aliases, whose
+     targets are recorded themselves, so a unit does not depend on the map's
+     interface. *)
+  let alias_maps = !((Clflags.current ()).alias_maps) in
+  Consistbl.extract
+    (String_set.fold
+       (fun m acc -> if List.mem m alias_maps then acc else m :: acc)
+       !(imported_units ())
+       [])
+    (crc_units ())
 
 (* Save a signature to a file *)
 

rewatch-ocaml/build_artifacts.ml

@@ -208,6 +208,10 @@ let cleanup_stale ~artifact_files ~ast_sources ~present_source_files
   Config.namespace_compiler_name config.namespace
   |> Option.iter (fun namespace ->
       add_expected namespace [".cmi"; ".cmj"; ".cmt"; ".mlmap"]);
+  (* The dev map's .mlmap is in dev/, which is not scanned for stale files. *)
+  Source.dev_namespace_compiler_name config modules
+  |> Option.iter (fun dev_namespace ->
+      add_expected dev_namespace [".cmi"; ".cmj"; ".cmt"]);
   let removed_modules = ref [] in
   artifact_files
   |> List.iter (fun path ->

rewatch-ocaml/compiler_args.ml

@@ -82,13 +82,23 @@ let gentype_dependency_args_from_paths (config : Config.t) dependencies =
         | None -> []
         | Some path -> ["-bs-gentype-dep-path"; dependency.name ^ "=" ^ path])
 
-let namespace_args (config : Config.t) module_name =
-  match config.namespace with
-  | Config.No_namespace -> []
-  | Config.Namespace namespace -> ["-bs-ns"; namespace]
-  | Config.Namespace_with_entry {name; entry} ->
-    if entry = module_name then ["-open"; "@" ^ name]
-    else ["-bs-ns"; "@" ^ name]
+(* Dev modules also open the dev map, which aliases the package's dev modules
+   (Source.namespace_members). *)
+let namespace_args (config : Config.t) ~is_dev module_name =
+  let namespace =
+    match config.namespace with
+    | Config.No_namespace -> []
+    | Config.Namespace namespace -> ["-bs-ns"; namespace]
+    | Config.Namespace_with_entry {name; entry} ->
+      if entry = module_name then ["-open"; "@" ^ name]
+      else ["-bs-ns"; "@" ^ name]
+  in
+  let dev_namespace =
+    match Config.dev_namespace_compiler_name config.namespace with
+    | Some dev_namespace when is_dev -> ["-bs-open-alias-map"; dev_namespace]
+    | Some _ | None -> []
+  in
+  namespace @ dev_namespace
 
 let parser_arguments ~(config : Config.t) ~contents ~path =
   parser_flags ~ppx_flags:(filter_ppx_flags config.ppx_flags contents) config
@@ -112,7 +122,7 @@ let compiler_common_arguments ~project_root ~(config : Config.t) ~runtime
   @ ["-bs-package-name"; config.name; "-bs-project-root"; project_root]
 
 let compiler_arguments_with_common ~(config : Config.t) ~common_args
-    ~module_name ~source_kind ~has_interface ~path =
+    ~module_name ~is_dev ~source_kind ~has_interface ~path =
   let interface_args =
     match source_kind with
     | Source.Implementation when has_interface -> ["-bs-read-cmi"]
@@ -126,15 +136,15 @@ let compiler_arguments_with_common ~(config : Config.t) ~common_args
         (fun spec -> ["-bs-package-output"; package_output config path spec])
         config.package_specs
   in
-  namespace_args config module_name
+  namespace_args config ~is_dev module_name
   @ interface_args @ common_args @ output_args
   @ [Source.ast_path path]
 
 let compiler_arguments ~project_root ~(config : Config.t) ~runtime
-    ~dependency_dirs ~module_name ~source_kind ~has_interface ~watch
+    ~dependency_dirs ~module_name ~is_dev ~source_kind ~has_interface ~watch
     ~gentype_dependency_args ~path =
   compiler_arguments_with_common ~config
     ~common_args:
       (compiler_common_arguments ~project_root ~config ~runtime ~dependency_dirs
          ~watch ~gentype_dependency_args)
-    ~module_name ~source_kind ~has_interface ~path
+    ~module_name ~is_dev ~source_kind ~has_interface ~path

rewatch-ocaml/compiler_args.mli

@@ -13,6 +13,10 @@ val with_local_warning_policy : is_local:bool -> Config.t -> Config.t
 val gentype_dependency_args_from_paths :
   Config.t -> (Config.dependency * string) list -> string list
 
+val namespace_args : Config.t -> is_dev:bool -> string -> string list
+(** The namespace arguments of the module with the given name. Dev modules
+    also open their package's dev map. *)
+
 val parser_arguments :
   config:Config.t -> contents:string -> path:string -> string list
 
@@ -22,6 +26,7 @@ val compiler_arguments :
   runtime:string ->
   dependency_dirs:string list ->
   module_name:string ->
+  is_dev:bool ->
   source_kind:Source.source_kind ->
   has_interface:bool ->
   watch:bool ->
@@ -42,6 +47,7 @@ val compiler_arguments_with_common :
   config:Config.t ->
   common_args:string list ->
   module_name:string ->
+  is_dev:bool ->
   source_kind:Source.source_kind ->
   has_interface:bool ->
   path:string ->

rewatch-ocaml/compiler_args_command.ml

@@ -80,8 +80,9 @@ let run ~verbosity path =
     | Source.Implementation -> File_util.exists (source ^ "i")
     | Source.Interface -> false
   in
+  let is_dev = Config.source_is_dev config relative in
   let dependencies =
-    (if Config.source_is_dev config relative then
+    (if is_dev then
        List.map (fun dependency -> (false, dependency)) config.dev_dependencies
      else [])
     @ List.map (fun dependency -> (true, dependency)) config.dependencies
@@ -113,8 +114,8 @@ let run ~verbosity path =
     Compiler_args.compiler_arguments ~project_root ~config ~runtime
       ~dependency_dirs
       ~module_name:(Source.module_name source)
-      ~source_kind ~has_interface ~watch:false ~gentype_dependency_args:[]
-      ~path:relative
+      ~is_dev ~source_kind ~has_interface ~watch:false
+      ~gentype_dependency_args:[] ~path:relative
   in
   Yojson.Safe.pretty_to_string
     (`Assoc