Pass the documentation along with module expansions

Previously, when resolving module aliases, the documentation of the
target module was inserted in the signature as a Comment.

Author: Julow

src/document/generator.ml

@@ -1241,15 +1241,18 @@ module Make (Syntax : SYNTAX) = struct
       let modname = Paths.Identifier.name t.id in
       let expansion =
         match t.type_ with
-        | Alias (_, Some e) -> Some (simple_expansion e)
+        | Alias (_, Some e) -> Some (simple_expansion e.a_expansion, e.a_doc)
         | Alias (_, None) -> None
-        | ModuleType e -> expansion_of_module_type_expr e
+        | ModuleType e -> (
+            match expansion_of_module_type_expr e with
+            | Some e -> Some (e, t.doc)
+            | None -> None )
       in
       let modname, status, expansion =
         match expansion with
         | None -> (O.documentedSrc (O.txt modname), `Default, None)
-        | Some items ->
-            let doc = Comment.standalone t.doc in
+        | Some (items, expansion_doc) ->
+            let doc = Comment.standalone expansion_doc in
             let status =
               match t.type_ with
               | ModuleType (Signature _) -> `Inline
@@ -1293,7 +1296,7 @@ module Make (Syntax : SYNTAX) = struct
         ++ Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag
       in
       match md with
-      | Alias (_, Some se) -> simple_expansion_in_decl base se
+      | Alias (_, Some se) -> simple_expansion_in_decl base se.a_expansion
       | Alias (p, _) when not Paths.Path.(is_hidden (p :> t)) ->
           O.txt " = " ++ mdexpr md
       | Alias _ -> sig_dotdotdot

src/document/targets.ml

@@ -55,7 +55,7 @@ and module_ (t : Odoc_model.Lang.Module.t) =
   let url = Url.Path.from_identifier t.id in
   let subpages =
     match t.type_ with
-    | Alias (_, Some e) -> simple_expansion e
+    | Alias (_, Some e) -> simple_expansion e.a_expansion
     | Alias (_, None) -> []
     | ModuleType expr -> module_type_expr expr
   in

src/model/lang.ml

@@ -19,8 +19,13 @@ open Paths
 (** {3 Modules} *)
 
 module rec Module : sig
+  type alias_expansion = {
+    a_doc : Comment.docs;
+    a_expansion : ModuleType.simple_expansion;
+  }
+
   type decl =
-    | Alias of (Path.Module.t * ModuleType.simple_expansion option)
+    | Alias of (Path.Module.t * alias_expansion option)
     | ModuleType of ModuleType.expr
 
   type t = {

src/model_desc/lang_desc.ml

@@ -18,9 +18,17 @@ let rec module_decl =
         C
           ( "Alias",
             ((x :> Paths.Path.t), y),
-            Pair (path, Option simple_expansion) )
+            Pair (path, Option module_alias_expansion) )
     | ModuleType x -> C ("ModuleType", x, moduletype_expr))
 
+and module_alias_expansion =
+  let open Lang.Module in
+  Record
+    [
+      F ("a_doc", (fun t -> t.a_doc), docs);
+      F ("a_expansion", (fun t -> t.a_expansion), simple_expansion);
+    ]
+
 and module_t =
   let open Lang.Module in
   Record

src/xref2/compile.ml

@@ -315,7 +315,7 @@ and include_ : Env.t -> Include.t -> Include.t =
       match decl with
       | Alias p ->
           Expand_tools.aux_expansion_of_module_alias env ~strengthen:true p
-          >>= Expand_tools.assert_not_functor
+          >>= fun (expansion, _doc) -> Expand_tools.assert_not_functor expansion
       | ModuleType mty ->
           Expand_tools.aux_expansion_of_u_module_type_expr env mty
     with

src/xref2/component.ml

@@ -71,8 +71,13 @@ module Opt = struct
 end
 
 module rec Module : sig
+  type alias_expansion = {
+    a_doc : CComment.docs;
+    a_expansion : ModuleType.simple_expansion;
+  }
+
   type decl =
