Add --occurrences arg to compile-index

panglesd · panglesd · commit bd1215c91230 · 2024-01-31T10:45:31.000+01:00
This adds the occurrence count to each element of the json index

Signed-off-by: Paul-Elliot &lt;peada@free.fr&gt;
diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml
@@ -408,15 +408,17 @@ module Indexing = struct
     | Some file -> Fs.File.of_string file
     | None -> Fs.File.of_string "index.json"
 
-  let index dst warnings_options inputs_in_file inputs =
+  let index dst warnings_options inputs_in_file inputs occurrences =
     let output = output_file ~dst in
     match (inputs_in_file, inputs) with
     | [], [] ->
         Result.Error
           (`Msg
             "At least one of --file-list or an .odocl file must be passed to \
              odoc compile-index")
-    | _ -> Indexing.compile ~output ~warnings_options inputs_in_file inputs
+    | _ ->
+        Indexing.compile ~output ~warnings_options ~occurrences inputs_in_file
+          inputs
 
   let cmd =
     let dst =
@@ -427,6 +429,13 @@ module Indexing = struct
       Arg.(
         value & opt (some string) None & info ~docs ~docv:"PATH" ~doc [ "o" ])
     in
+    let occurrences =
+      let doc = "Occurrence file." in
+      Arg.(
+        value
+        & opt (some convert_fpath) None
+        & info ~docs ~docv:"PATH" ~doc [ "occurrences" ])
+    in
     let inputs_in_file =
       let doc =
         "Input text file containing a line-separated list of paths to .odocl \
@@ -442,7 +451,8 @@ module Indexing = struct
     in
     Term.(
       const handle_error
-      $ (const index $ dst $ warnings_options $ inputs_in_file $ inputs))
+      $ (const index $ dst $ warnings_options $ inputs_in_file $ inputs
+       $ occurrences))
 
   let info ~docs =
     let doc =
diff --git a/src/odoc/indexing.ml b/src/odoc/indexing.ml
@@ -32,9 +32,19 @@ let parse_input_files input =
     (Ok []) input
   >>= fun files -> Ok (List.concat files)
 
-let compile ~output ~warnings_options inputs_in_file inputs =
+let read_occurrences file =
+  let ic = open_in_bin file in
+  let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in
+  htbl
+
+let compile ~output ~warnings_options ~occurrences inputs_in_file inputs =
   parse_input_files inputs_in_file >>= fun files ->
   let files = List.rev_append inputs files in
+  let occurrences =
+    match occurrences with
+    | None -> None
+    | Some occurrences -> Some (read_occurrences (Fpath.to_string occurrences))
+  in
   let output_channel =
     Fs.Directory.mkdir_p (Fs.File.dirname output);
     open_out_bin (Fs.File.to_string output)
@@ -51,7 +61,7 @@ let compile ~output ~warnings_options inputs_in_file inputs =
       (fun acc file ->
         match
           handle_file
-            ~unit:(print Json_search.unit acc)
+            ~unit:(print (Json_search.unit ?occurrences) acc)
             ~page:(print Json_search.page acc)
             file
         with
diff --git a/src/odoc/indexing.mli b/src/odoc/indexing.mli
@@ -11,6 +11,7 @@ val handle_file :
 val compile :
   output:Fs.file ->
   warnings_options:Odoc_model.Error.warnings_options ->
+  occurrences:Fs.file option ->
   Fs.file list ->
   Fs.file list ->
   (unit, [> msg ]) result
diff --git a/src/search/json_index/dune b/src/search/json_index/dune
@@ -1,4 +1,4 @@
 (library
  (name odoc_json_index)
  (public_name odoc.json_index)
- (libraries tyxml odoc_model odoc_search))
+ (libraries tyxml odoc_model odoc_search odoc_occurrences))
diff --git a/src/search/json_index/json_search.ml b/src/search/json_index/json_search.ml
@@ -86,7 +86,7 @@ let of_doc (doc : Odoc_model.Comment.docs) =
   let txt = Text.of_doc doc in
   `String txt
 
-let of_entry ({ Entry.id; doc; kind } as entry) html =
+let of_entry ({ Entry.id; doc; kind } as entry) html occurrences =
   let j_id = of_id id in
   let doc = of_doc doc in
   let kind =
@@ -167,11 +167,27 @@ let of_entry ({ Entry.id; doc; kind } as entry) html =
             ("parent_type", `String (Text.of_type parent_type));
           ]
   in
+  let occurrences =
+    match occurrences with
+    | Some occ ->
+        `Object
+          [
+            ("direct", `Float (float_of_int occ.Odoc_occurrences.Table.direct));
+            ("indirect", `Float (float_of_int occ.indirect));
+          ]
+    | None -> `Null
+  in
   match Json_display.of_entry entry html with
   | Result.Ok display ->
       Result.Ok
         (`Object
-          [ ("id", j_id); ("doc", doc); ("kind", kind); ("display", display) ])
+          [
+            ("id", j_id);
+            ("doc", doc);
+            ("kind", kind);
+            ("display", display);
+            ("occurrences", occurrences);
+          ])
   | Error _ as e -> e
 
 let output_json ppf first entries =
