Add --occurrences arg to compile-index

This adds the occurrence count to each element of the json index

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

Author: panglesd

src/odoc/bin/main.ml

@@ -524,7 +524,7 @@ module Indexing = struct
     | None, `Marshall -> Ok (Fs.File.of_string "index.odoc-index")
 
   let index dst json warnings_options page_roots lib_roots inputs_in_file inputs
-      =
+      occurrences =
     let marshall = if json then `JSON else `Marshall in
     output_file ~dst marshall >>= fun output ->
     (if
@@ -534,8 +534,8 @@ module Indexing = struct
      then Error (`Msg "Paths given to all -P and -L options must be disjoint")
      else Ok ())
     >>= fun () ->
-    Indexing.compile marshall ~output ~warnings_options ~lib_roots ~page_roots
-      ~inputs_in_file ~odocls:inputs
+    Indexing.compile marshall ~output ~warnings_options ~occurrences ~lib_roots
+      ~page_roots ~inputs_in_file ~odocls:inputs
   let cmd =
     let dst =
       let doc =
@@ -546,6 +546,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 \
@@ -587,7 +594,7 @@ module Indexing = struct
     Term.(
       const handle_error
       $ (const index $ dst $ json $ warnings_options $ page_roots $ lib_roots
-       $ inputs_in_file $ inputs))
+       $ inputs_in_file $ inputs $ occurrences))
 
   let info ~docs =
     let doc =

src/odoc/indexing.ml

@@ -40,7 +40,7 @@ let parse_input_files input =
     (Ok []) input
   >>= fun files -> Ok (List.concat files)
 
-let compile_to_json ~output ~warnings_options files =
+let compile_to_json ~output ~warnings_options ~occurrences files =
   let output_channel =
     Fs.Directory.mkdir_p (Fs.File.dirname output);
     open_out_bin (Fs.File.to_string output)
@@ -57,7 +57,7 @@ let compile_to_json ~output ~warnings_options files =
       (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)
             ~occ:(print Json_search.index acc)
             file
@@ -110,12 +110,22 @@ let compile_to_marshall ~output ~warnings_options sidebar files =
   result |> Error.handle_warnings ~warnings_options >>= fun () ->
   Ok (Odoc_file.save_index output (sidebar, final_index))
 
+let read_occurrences file =
+  let ic = open_in_bin file in
+  let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in
+  htbl
+
 open Odoc_model.Lang.Sidebar
 
-let compile out_format ~output ~warnings_options ~lib_roots ~page_roots
-    ~inputs_in_file ~odocls =
+let compile out_format ~output ~warnings_options ~occurrences ~lib_roots
+    ~page_roots ~inputs_in_file ~odocls =
   parse_input_files inputs_in_file >>= fun files ->
   let files = List.rev_append odocls files in
+  let occurrences =
+    match occurrences with
+    | None -> None
+    | Some occurrences -> Some (read_occurrences (Fpath.to_string occurrences))
+  in
   let resolver =
     Resolver.create ~important_digests:false ~directories:[]
       ~roots:
@@ -168,5 +178,5 @@ let compile out_format ~output ~warnings_options ~lib_roots ~page_roots
   in
   let content = { pages; libraries } in
   match out_format with
-  | `JSON -> compile_to_json ~output ~warnings_options files
+  | `JSON -> compile_to_json ~output ~warnings_options ~occurrences files
   | `Marshall -> compile_to_marshall ~output ~warnings_options content files

src/odoc/indexing.mli

@@ -13,6 +13,7 @@ val compile :
   [ `JSON | `Marshall ] ->
   output:Fs.file ->
   warnings_options:Odoc_model.Error.warnings_options ->
+  occurrences:Fs.file option ->
   lib_roots:(string * Fs.directory) list ->
   page_roots:(string * Fs.directory) list ->
   inputs_in_file:Fs.file list ->

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))

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 i =
     let entries = Entry.entries_of_item 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 first = output_json ppf first entries in
     first
@@ -208,7 +233,7 @@ let page ppf (page : Odoc_model.Lang.Page.t) =
   let f first i =
     let entries = Entry.entries_of_item 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
@@ -219,7 +244,7 @@ let index ppf (index : Entry.t Odoc_model.Paths.Identifier.Hashtbl.Any.t) =
   let _first =
     Odoc_model.Paths.Identifier.Hashtbl.Any.fold
       (fun _id entry first ->
-        let entry = (entry, Html.of_entry entry) in
+        let entry = (entry, Html.of_entry entry, None) in
         output_json ppf first [ entry ])
       index true
   in

src/search/json_index/json_search.mli

@@ -1,6 +1,10 @@
 (** 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
 val index :
   Format.formatter ->

test/occurrences/double_wrapped.t/run.t

@@ -144,3 +144,76 @@ 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 link -I . main.odoc
+
+  $ odoc compile-index --json -o index.json --occurrences occurrences-all.odoc 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=\"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/index.html#module-A","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/index.html#module-B","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/index.html#module-M","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/index.html#module-Y","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/index.html#module-Z","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/index.html#module-Y","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/index.html#module-type-M","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/index.html#module-type-Y","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=\"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