Occurrences: add shapes for other nodes, improve test

Signed-off-by: Paul-Elliot <peada@free.fr>

Author: panglesd

src/xref2/link.ml

@@ -565,18 +565,23 @@ let rec unit env t =
                 | ModuleType v ->
                     ModuleType
                       (jump_to v
-                         (fun _ -> None)
+                         (Shape_tools.lookup_module_type_path env)
                          (module_type_path ~report_errors:false env))
                 | Type v ->
                     Type
                       (jump_to v
-                         (fun _ -> None)
+                         (Shape_tools.lookup_type_path env)
                          (type_path ~report_errors:false env))
                 | Constructor v ->
                     Constructor
                       (jump_to v
                          (fun _ -> None)
                          (constructor_path ~report_errors:false env))
+                | ClassType v ->
+                    ClassType
+                      (jump_to v
+                         (Shape_tools.lookup_class_type_path env)
+                         (class_type_path ~report_errors:false env))
                 | i -> i
               in
               (info, pos))

src/xref2/shape_tools.ml

@@ -81,21 +81,20 @@ let rec shape_of_module_path env : _ -> Shape.t option =
     | `Identifier (id, _) ->
         shape_of_id env (id :> Odoc_model.Paths.Identifier.NonSrc.t)
 
-let shape_of_value_path env :
-    Odoc_model.Paths.Path.Value.t -> Shape.t option =
+let shape_of_kind_path env kind :
+    _ -> Shape.t option =
   let proj parent kind name =
     let item = Shape.Item.make name kind in
     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) ->
+  fun path ->
     match path with
     | `Resolved _ -> None
-    | `Dot (parent, name) -> proj parent Kind.Value name
+    | `Dot (parent, name) -> proj parent kind name
     | `Identifier (id, _) -> shape_of_id env (id :> Odoc_model.Paths.Identifier.NonSrc.t)
 
-
 module MkId = Identifier.Mk
 
 let unit_of_uid uid =
@@ -151,25 +150,24 @@ let lookup_def :
   | None -> None
   | Some query -> lookup_shape env query
 
-let lookup_value_path :
-    Env.t ->
-    Path.Value.t ->
-    Identifier.SourceLocation.t option
- = fun env path ->
-  match shape_of_value_path env path with
+let lookup_module_path = fun env path ->
+  match shape_of_module_path env path with
   | 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
+let lookup_kind_path = fun kind env path ->
+  match shape_of_kind_path env kind path with
   | None -> None
   | Some query -> lookup_shape env query
 
+let lookup_value_path = lookup_kind_path Kind.Value
+
+let lookup_type_path = lookup_kind_path Kind.Type
+
+let lookup_module_type_path = lookup_kind_path Kind.Module_type
+
+let lookup_class_type_path = lookup_kind_path Kind.Class_type
+
 #else
 
 type t = unit
@@ -180,4 +178,10 @@ let lookup_value_path _ _id = None
 
 let lookup_module_path _ _id = None
 
+let lookup_type_path _ _id = None
+
+let lookup_module_type_path _ _id = None
+
+let lookup_class_type_path _ _id = None
+
 #endif

src/xref2/shape_tools.mli

@@ -19,7 +19,23 @@ val lookup_value_path :
   Path.Value.t ->
   Identifier.SourceLocation.t option
 
+val lookup_type_path :
+  Env.t ->
+  Path.Type.t ->
+  Identifier.SourceLocation.t option
+
 val lookup_module_path :
   Env.t ->
   Path.Module.t ->
   Identifier.SourceLocation.t option
+
+val lookup_module_type_path :
+  Env.t ->
+  Path.ModuleType.t ->
+  Identifier.SourceLocation.t option
+
+val lookup_class_type_path :
+  Env.t ->
+  Path.ClassType.t ->
+  Identifier.SourceLocation.t option
+

test/occurrences/double_wrapped.t/a.ml

@@ -5,3 +5,5 @@ type t = string
 module type M = sig end
 
 let (||>) x y = x + y
+
+let _ = x + x

test/occurrences/double_wrapped.t/run.t

@@ -119,6 +119,8 @@ We can also include persistent ids, and hidden ids:
 
   $ odoc count-occurrences -I main__A -o occurrences.txt --include-own --include-hidden
   $ occurrences_print occurrences.txt | sort
+  Main__A was used directly 0 times and indirectly 2 times
+  Main__A.x was used directly 2 times and indirectly 0 times
   string was used directly 1 times and indirectly 0 times
 
   $ odoc count-occurrences -I . -o occurrences.txt --include-own
@@ -160,9 +162,32 @@ We can also include persistent ids, and hidden ids:
   Main__ was used directly 0 times and indirectly 2 times
   Main__.C was used directly 1 times and indirectly 1 times
   Main__.C.y was used directly 1 times and indirectly 0 times
-  Main__A was used directly 1 times and indirectly 0 times
+  Main__A was used directly 1 times and indirectly 2 times
+  Main__A.x was used directly 2 times and indirectly 0 times
   Main__B was used directly 1 times and indirectly 1 times
   Main__B.Z was used directly 0 times and indirectly 1 times
   Main__B.Z.y was used directly 1 times and indirectly 0 times
   Main__C was used directly 1 times and indirectly 0 times
   string was used directly 1 times and indirectly 0 times
+
+
+REMARKS!
+
+  $ odoc count-occurrences -I main__B -o b_only_persistent.occ
+  $ odoc count-occurrences -I main__B -o b_with_own.occ --include-own
+  $ occurrences_print b_only_persistent.occ | sort > only_persistent
+  $ occurrences_print b_with_own.occ | sort > with_own
+  $ diff only_persistent with_own | grep Main.A.x
+  < Main.A.x was used directly 1 times and indirectly 0 times
+  > Main.A.x was used directly 2 times and indirectly 0 times
+
+This is because the persistent Y.x is resolved into Main.A.x. So maybe relying
+on Ident.persistent is not the good way of knowing if it is persistent or not?
+
+  $ odoc count-occurrences -I main__A -o a_with_own_and_hidden.occ --include-own --include-hidden
+  $ occurrences_print a_with_own_and_hidden.occ | sort
+  Main__A was used directly 0 times and indirectly 2 times
+  Main__A.x was used directly 2 times and indirectly 0 times
+  string was used directly 1 times and indirectly 0 times
+
+That's a problem: it should be Main.A and Main.A.x