feature: enable (include_subdirs qualified)

Signed-off-by: Rudi Grinberg <[email protected]>

ps-id: f0bdd789-87c5-4047-b418-47cdaf7749ae

bin/describe.ml

@@ -262,7 +262,7 @@ module Crawl = struct
         Memo.return
         @@
         match Module.kind unit with
-        | Alias ->
+        | Alias _ ->
           (* TODO: handle Alias modules, that are generated by dune. They are
              currently associated to no ocamldep-related rules. *)
           Action_builder.return no_deps

bin/ocaml_merlin.ml

@@ -78,14 +78,13 @@ end = struct
   let load_merlin_file file =
     (* We search for an appropriate merlin configuration in the current
        directory and its parents *)
-    let filename = String.lowercase_ascii (Path.Build.basename file) in
     let rec find_closest path =
       match
         get_merlin_files_paths path
         |> List.find_map ~f:(fun file_path ->
                match Merlin.Processed.load_file file_path with
                | Error msg -> Some (Merlin_conf.make_error msg)
-               | Ok config -> Merlin.Processed.get config ~filename)
+               | Ok config -> Merlin.Processed.get config ~file)
       with
       | Some p -> Some p
       | None -> (

bin/top.ml

@@ -189,9 +189,7 @@ module Module = struct
       let+ (pp, ppx), files_to_load = Memo.fork_and_join pps files_to_load in
       let code =
         let modules = Dune_rules.Compilation_context.modules cctx in
-        let opens_ =
-          Dune_rules.Module_compilation.open_modules modules module_
-        in
+        let opens_ = Dune_rules.Modules.local_open modules module_ in
         List.map opens_ ~f:(fun name ->
             sprintf "open %s" (Dune_rules.Module_name.to_string name))
       in

src/dune_rules/dep_rules.ml

@@ -43,17 +43,23 @@ let ooi_deps { vimpl; sctx; dir; obj_dir; modules = _; stdlib = _; sandbox = _ }
   in
   read
 
-let deps_of_module md ~ml_kind m =
+let deps_of_module ({ modules; _ } as md) ~ml_kind m =
   match Module.kind m with
   | Wrapped_compat ->
-    let modules = md.modules in
     let interface_module =
       match Modules.lib_interface modules with
       | Some m -> m
       | None -> Modules.compat_for_exn modules m
     in
     Action_builder.return (List.singleton interface_module) |> Memo.return
-  | _ -> Ocamldep.deps_of md ~ml_kind m
+  | _ -> (
+    let+ deps = Ocamldep.deps_of md ~ml_kind m in
+    match Modules.alias_for modules m with
+    | [] -> deps
+    | aliases ->
+      let open Action_builder.O in
+      let+ deps = deps in
+      aliases @ deps)
 
 let deps_of_vlib_module ({ obj_dir; vimpl; dir; sctx; _ } as md) ~ml_kind m =
   let vimpl = Option.value_exn vimpl in
@@ -82,8 +88,11 @@ let deps_of_vlib_module ({ obj_dir; vimpl; dir; sctx; _ } as md) ~ml_kind m =
 let rec deps_of md ~ml_kind (m : Modules.Sourced_module.t) =
   let is_alias =
     match m with
-    | Imported_from_vlib m | Normal m -> Module.kind m = Alias
     | Impl_of_virtual_module _ -> false
+    | Imported_from_vlib m | Normal m -> (
+      match Module.kind m with
+      | Alias _ -> true
+      | _ -> false)
   in
   if is_alias then Memo.return (Action_builder.return [])
   else

src/dune_rules/dune_file.ml

@@ -2143,11 +2143,16 @@ module Include_subdirs = struct
     | Include of qualification
 
   let decode ~enable_qualified =
-    let opts_list =
-      [ ("no", No); ("unqualified", Include Unqualified) ]
-      @ if enable_qualified then [ ("qualified", Include Qualified) ] else []
-    in
-    enum opts_list
+    sum
+      [ ("no", return No)
+      ; ("unqualified", return (Include Unqualified))
+      ; ( "qualified"
+        , let+ () =
+            if enable_qualified then return ()
+            else Syntax.since Stanza.syntax (3, 7)
+          in
+          Include Qualified )
+      ]
 end
 
 module Library_redirect = struct

src/dune_rules/link_time_code_gen.ml

@@ -28,7 +28,7 @@ let generate_and_compile_module cctx ~precompiled_cmi ~name ~lib ~code ~requires
       let main_module_name = Option.value_exn main_module_name in
       (* XXX this is fishy. We shouldn't be introducing a toplevel module into a
          wrapped library with a single module *)
-      Module.with_wrapper gen_module ~main_module_name
+      Module.with_wrapper gen_module ~main_module_name ~path:[]
   in
   let open Memo.O in
   let* () =

src/dune_rules/merlin.ml

@@ -1,5 +1,15 @@
 open Import
 
+let remove_extension file =
+  let dir = Path.Build.parent_exn file in
+  let basename =
+    match Path.Build.basename file |> Filename.chop_extension with
+    | s -> s
+    | exception Code_error.E _ ->
+      Code_error.raise "opens" [ ("file", Path.Build.to_dyn file) ]
+  in
+  Path.Build.relative dir basename
+
 module Processed = struct
   (* The actual content of the merlin file as built by the [Unprocessed.process]
      function from the unprocessed info gathered through [gen_rules]. The first
@@ -40,14 +50,15 @@ module Processed = struct
     { config : config
     ; modules : Module_name.t list
     ; pp_config : pp_flag option Module_name.Per_item.t
+    ; per_module_opens : Module_name.t list Path.Build.Map.t
     }
 
   module D = struct
     type nonrec t = t
 
     let name = "merlin-conf"
 
-    let version = 3
+    let version = 4
 
     let to_dyn _ = Dyn.String "Use [dune ocaml dump-dot-merlin] instead"
   end
@@ -68,7 +79,7 @@ module Processed = struct
 
   let serialize_path = Path.to_absolute_filename
 
-  let to_sexp ~pp { stdlib_dir; obj_dirs; src_dirs; flags; extensions } =
+  let to_sexp ~opens ~pp { stdlib_dir; obj_dirs; src_dirs; flags; extensions } =
     let make_directive tag value = Sexp.List [ Atom tag; value ] in
     let make_directive_of_path tag path =
       make_directive tag (Sexp.Atom (serialize_path path))
@@ -94,6 +105,16 @@ module Processed = struct
               (Sexp.List (List.map ~f:(fun s -> Sexp.Atom s) flags))
           ]
       in
+      let flags =
+        match opens with
+        | [] -> flags
+        | flags ->
+          [ make_directive "FLG"
+              (Sexp.List
+                 (List.concat_map flags ~f:(fun name ->
+                      [ Sexp.Atom "-open"; Atom (Module_name.to_string name) ])))
+          ]
+      in
       match pp with
       | None -> flags
       | Some { flag; args } ->
@@ -147,29 +168,36 @@ module Processed = struct
           print "\n");
     Buffer.contents b
 