-    | Alias of Cpath.module_ * ModuleType.simple_expansion option
+    | Alias of Cpath.module_ * alias_expansion option
     | ModuleType of ModuleType.expr
 
   type t = {
@@ -1887,10 +1892,16 @@ module Of_Lang = struct
     match m with
     | Odoc_model.Lang.Module.Alias (p, e) ->
         Module.Alias
-          (module_path ident_map p, option simple_expansion ident_map e)
+          (module_path ident_map p, option module_alias_expansion ident_map e)
     | Odoc_model.Lang.Module.ModuleType s ->
         Module.ModuleType (module_type_expr ident_map s)
 
+  and module_alias_expansion ident_map e =
+    {
+      Module.a_doc = docs ident_map e.a_doc;
+      a_expansion = simple_expansion ident_map e.a_expansion;
+    }
+
   and include_decl ident_map m =
     match m with
     | Odoc_model.Lang.Include.Alias p -> Include.Alias (module_path ident_map p)

src/xref2/component.mli

@@ -61,8 +61,13 @@ end
 *)
 
 module rec Module : sig
+  type alias_expansion = {
+    a_doc : CComment.docs;
+    a_expansion : ModuleType.simple_expansion;
+  }
+
   type decl =
-    | Alias of Cpath.module_ * ModuleType.simple_expansion option
+    | Alias of Cpath.module_ * alias_expansion option
     | ModuleType of ModuleType.expr
 
   type t = {

src/xref2/expand_tools.ml

@@ -33,13 +33,14 @@ let rec aux_expansion_of_module :
     Component.Module.t ->
     (expansion, signature_of_module_error) Result.result =
   let open Component.Module in
-  fun env ~strengthen m -> aux_expansion_of_module_decl env ~strengthen m.type_
-
-and aux_expansion_of_module_decl env ~strengthen ty =
-  let open Component.Module in
-  match ty with
-  | Alias (path, _) -> aux_expansion_of_module_alias env ~strengthen path
-  | ModuleType expr -> aux_expansion_of_module_type_expr env expr
+  fun env ~strengthen m ->
+    match m.type_ with
+    | Alias (path, _) ->
+        aux_expansion_of_module_alias env ~strengthen path
+        >>= fun (expansion, _doc) -> Ok expansion
+    | ModuleType expr ->
+        (* TODO: Should [expr] be [ModuleType.t] ? (eg. include the [doc] field) *)
+        aux_expansion_of_module_type_expr env expr
 
 and aux_expansion_of_module_alias env ~strengthen path =
   (* Format.eprintf "aux_expansion_of_module_alias (strengthen=%b, path=%a)\n%!"
@@ -56,28 +57,14 @@ and aux_expansion_of_module_alias env ~strengthen path =
         && not (Cpath.is_resolved_module_hidden ~weak_canonical_test:true p)
       in
       let m = Component.Delayed.get m in
-      match (aux_expansion_of_module env ~strengthen:true m, m.doc) with
-      | (Error _ as e), _ -> e
-      | Ok (Signature sg), [] ->
-          (* Format.eprintf "Maybe strenthening now...\n%!"; *)
-          let sg' =
-            if strengthen then
-              Strengthen.signature ?canonical:m.canonical (`Resolved p) sg
-            else sg
-          in
-          Ok (Signature sg')
-      | Ok (Signature sg), docs ->
-          (* Format.eprintf "Maybe strenthening now...\n%!"; *)
+      match aux_expansion_of_module env ~strengthen:true m with
+      | Error _ as e -> e
+      | Ok (Signature sg) when strengthen ->
           let sg' =
-            if strengthen then
-              Strengthen.signature ?canonical:m.canonical (`Resolved p) sg
-            else sg
+            Strengthen.signature ?canonical:m.canonical (`Resolved p) sg
           in
-          (* Format.eprintf "Before:\n%a\n\n%!After\n%a\n\n%!"
-             Component.Fmt.signature sg
-             Component.Fmt.signature sg'; *)
-          Ok (Signature { sg' with items = Comment (`Docs docs) :: sg'.items })
-      | Ok (Functor _ as x), _ -> Ok x )
+          Ok (Signature sg', m.doc)
+      | Ok x -> Ok (x, m.doc) )
   | Error e -> Error (`UnresolvedPath (`Module (path, e)))
 
 (* We need to reresolve fragments in expansions as the root of the fragment
@@ -99,7 +86,10 @@ and aux_expansion_of_module_type_type_of_desc env t :
   match t with
   | Component.ModuleType.ModPath p ->
       aux_expansion_of_module_alias env ~strengthen:false p
-  | StructInclude p -> aux_expansion_of_module_alias env ~strengthen:true p
+      >>= fun (expansion, _doc) -> Ok expansion
+  | StructInclude p ->
+      aux_expansion_of_module_alias env ~strengthen:true p
+      >>= fun (expansion, _doc) -> Ok expansion
 
 and assert_not_functor = function Signature sg -> Ok sg | _ -> assert false
 
@@ -211,8 +201,9 @@ let expansion_of_u_module_type_expr env id expr =
 let expansion_of_module_alias env id path =
   let open Paths.Identifier in
   aux_expansion_of_module_alias ~strengthen:false env path
-  >>= handle_expansion env (id : Module.t :> Signature.t)
-  >>= fun (env, r) -> Ok (env, false, r)
+  >>= fun (expansion, doc) ->
+  handle_expansion env (id : Module.t :> Signature.t) expansion
+  >>= fun (env, r) -> Ok (env, false, r, doc)
 
 let expansion_of_module_type_of_desc env id t_desc =
   aux_expansion_of_module_type_type_of_desc env t_desc

src/xref2/lang_of.ml

@@ -674,9 +674,20 @@ and module_decl :
   match d with
   | Component.Module.Alias (p, s) ->
       Odoc_model.Lang.Module.Alias
-        (Path.module_ map p, Opt.map (simple_expansion map identifier) s)
+        (Path.module_ map p, Opt.map (module_alias_expansion map identifier) s)
   | ModuleType mty -> ModuleType (module_type_expr map identifier mty)
 
+and module_alias_expansion :
+    maps ->
+    Identifier.Signature.t ->
+    Component.Module.alias_expansion ->
+    Lang.Module.alias_expansion =
+ fun map identifier t ->
+  {
+    a_doc = docs (identifier :> Identifier.LabelParent.t) t.a_doc;
+    a_expansion = simple_expansion map identifier t.a_expansion;
+  }
+
 and mty_substitution map identifier = function
   | Component.ModuleType.ModuleEq (frag, decl) ->
       Odoc_model.Lang.ModuleType.ModuleEq

src/xref2/link.ml

@@ -380,8 +380,7 @@ and extract_doc : Module.decl -> Comment.docs * Module.decl =
     | e -> ([], e)
   in
   function
-  | Alias (p, expansion) -> (
-      match map_expansion expansion with d, e -> (d, Alias (p, e)) )
+  | Alias (_, Some e) as alias -> (e.a_doc, alias)
   | ModuleType (Path { p_path; p_expansion }) -> (
       match map_expansion p_expansion with
       | d, e -> (d, ModuleType (Path { p_path; p_expansion = e })) )
@@ -403,7 +402,7 @@ and module_ : Env.t -> Module.t -> Module.t =
     let type_ = module_decl env sg_id m.type_ in
     let type_ =
       match type_ with
-      | Alias (`Resolved p, e) ->
+      | Alias (`Resolved p, _) ->
           let hidden_alias =
             Paths.Path.is_hidden (`Resolved (p :> Paths.Path.Resolved.t))
           in
@@ -417,11 +416,13 @@ and module_ : Env.t -> Module.t -> Module.t =
             match
               Expand_tools.expansion_of_module_alias env m.id (`Resolved cp)
             with
-            | Ok (_, _, e) ->
+            | Ok (_, _, e, doc) ->
                 let le = Lang_of.(simple_expansion empty sg_id e) in
-                Alias (`Resolved p, Some (simple_expansion env sg_id le))
-            | Error _ -> Alias (`Resolved p, e)
-          else Alias (`Resolved p, e)
+                let a_doc = Lang_of.docs (sg_id :> Id.LabelParent.t) doc
+                and a_expansion = simple_expansion env sg_id le in
+                Alias (`Resolved p, Some { a_doc; a_expansion })
+            | Error _ -> type_
+          else type_
       | Alias _ | ModuleType _ -> type_
     in
     let doc, type_ =
@@ -435,7 +436,16 @@ and module_decl : Env.t -> Id.Signature.t -> Module.decl -> Module.decl =
   match decl with
   | ModuleType expr -> ModuleType (module_type_expr env id expr)
   | Alias (p, e) ->
-      Alias (module_path env p, Opt.map (simple_expansion env id) e)
+      Alias (module_path env p, Opt.map (module_alias_expansion env id) e)
+
+and module_alias_expansion :
+    Env.t -> Id.Signature.t -> Module.alias_expansion -> Module.alias_expansion
+    =
+ fun env id e ->
+  {
+    a_doc = comment_docs env e.a_doc;
+    a_expansion = simple_expansion env id e.a_expansion;
+  }
 
 and include_decl : Env.t -> Id.Signature.t -> Include.decl -> Include.decl =
  fun env id decl ->