Working module arguments

panglesd · panglesd · commit 7e20799cd08a · 2026-03-25T15:40:29.000+01:00
The way it works is not ideal: we create a synthetic parent id for each module
argument (as they can be introduced multiple times with the same name in the
same type expression). This id is hidden and we don't render links to hidden
ids.

This is slightly bad because:
- The appearance of unresolved links suggest an error when there is no.
- There is no way to distinguish module args from normal modules

But let's say it is a good first step!
diff --git a/src/document/generator.ml b/src/document/generator.ml
@@ -488,9 +488,20 @@ module Make (Syntax : SYNTAX) = struct
                 | Lang.TypeExpr.Optional s ) ->
                 O.txt (s ^ ":")
           in
+          (* let href = *)
+          (*   Url.from_identifier ~stop_before:false *)
+          (*     (m_arg.id :> Paths.Identifier.t) *)
+          (* in *)
+          let name =
+            match m_arg.id.iv with
+            | `Parameter (_, name) -> ModuleName.to_string name
+          in
           let dst = type_expr dst in
-          lbl ++ O.txt "(module " ++ O.txt "test" ++ O.txt ":"
-          ++ package m_arg.package ++ O.txt ")" ++ Syntax.Type.arrow ++ dst
+          lbl ++ O.txt "(module "
+          ++
+          (* resolved href [ inline @@ Text name ] *)
+          O.txt name ++ O.txt " : " ++ package m_arg.package ++ O.txt ")"
+          ++ O.sp ++ Syntax.Type.arrow ++ O.sp ++ dst
 
     and package pkg =
       Link.from_path (pkg.path :> Paths.Path.t)
diff --git a/src/loader/cmti.ml b/src/loader/cmti.ml
@@ -168,8 +168,12 @@ let rec read_core_type env container ctyp =
 #endif
 #if OCAML_VERSION >= (5,5,0)
   | Ttyp_functor (lbl, id, pkg, ret_type) ->
-      let lbl = read_label lbl in
-      let e', id = Env.add_module_arg id.txt (ModuleName.of_ident id.txt) env.ident_env in
+    let lbl = read_label lbl in
+    let parent = Identifier.fresh_module_arg_parent () in
+    let e', id =
+      Env.add_module_arg parent id.txt (ModuleName.hidden_of_ident id.txt)
+        env.ident_env
+    in
       let env = {env with ident_env = e'} in
       let ret = read_core_type env container ret_type in
       let package = read_package env container pkg in
diff --git a/src/loader/ident_env.cppo.ml b/src/loader/ident_env.cppo.ml
@@ -638,8 +638,8 @@ let add_parameter parent id name env =
   let parameters = Ident.add id oid env.parameters in
   { env with module_paths; modules; parameters }
 
-let add_module_arg id name env =
-  let oid = Odoc_model.Paths.Identifier.Mk.(parameter ((root(None, ModuleName.make_std "yoyo")), name)) in
+let add_module_arg parent id name env =
+  let oid = Odoc_model.Paths.Identifier.Mk.(parameter (parent, name)) in
   let path = `Identifier (oid, false) in
   let module_paths = Ident.add id path env.module_paths in
   let modules = Ident.add id oid env.modules in
diff --git a/src/loader/ident_env.cppo.mli b/src/loader/ident_env.cppo.mli
@@ -24,6 +24,7 @@ val add_parameter :
   Paths.Identifier.Signature.t -> Ident.t -> Names.ModuleName.t -> t -> t
 
 val add_module_arg :
+  Paths.Identifier.Signature.t ->
   Ident.t ->
   Names.ModuleName.t ->
   t ->
diff --git a/src/model/paths.ml b/src/model/paths.ml
@@ -637,6 +637,16 @@ module Identifier = struct
     let name = Printf.sprintf "include%d_" !include_parent_counter in
     (Mk.module_ (parent, ModuleName.make_std name) :> Signature.t)
 
+  let module_arg_parent_counter = ref 0
+
+  (* Create a synthetic parent identifier for module arguments, which can't have
+     unique identifier, as they can be introduced multiple times with the same
+     name in a single type expression . *)
+  let fresh_module_arg_parent () : Signature.t =
+    incr module_arg_parent_counter;
+    let name = Printf.sprintf "module_arg_%d_" !module_arg_parent_counter in
+    (Mk.root (None, ModuleName.hidden_of_string name) :> Signature.t)
+
   module Hashtbl = struct
     module Any = Hashtbl.Make (Any)
     module ContainerPage = Hashtbl.Make (ContainerPage)
@@ -662,7 +672,7 @@ module Path = struct
       | `Identifier { iv = `Module (_, m); _ } when Names.ModuleName.is_hidden m
         ->
           true
-      | `Identifier _ -> false
+      | `Identifier id -> Identifier.is_hidden id
       | `Canonical (_, `Resolved _) -> false
       | `Canonical (x, _) ->
           (not weak_canonical_test) && inner (x : module_ :> any)
@@ -705,7 +715,7 @@ module Path = struct
     let open Paths_types.Path in
     function
     | `Resolved r -> is_resolved_hidden ~weak_canonical_test:false r
-    | `Identifier (_, hidden) -> hidden
+    | `Identifier (id, hidden) -> hidden || Identifier.is_hidden id
     | `Substituted r -> is_path_hidden (r :> any)
     | `SubstitutedMT r -> is_path_hidden (r :> any)
     | `SubstitutedT r -> is_path_hidden (r :> any)
diff --git a/src/model/paths.mli b/src/model/paths.mli
@@ -351,6 +351,11 @@ module Identifier : sig
       type expression. Uses a lowercase module name (illegal in normal OCaml) to
       ensure no clashes with real identifiers. Each call returns a fresh
       identifier. *)
+
+  val fresh_module_arg_parent : unit -> Signature.t
+  (** Create a synthetic parent identifier for module arguments, which can't
+      have unique identifier, as they can be introduced multiple times with the
+      same name in a single type expression . *)
 end
 
 (** Normal OCaml paths (i.e. the ones present in types) *)