@@ -180,8 +196,8 @@ let output_json ppf first entries =
     Format.fprintf ppf "%s\n" str
   in
   List.fold_left
-    (fun first (entry, html) ->
-      let json = of_entry entry html in
+    (fun first (entry, html, occurrences) ->
+      let json = of_entry entry html occurrences in
       if not first then Format.fprintf ppf ",";
       match json with
       | Ok json ->
@@ -192,11 +208,20 @@ let output_json ppf first entries =
           true)
     first entries
 
-let unit ppf u =
+let unit ?occurrences ppf u =
+  let get_occ id =
+    match occurrences with
+    | None -> None
+    | Some occurrences -> Odoc_occurrences.Table.get occurrences id
+  in
   let f (first, id) i =
     let entries = Entry.entries_of_item id i in
     let entries =
-      List.map (fun entry -> (entry, Html.of_entry entry)) entries
+      List.map
+        (fun entry ->
+          let occ = get_occ entry.Entry.id in
+          (entry, Html.of_entry entry, occ))
+        entries
     in
     let id =
       match i with
@@ -230,7 +255,7 @@ let page ppf (page : Odoc_model.Lang.Page.t) =
       Entry.entries_of_item (page.name :> Odoc_model.Paths.Identifier.t) i
     in
     let entries =
-      List.map (fun entry -> (entry, Html.of_entry entry)) entries
+      List.map (fun entry -> (entry, Html.of_entry entry, None)) entries
     in
     output_json ppf first entries
   in
diff --git a/src/search/json_index/json_search.mli b/src/search/json_index/json_search.mli
@@ -1,4 +1,8 @@
 (** This module generates json intended to be consumed by search engines. *)
 
-val unit : Format.formatter -> Odoc_model.Lang.Compilation_unit.t -> unit
+val unit :
+  ?occurrences:Odoc_occurrences.Table.t ->
+  Format.formatter ->
+  Odoc_model.Lang.Compilation_unit.t ->
+  unit
 val page : Format.formatter -> Odoc_model.Lang.Page.t -> unit
diff --git a/test/occurrences/double_wrapped.t/run.t b/test/occurrences/double_wrapped.t/run.t
@@ -135,3 +135,74 @@ We can also include hidden ids:
   Main__A was used directly 1 times and indirectly 0 times
   Main__B was used directly 1 times and indirectly 0 times
   Main__C was used directly 1 times and indirectly 0 times
+
+We can use the generated table when generating the json output:
+
+  $ odoc compile-index -o index.json --occurrences occurrences-all.odoc main/main.odocl
+
+  $ cat index.json | jq sort | jq '.[]' -c
+  {"id":[{"kind":"Root","name":"Main"}],"doc":"Handwritten top-level module","kind":{"kind":"Module"},"display":{"url":"Main/index.html","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">.</span><span class=\"entry-name\">Main</span></code><div class=\"entry-comment\"><div><p>Handwritten top-level module</p></div></div>"},"occurrences":{"direct":0,"indirect":11}}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/A/index.html","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.</span><span class=\"entry-name\">A</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":{"direct":4,"indirect":6}}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/index.html","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.</span><span class=\"entry-name\">B</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":{"direct":1,"indirect":0}}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"M"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/M/index.html","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.B.</span><span class=\"entry-name\">M</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":null}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"Y"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/Y/index.html","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.B.</span><span class=\"entry-name\">Y</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":null}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"Z"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/Z/index.html","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.B.</span><span class=\"entry-name\">Z</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":null}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"Z"},{"kind":"Module","name":"Y"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/Z/Y/index.html","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.B.Z.</span><span class=\"entry-name\">Y</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":null}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"},{"kind":"ModuleType","name":"M"}],"doc":"","kind":{"kind":"ModuleType"},"display":{"url":"Main/A/module-type-M/index.html","html":"<code class=\"entry-kind\">sig</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.A.</span><span class=\"entry-name\">M</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":{"direct":2,"indirect":0}}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"ModuleType","name":"Y"}],"doc":"","kind":{"kind":"ModuleType"},"display":{"url":"Main/B/module-type-Y/index.html","html":"<code class=\"entry-kind\">sig</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.B.</span><span class=\"entry-name\">Y</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":null}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"},{"kind":"Type","name":"t"}],"doc":"","kind":{"kind":"TypeDecl","private":false,"manifest":"string","constraints":[]},"display":{"url":"Main/A/index.html#type-t","html":"<code class=\"entry-kind\">type</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.A.</span><span class=\"entry-name\">t</span><code class=\"entry-rhs\"> = string</code></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":{"direct":1,"indirect":0}}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"},{"kind":"Value","name":"(||>)"}],"doc":"","kind":{"kind":"Value","type":"int -> int -> int"},"display":{"url":"Main/A/index.html#val-(||>)","html":"<code class=\"entry-kind\">val</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.A.</span><span class=\"entry-name\">(||&gt;)</span><code class=\"entry-rhs\"> : int -&gt; int -&gt; int</code></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":{"direct":1,"indirect":0}}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"},{"kind":"Value","name":"x"}],"doc":"","kind":{"kind":"Value","type":"int"},"display":{"url":"Main/A/index.html#val-x","html":"<code class=\"entry-kind\">val</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.A.</span><span class=\"entry-name\">x</span><code class=\"entry-rhs\"> : int</code></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":{"direct":2,"indirect":0}}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Value","name":"y"}],"doc":"","kind":{"kind":"Value","type":"int"},"display":{"url":"Main/B/index.html#val-y","html":"<code class=\"entry-kind\">val</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.B.</span><span class=\"entry-name\">y</span><code class=\"entry-rhs\"> : int</code></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":null}
+  {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"Z"},{"kind":"Value","name":"y"}],"doc":"","kind":{"kind":"Value","type":"int"},"display":{"url":"Main/B/Z/index.html#val-y","html":"<code class=\"entry-kind\">val</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.B.Z.</span><span class=\"entry-name\">y</span><code class=\"entry-rhs\"> : int</code></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":null}
+
+  $ cat index.json | jq sort | head -n 33
+  [
+    {
+      "id": [
+        {
+          "kind": "Root",
+          "name": "Main"
+        }
+      ],
+      "doc": "Handwritten top-level module",
+      "kind": {
+        "kind": "Module"
+      },
+      "display": {
+        "url": "Main/index.html",
+        "html": "<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">.</span><span class=\"entry-name\">Main</span></code><div class=\"entry-comment\"><div><p>Handwritten top-level module</p></div></div>"
+      },
+      "occurrences": {
+        "direct": 0,
+        "indirect": 11
+      }
+    },
+    {
+      "id": [
+        {
+          "kind": "Root",
+          "name": "Main"
+        },
+        {
+          "kind": "Module",
+          "name": "A"
+        }
+      ],
+      "doc": "",
+
+  $ cat index.json | jq -r '.[] | "\(.id | map("\(.kind)-\(.name)") | join(".")), direct: \(.occurrences.direct), indirect: \(.occurrences.indirect)"' | sort
+  Root-Main, direct: 0, indirect: 11
+  Root-Main.Module-A, direct: 4, indirect: 6
+  Root-Main.Module-A.ModuleType-M, direct: 2, indirect: 0
+  Root-Main.Module-A.Type-t, direct: 1, indirect: 0
+  Root-Main.Module-A.Value-(||>), direct: 1, indirect: 0
+  Root-Main.Module-A.Value-x, direct: 2, indirect: 0
+  Root-Main.Module-B, direct: 1, indirect: 0
+  Root-Main.Module-B.Module-M, direct: null, indirect: null
+  Root-Main.Module-B.Module-Y, direct: null, indirect: null
+  Root-Main.Module-B.Module-Z, direct: null, indirect: null
+  Root-Main.Module-B.Module-Z.Module-Y, direct: null, indirect: null
+  Root-Main.Module-B.Module-Z.Value-y, direct: null, indirect: null
+  Root-Main.Module-B.ModuleType-Y, direct: null, indirect: null
+  Root-Main.Module-B.Value-y, direct: null, indirect: null
diff --git a/test/search/html_search.t/run.t b/test/search/html_search.t/run.t
