Occurrences: add a command to aggregate occurrence tables

panglesd · jonludlam · commit 12027339bae5 · 2023-12-15T12:55:02.000Z
Signed-off-by: Paul-Elliot &lt;peada@free.fr&gt;
diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml
@@ -1111,27 +1111,74 @@ module Targets = struct
 end
 
 module Occurrences = struct
-  let index directories dst warnings_options =
-    let dst = Fpath.v dst in
-    Occurrences.count ~dst ~warnings_options directories
+  module Count = struct
+    let index directories dst warnings_options =
+      let dst = Fpath.v dst in
+      Occurrences.count ~dst ~warnings_options directories
 
-  let cmd =
-    let dst =
-      let doc = "Output file path." in
-      Arg.(
-        required & opt (some string) None & info ~docs ~docv:"PATH" ~doc [ "o" ])
-    in
-    Term.(
-      const handle_error
-      $ (const index $ odoc_file_directories $ dst $ warnings_options))
+    let cmd =
+      let dst =
+        let doc = "Output file path." in
+        Arg.(
+          required
+          & opt (some string) None
+          & info ~docs ~docv:"PATH" ~doc [ "o" ])
+      in
+      Term.(
+        const handle_error
+        $ (const index $ odoc_file_directories $ dst $ warnings_options))
 
