From 447e6ac68ff17debc47a13865432946dd5c8b0c5 Mon Sep 17 00:00:00 2001
From: Paul-Elliot <peada@free.fr>
Date: Mon, 15 Jul 2024 18:13:14 +0200
Subject: [PATCH] Occurrences: don't expose sub in occurrence table

Signed-off-by: Paul-Elliot <peada@free.fr>
---
 src/occurrences/table.ml             | 13 +++++++++++--
 src/occurrences/table.mli            |  2 +-
 src/search/json_index/json_search.ml |  9 +++------
 3 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/src/occurrences/table.ml b/src/occurrences/table.ml
index 0276731825..5004d97aa2 100644
--- a/src/occurrences/table.ml
+++ b/src/occurrences/table.ml
@@ -1,9 +1,14 @@
 module H = Hashtbl.Make (Odoc_model.Paths.Identifier)
 
-type t = item H.t
-and item = { direct : int; indirect : int; sub : item H.t }
+type t = internal_item H.t
+and internal_item = { direct : int; indirect : int; sub : t }
 type key = Odoc_model.Paths.Identifier.t
 
+type item = { direct : int; indirect : int }
+
+let internal_to_item : internal_item -> item =
+ fun { direct; indirect; _ } -> { direct; indirect }
+
 let v_item () = { direct = 0; indirect = 0; sub = H.create 0 }
 
 let v () = H.create 0
@@ -78,9 +83,13 @@ let rec get t id =
   | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ ->
       None
 
+let get t id =
+  match get t id with None -> None | Some i -> Some (internal_to_item i)
+
 let rec iter f tbl =
   H.iter
     (fun id v ->
       iter f v.sub;
+      let v = internal_to_item v in
       f id v)
     tbl
diff --git a/src/occurrences/table.mli b/src/occurrences/table.mli
index 9c36a16a0d..954aaba55f 100644
--- a/src/occurrences/table.mli
+++ b/src/occurrences/table.mli
@@ -1,5 +1,5 @@
 type t
-type item = { direct : int; indirect : int; sub : t }
+type item = { direct : int; indirect : int }
 type key = Odoc_model.Paths.Identifier.t
 
 val v : unit -> t
diff --git a/src/search/json_index/json_search.ml b/src/search/json_index/json_search.ml
index 9353b0d8ed..f7a5c3e697 100644
--- a/src/search/json_index/json_search.ml
+++ b/src/search/json_index/json_search.ml
@@ -169,7 +169,7 @@ let of_entry ({ Entry.id; doc; kind } as entry) html occurrences =
   in
   let occurrences =
     match occurrences with
-    | Some (`Direct direct, `Indirect indirect) ->
+    | Some { Odoc_occurrences.Table.direct; indirect } ->
         [
           ( "occurrences",
             `Object
@@ -211,12 +211,9 @@ let unit ?occurrences ppf u =
     match occurrences with
     | None -> None
     | Some occurrences -> (
-        (* We don't want to include the [sub] field of occurrence tables. We use
-           a "polymorphic record" to avoid defining a type, but still get named
-           fields! *)
         match Odoc_occurrences.Table.get occurrences id with
-        | Some x -> Some (`Direct x.direct, `Indirect x.indirect)
-        | None -> Some (`Direct 0, `Indirect 0))
+        | Some x -> Some x
+        | None -> Some { direct = 0; indirect = 0 })
   in
   let f first i =
     let entries = Entry.entries_of_item i in