Render source code: Add jump to implementation for modules

Signed-off-by: Paul-Elliot <[email protected]>

Author: panglesd

src/xref2/link.ml

@@ -462,7 +462,7 @@ let rec unit env t =
                 | Module v ->
                     Module
                       (jump_to v
-                         (fun _ -> None)
+                         (Shape_tools.lookup_module_path env)
                          (module_path ~report_errors:false env))
                 | ModuleType v ->
                     ModuleType

src/xref2/shape_tools.cppo.ml

@@ -56,11 +56,11 @@ let rec shape_of_id env :
 let rec shape_of_module_path env : _ -> Shape.t option =
   let proj parent kind name =
     let item = Shape.Item.make name kind in
-    match shape_of_module_path env (parent :> Odoc_model.Paths.Path.t) with
+    match shape_of_module_path env (parent :> Odoc_model.Paths.Path.Module.t) with
     | Some shape -> Some (Shape.proj shape item)
     | None -> None
   in
-  fun (path : Odoc_model.Paths.Path.t) ->
+  fun (path : Odoc_model.Paths.Path.Module.t) ->
     match path with
     | `Resolved _ -> None
     | `Root name -> (
@@ -72,11 +72,11 @@ let rec shape_of_module_path env : _ -> Shape.t option =
         | _ -> None)
     | `Forward _ -> None
     | `Dot (parent, name) ->
-        proj (parent :> Odoc_model.Paths.Path.t) Kind.Module name
+        proj (parent :> Odoc_model.Paths.Path.Module.t) Kind.Module name
     | `Apply (parent, arg) ->
-        shape_of_module_path env (parent :> Odoc_model.Paths.Path.t)
+        shape_of_module_path env (parent :> Odoc_model.Paths.Path.Module.t)
         >>= fun parent ->
-        shape_of_module_path env (arg :> Odoc_model.Paths.Path.t) >>= fun arg ->
+        shape_of_module_path env (arg :> Odoc_model.Paths.Path.Module.t) >>= fun arg ->
         Some (Shape.app parent ~arg)
     | `Identifier (id, _) ->
         shape_of_id env (id :> Odoc_model.Paths.Identifier.NonSrc.t)
@@ -85,14 +85,14 @@ let shape_of_value_path env :
     Odoc_model.Paths.Path.Value.t -> Shape.t option =
   let proj parent kind name =
     let item = Shape.Item.make name kind in
-    match shape_of_module_path env (parent :> Odoc_model.Paths.Path.t) with
+    match shape_of_module_path env parent with
     | Some shape -> Some (Shape.proj shape item)
     | None -> None
   in
   fun (path : Odoc_model.Paths.Path.Value.t) ->
     match path with
     | `Resolved _ -> None
-    | `Dot (parent, name) -> proj (parent :> Odoc_model.Paths.Path.t) Kind.Value name
+    | `Dot (parent, name) -> proj parent Kind.Value name
     | `Identifier (id, _) -> shape_of_id env (id :> Odoc_model.Paths.Identifier.NonSrc.t)
 
 
@@ -160,6 +160,16 @@ let lookup_value_path :
   | None -> None
   | Some query -> lookup_shape env query
 
+
+let lookup_module_path :
+    Env.t ->
+    Path.Module.t ->
+    Identifier.SourceLocation.t option
+ = fun env path ->
+  match shape_of_module_path env path with
+  | None -> None
+  | Some query -> lookup_shape env query
+
 #else
 
 type t = unit

src/xref2/shape_tools.cppo.mli

@@ -18,3 +18,8 @@ val lookup_value_path :
   Env.t ->
   Path.Value.t ->
   Identifier.SourceLocation.t option
+
+val lookup_module_path :
+  Env.t ->
+  Path.Module.t ->
+  Identifier.SourceLocation.t option

test/sources/source.t/run.t

@@ -307,7 +307,7 @@ Ids generated in the source code:
   id="module-F.argument-1-M.module-A"
   id="module-F.module-B"
   id="module-FM"
-  id="def_3"
+  id="local_A_3"
   id="module-FF"
   id="module-FF2"
   id="module-FF2.argument-1-A.module-E"