-  let info ~docs =
-    let doc =
-      "Generate a hashtable mapping identifiers to number of occurrences, as \
-       computed from the implementations of .odocl files found in the given \
-       directories."
-    in
-    Term.info "count-occurrences" ~docs ~doc
+    let info ~docs =
+      let doc =
+        "Generate a hashtable mapping identifiers to number of occurrences, as \
+         computed from the implementations of .odocl files found in the given \
+         directories."
+      in
+      Term.info "count-occurrences" ~docs ~doc
+  end
+  module Aggregate = struct
+    let index dst files file_list warnings_options =
+      match (files, file_list) with
+      | [], [] ->
+          Error
+            (`Msg
+              "At least one of --file-list or a path to a file must be passed \
+               to odoc aggregate-occurrences")
+      | _ ->
+          let dst = Fpath.v dst in
+          Occurrences.aggregate ~dst ~warnings_options files file_list
+
+    let cmd =
+      let dst =
+        let doc = "Output file path." in
+        Arg.(
+          required
+          & opt (some string) None
+          & info ~docs ~docv:"PATH" ~doc [ "o" ])
+      in
+      let inputs_in_file =
+        let doc =
+          "Input text file containing a line-separated list of paths to files \
+           created with count-occurrences."
+        in
+        Arg.(
+          value & opt_all convert_fpath []
+          & info ~doc ~docv:"FILE" [ "file-list" ])
+      in
+      let inputs =
+        let doc = "file created with count-occurrences" in
+        Arg.(value & pos_all convert_fpath [] & info ~doc ~docv:"FILE" [])
+      in
+      Term.(
+        const handle_error
+        $ (const index $ dst $ inputs $ inputs_in_file $ warnings_options))
+
+    let info ~docs =
+      let doc =
+        "Aggregate hashtables created with odoc count-occurrences."
+      in
+      Term.info "aggregate-occurrences" ~docs ~doc
+  end
 end
 
 module Odoc_error = struct
@@ -1174,7 +1221,8 @@ let () =
   Printexc.record_backtrace true;
   let subcommands =
     [
-      Occurrences.(cmd, info ~docs:section_pipeline);
+      Occurrences.Count.(cmd, info ~docs:section_pipeline);
+      Occurrences.Aggregate.(cmd, info ~docs:section_pipeline);
       Compile.(cmd, info ~docs:section_pipeline);
       Odoc_link.(cmd, info ~docs:section_pipeline);
       Odoc_html.generate ~docs:section_pipeline;
diff --git a/src/odoc/occurrences.ml b/src/odoc/occurrences.ml
@@ -142,7 +142,10 @@ let count ~dst ~warnings_options:_ directories =
           | Type { documentation = Some (`Resolved p as p'); _ }, _ ->
               incr htbl p Odoc_model.Paths.Path.((p' : Type.t :> t))
           | _ -> ())
-        (match unit.source_info with None -> [] | Some i -> i.infos)
+        (match unit.source_info with
+        | None -> []
+        | Some i ->
+            i.infos)
     in
     ()
   in
@@ -151,3 +154,53 @@ let count ~dst ~warnings_options:_ directories =
   let oc = open_out_bin (Fs.File.to_string dst) in
   Marshal.to_channel oc htbl [];
   Ok ()
+
+open Astring
+open Or_error
+
+let parse_input_file input =
+  let is_sep = function '\n' | '\r' -> true | _ -> false in
+  Fs.File.read input >>= fun content ->
+  let files =
+    String.fields ~empty:false ~is_sep content |> List.rev_map Fs.File.of_string
+  in
+  Ok files
+
+let parse_input_files input =
+  List.fold_left
+    (fun acc file ->
+      acc >>= fun acc ->
+      parse_input_file file >>= fun files -> Ok (files :: acc))
+    (Ok []) input
+  >>= fun files -> Ok (List.concat files)
+
+let aggregate files file_list ~warnings_options:_ ~dst =
+  parse_input_files file_list >>= fun new_files ->
+  let files = files @ new_files in
+  let from_file file : Occtbl.t =
+    let ic = open_in_bin (Fs.File.to_string file) in
+    Marshal.from_channel ic
+  in
+  let rec loop n f =
+    if n > 0 then (
+      f ();
+      loop (n - 1) f)
+    else ()
+  in
+  let occtbl =
+    match files with
+    | [] -> H.create 0
+    | file1 :: files ->
+        let acc = from_file file1 in
+        List.iter
+          (fun file ->
+            Occtbl.iter
+              (fun id { direct; _ } ->
+                loop direct (fun () -> Occtbl.add acc id))
+              (from_file file))
+          files;
+        acc
+  in
+  let oc = open_out_bin (Fs.File.to_string dst) in
+  Marshal.to_channel oc occtbl [];
+  Ok ()
diff --git a/test/occurrences/double_wrapped.t/run.t b/test/occurrences/double_wrapped.t/run.t
@@ -13,7 +13,6 @@ The module B depends on both B and C, the module C only depends on A.
 Passing the count-occurrences flag to odoc compile makes it collect the
 occurrences information.
 
-
   $ odoc compile --count-occurrences -I . main__A.cmt
   $ odoc compile --count-occurrences -I . main__C.cmt
   $ odoc compile --count-occurrences -I . main__B.cmt
@@ -26,22 +25,45 @@ occurrences information.
   $ odoc link -I . main__C.odoc
   $ odoc link -I . main__.odoc
 
+  $ odoc html-generate -o html main.odocl
+  $ odoc html-generate -o html main__A.odocl
+  $ odoc html-generate -o html main__B.odocl
+  $ odoc html-generate -o html main__C.odocl
+  $ odoc html-generate -o html main__.odocl
+
 The count occurrences command outputs a marshalled hashtable, whose keys are
 odoc identifiers, and whose values are integers corresponding to the number of
-uses.
+uses. We can later aggregate those hashtables, so we create the full hashtable,
+and a hashtable for each compilation unit.
+
+  $ mkdir dir1
+  $ mkdir dir2
+  $ mkdir dir3
+  $ mkdir dir4
+  $ mkdir dir5
 
+  $ mv main.odocl dir1
+  $ mv main__.odocl dir2
+  $ mv main__A.odocl dir3
+  $ mv main__B.odocl dir4
+  $ mv main__C.odocl dir5
   $ odoc count-occurrences -I . -o occurrences.txt
+  $ odoc count-occurrences -I dir1 -o occurrences1.txt
+  $ odoc count-occurrences -I dir2 -o occurrences2.txt
+  $ odoc count-occurrences -I dir3 -o occurrences3.txt
+  $ odoc count-occurrences -I dir4 -o occurrences4.txt
+  $ odoc count-occurrences -I dir5 -o occurrences5.txt
 
   $ du -h occurrences.txt
   4.0K	occurrences.txt
 
 The occurrences_print executable, available only for testing, unmarshal the file
 and prints the number of occurrences in a readable format.
 
-Uses of A and B are counted correctly, with the path rewritten correctly.
-Uses of C are not counted, since the canonical destination (generated by dune) does not exist.
+Uses of A are: 2 times in b.ml, 1 time in c.ml, 1 time in main.ml
+Uses of B are: 1 time in main.ml
+Uses of C are not counted, since the canonical destination (Main.C, generated by dune) does not exist.
 Uses of values Y.x and Z.y (in b.ml) are not counted since they come from a "local" module.
-Uses of values Main__.C.y and Main__.A.x are not rewritten since we use references instead of paths.
 
   $ occurrences_print occurrences.txt | sort
   Main was used directly 0 times and indirectly 11 times
@@ -52,3 +74,45 @@ Uses of values Main__.C.y and Main__.A.x are not rewritten since we use referenc
   Main.A.x was used directly 2 times and indirectly 0 times
   Main.B was used directly 1 times and indirectly 0 times
   string was used directly 1 times and indirectly 0 times
+
+  $ occurrences_print occurrences1.txt | sort
+  Main was used directly 0 times and indirectly 2 times
+  Main.A was used directly 1 times and indirectly 0 times
+  Main.B was used directly 1 times and indirectly 0 times
+
+  $ occurrences_print occurrences2.txt | sort
+
+  $ occurrences_print occurrences3.txt | sort
+  string was used directly 1 times and indirectly 0 times
+
+  $ occurrences_print occurrences4.txt | sort
+  Main was used directly 0 times and indirectly 7 times
+  Main.A was used directly 2 times and indirectly 5 times
+  Main.A.(||>) was used directly 1 times and indirectly 0 times
+  Main.A.M was used directly 2 times and indirectly 0 times
+  Main.A.t was used directly 1 times and indirectly 0 times
+  Main.A.x was used directly 1 times and indirectly 0 times
+
+  $ occurrences_print occurrences5.txt | sort
+  Main was used directly 0 times and indirectly 2 times
+  Main.A was used directly 1 times and indirectly 1 times
+  Main.A.x was used directly 1 times and indirectly 0 times
+
+Now we can merge both files
+
+  $ cat > files.map << EOF
+  > occurrences3.txt
+  > occurrences4.txt
+  > occurrences5.txt
+  > EOF
+  $ odoc aggregate-occurrences occurrences1.txt occurrences2.txt --file-list files.map -o aggregated.txt
+
+  $ occurrences_print aggregated.txt | sort
+  Main was used directly 0 times and indirectly 11 times
+  Main.A was used directly 4 times and indirectly 6 times
+  Main.A.(||>) was used directly 1 times and indirectly 0 times
+  Main.A.M was used directly 2 times and indirectly 0 times
+  Main.A.t was used directly 1 times and indirectly 0 times
+  Main.A.x was used directly 2 times and indirectly 0 times
+  Main.B was used directly 1 times and indirectly 0 times
+  string was used directly 1 times and indirectly 0 times
diff --git a/test/odoc_print/occurrences_print.ml b/test/odoc_print/occurrences_print.ml
@@ -2,7 +2,7 @@ module H = Hashtbl.Make (Odoc_model.Paths.Identifier)
 
 let run inp =
   let ic = open_in_bin inp in
-  let htbl : Odoc_odoc.Occurrences.Occtbl.item Odoc_odoc.Occurrences.H.t =
+  let htbl : Odoc_odoc.Occurrences.Occtbl.t =
     Marshal.from_channel ic
   in
   Odoc_odoc.Occurrences.Occtbl.iter