-  let get { modules; pp_config; config } ~filename =
+  let opens per_module_opens file =
+    let file = remove_extension file in
+    Path.Build.Map.find per_module_opens file
+
+  let get { per_module_opens; modules; pp_config; config } ~file =
     (* We only match the first part of the filename : foo.ml -> foo foo.cppo.ml
        -> foo *)
     let fname =
+      let filename = Path.Build.basename file in
       String.lsplit2 filename ~on:'.'
       |> Option.map ~f:fst
       |> Option.value ~default:filename
       |> String.lowercase
     in
+    let opens = opens per_module_opens file in
     List.find_opt modules ~f:(fun name ->
         let fname' = Module_name.to_string name |> String.lowercase in
         String.equal fname fname')
     |> Option.map ~f:(fun name ->
            let pp = Module_name.Per_item.get pp_config name in
-           to_sexp ~pp config)
+           let opens = Option.value_exn opens in
+           to_sexp ~opens ~pp config)
 
   let print_file path =
     match load_file path with
     | Error msg -> Printf.eprintf "%s\n" msg
-    | Ok { modules; pp_config; config } ->
+    | Ok { per_module_opens = _; modules; pp_config; config } ->
       let pp_one module_ =
         let pp = Module_name.Per_item.get pp_config module_ in
-        let sexp = to_sexp ~pp config in
+        let sexp = to_sexp ~opens:[] ~pp config in
         let open Pp.O in
         Pp.vbox (Pp.text (Module_name.to_string module_))
         ++ Pp.newline
@@ -196,6 +224,7 @@ module Processed = struct
                (acc_pp, acc_obj, acc_src, acc_flags, acc_ext)
                { modules = _
                ; pp_config
+               ; per_module_opens = _
                ; config =
                    { stdlib_dir = _; obj_dirs; src_dirs; flags; extensions }
                }
@@ -264,16 +293,7 @@ module Unprocessed = struct
       Path.Set.singleton
       @@ obj_dir_of_lib `Private mode (Obj_dir.of_local obj_dir)
     in
-    let flags =
-      Ocaml_flags.common
-      @@
-      match Modules.alias_module modules with
-      | None -> flags
-      | Some m ->
-        Ocaml_flags.prepend_common
-          [ "-open"; Module_name.to_string (Module.name m) ]
-          flags
-    in
+    let flags = Ocaml_flags.common flags in
     let extensions = Dialect.DB.extensions_for_merlin dialects in
     let config =
       { stdlib_dir
@@ -420,12 +440,22 @@ module Unprocessed = struct
       in
       { Processed.stdlib_dir; src_dirs; obj_dirs; flags; extensions }
     and+ pp_config = pp_config t sctx ~expander in
+    let per_module_opens =
+      Modules.fold_no_vlib modules ~init:Path.Build.Map.empty ~f:(fun m init ->
+          Module.sources m
+          |> List.fold_left ~init ~f:(fun acc file ->
+                 let file = Path.as_in_build_dir_exn file |> remove_extension in
+                 let opens =
+                   Modules.alias_for modules m |> List.map ~f:Module.name
+                 in
+                 Path.Build.Map.set acc file opens))
+    in
     let modules =
       (* And copy for each module the resulting pp flags *)
       Modules.fold_no_vlib modules ~init:[] ~f:(fun m acc ->
           Module.name m :: acc)
     in
-    { Processed.modules; pp_config; config }
+    { Processed.modules; pp_config; config; per_module_opens }
 end
 
 let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) =

src/dune_rules/merlin.mli

@@ -37,7 +37,7 @@ module Processed : sig
       print the resulting configuration in dot-merlin syntax. *)
   val print_generic_dot_merlin : Path.t list -> unit
 
-  val get : t -> filename:string -> Sexp.t option
+  val get : t -> file:Path.Build.t -> Sexp.t option
 end
 
 val make :