From b527639730d469da46ff7bf6150f859816f6be9e Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Mon, 7 Oct 2024 10:21:11 +0200 Subject: [PATCH] Count-occurrences: consistency and driver support Made the count-occurrences command a bit more consistent: - output names are now `name.odoc-occurrences` instead of `occurrences-name.odoc` (similar to "index" artifacts) - input dirs are positional arguments instead of `-I` (which are for search path). Also, implemented support for counting occurrences, and passing that to the search indexing, in the reference driver. --- src/driver/compile.ml | 7 ++-- src/driver/compile.mli | 2 +- src/driver/odoc.ml | 21 +++++++++--- src/driver/odoc.mli | 3 +- src/driver/odoc_driver.ml | 9 ++++- src/odoc/bin/main.ml | 23 +++++++------ src/odoc/occurrences.ml | 14 ++------ test/occurrences/double_wrapped.t/run.t | 44 ++++++++++++------------- 8 files changed, 69 insertions(+), 54 deletions(-) diff --git a/src/driver/compile.ml b/src/driver/compile.ml index 1eace17a98..893110dd07 100644 --- a/src/driver/compile.ml +++ b/src/driver/compile.ml @@ -225,7 +225,7 @@ let sherlodoc_index_one ~output_dir (index : Odoc_unit.index) = Sherlodoc.index ~format:`js ~inputs ~dst (); rel_path -let html_generate output_dir linked = +let html_generate ~occurrence_file output_dir linked = let tbl = Hashtbl.create 10 in let _ = OS.Dir.create output_dir |> Result.get_ok in Sherlodoc.js Fpath.(output_dir // Sherlodoc.js_file); @@ -235,7 +235,10 @@ let html_generate output_dir linked = ({ pkg_args = { pages; libs }; output_file; json; search_dir = _ } as index : Odoc_unit.index) = - let () = Odoc.compile_index ~json ~output_file ~libs ~docs:pages () in + let () = + Odoc.compile_index ~json ~occurrence_file ~output_file ~libs ~docs:pages + () + in sherlodoc_index_one ~output_dir index in match Hashtbl.find_opt tbl index.output_file with diff --git a/src/driver/compile.mli b/src/driver/compile.mli index 772e5cfee6..e7809b89cb 100644 --- a/src/driver/compile.mli +++ b/src/driver/compile.mli @@ -18,4 +18,4 @@ type linked val link : compiled list -> linked list -val html_generate : Fpath.t -> linked list -> unit +val html_generate : occurrence_file:Fpath.t -> Fpath.t -> linked list -> unit diff --git a/src/driver/odoc.ml b/src/driver/odoc.ml index 9fe020cab3..846dc4709b 100644 --- a/src/driver/odoc.ml +++ b/src/driver/odoc.ml @@ -138,13 +138,20 @@ let link ?(ignore_output = false) ~input_file:file ?output_file ~includes ~docs Cmd_outputs.( add_prefixed_output cmd link_output (Fpath.to_string file) lines) -let compile_index ?(ignore_output = false) ~output_file ~json ~docs ~libs () = +let compile_index ?(ignore_output = false) ~output_file ?occurrence_file ~json + ~docs ~libs () = let docs = doc_args docs in let libs = lib_args libs in let json = if json then Cmd.v "--json" else Cmd.empty in + let occ = + match occurrence_file with + | None -> Cmd.empty + | Some f -> Cmd.(v "--occurrences" % p f) + in let cmd = Cmd.( - !odoc % "compile-index" %% json %% v "-o" % p output_file %% docs %% libs) + !odoc % "compile-index" %% json %% v "-o" % p output_file %% docs %% libs + %% occ) in let desc = Printf.sprintf "Generating index for %s" (Fpath.to_string output_file) @@ -212,11 +219,15 @@ let support_files path = let desc = "Generating support files" in Cmd_outputs.submit desc cmd None -let count_occurrences output = +let count_occurrences ~input ~output = let open Cmd in - let cmd = !odoc % "count-occurrences" % "-I" % "." % "-o" % p output in + let input = Cmd.of_values Fpath.to_string input in + let output_c = v "-o" % p output in + let cmd = !odoc % "count-occurrences" %% input %% output_c in let desc = "Counting occurrences" in - Cmd_outputs.submit desc cmd None + let lines = Cmd_outputs.submit desc cmd None in + Cmd_outputs.( + add_prefixed_output cmd generate_output (Fpath.to_string output) lines) let source_tree ?(ignore_output = false) ~parent ~output file = let open Cmd in diff --git a/src/driver/odoc.mli b/src/driver/odoc.mli index 6c45f940b6..acf7aa19af 100644 --- a/src/driver/odoc.mli +++ b/src/driver/odoc.mli @@ -42,6 +42,7 @@ val link : val compile_index : ?ignore_output:bool -> output_file:Fpath.t -> + ?occurrence_file:Fpath.t -> json:bool -> docs:(string * Fpath.t) list -> libs:(string * Fpath.t) list -> @@ -76,6 +77,6 @@ val html_generate_source : val support_files : Fpath.t -> string list -val count_occurrences : Fpath.t -> string list +val count_occurrences : input:Fpath.t list -> output:Fpath.t -> unit val source_tree : ?ignore_output:bool -> parent:string -> output:Fpath.t -> Fpath.t -> unit diff --git a/src/driver/odoc_driver.ml b/src/driver/odoc_driver.ml index ec032ffc4e..e01bdee765 100644 --- a/src/driver/odoc_driver.ml +++ b/src/driver/odoc_driver.ml @@ -577,7 +577,14 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers all in let linked = Compile.link compiled in - let () = Compile.html_generate html_dir linked in + let occurrence_file = + let output = + Fpath.( / ) odoc_dir "occurrences-all.odoc-occurrences" + in + let () = Odoc.count_occurrences ~input:[ odoc_dir ] ~output in + output + in + let () = Compile.html_generate ~occurrence_file html_dir linked in let _ = Odoc.support_files html_dir in ()) (fun () -> render_stats env nb_workers) diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index 6e1e686884..bafb996fb0 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -1438,16 +1438,10 @@ end module Occurrences = struct open Or_error - let has_occurrences_prefix input = - input |> Fs.File.basename |> Fs.File.to_string - |> Astring.String.is_prefix ~affix:"occurrences-" - let dst_of_string s = let f = Fs.File.of_string s in - if not (Fs.File.has_ext ".odoc" f) then - Error (`Msg "Output file must have '.odoc' extension.") - else if not (has_occurrences_prefix f) then - Error (`Msg "Output file must be prefixed with 'occurrences-'.") + if not (Fs.File.has_ext ".odoc-occurrences" f) then + Error (`Msg "Output file must have '.odoc-occurrences' extension.") else Ok f module Count = struct @@ -1467,10 +1461,19 @@ module Occurrences = struct let doc = "Include hidden identifiers in the table" in Arg.(value & flag & info ~docs ~doc [ "include-hidden" ]) in + let input = + let doc = + "Directories to recursively traverse, agregating occurrences from \ + $(i,impl-*.odocl) files. Can be present several times." + in + Arg.( + value + & pos_all (convert_directory ()) [] + & info ~docs ~docv:"DIR" ~doc []) + in Term.( const handle_error - $ (const count $ odoc_file_directories $ dst $ warnings_options - $ include_hidden)) + $ (const count $ input $ dst $ warnings_options $ include_hidden)) let info ~docs = let doc = diff --git a/src/odoc/occurrences.ml b/src/odoc/occurrences.ml index 696ab8c71d..bd8f91561a 100644 --- a/src/odoc/occurrences.ml +++ b/src/odoc/occurrences.ml @@ -1,18 +1,8 @@ open Or_error - -(* Copied from ocaml 5.0 String module *) -let string_starts_with ~prefix s = - let open String in - let len_s = length s and len_pre = length prefix in - let rec aux i = - if i = len_pre then true - else if unsafe_get s i <> unsafe_get prefix i then false - else aux (i + 1) - in - len_s >= len_pre && aux 0 +open Astring let handle_file file ~f = - if string_starts_with ~prefix:"impl-" (Fpath.filename file) then + if String.is_prefix ~affix:"impl-" (Fpath.filename file) then Odoc_file.load file |> function | Error _ as e -> e | Ok unit' -> ( diff --git a/test/occurrences/double_wrapped.t/run.t b/test/occurrences/double_wrapped.t/run.t index 8a883e67a0..1f1e71d24e 100644 --- a/test/occurrences/double_wrapped.t/run.t +++ b/test/occurrences/double_wrapped.t/run.t @@ -50,11 +50,11 @@ and a hashtable for each compilation unit. $ mv impl-main__A.odocl main__A $ mv impl-main__B.odocl main__B $ mv impl-main__C.odocl main__C - $ odoc count-occurrences -I main -o occurrences-main.odoc - $ odoc count-occurrences -I main__ -o occurrences-main__.odoc - $ odoc count-occurrences -I main__A -o occurrences-main__A.odoc - $ odoc count-occurrences -I main__B -o occurrences-main__B.odoc - $ odoc count-occurrences -I main__C -o occurrences-main__C.odoc + $ odoc count-occurrences main -o main.odoc-occurrences + $ odoc count-occurrences main__ -o main__.odoc-occurrences + $ odoc count-occurrences main__A -o main__A.odoc-occurrences + $ odoc count-occurrences main__B -o main__B.odoc-occurrences + $ odoc count-occurrences main__C -o main__C.odoc-occurrences The occurrences_print executable, available only for testing, unmarshal the file and prints the number of occurrences in a readable format. @@ -65,18 +65,18 @@ Uses of C are not counted, since the canonical destination (Main.C, generated by Uses of B.Z are not counted since they go to a hidden module. Uses of values Y.x and Z.y (in b.ml) are not counted since they come from a "local" module. - $ occurrences_print occurrences-main.odoc | sort + $ occurrences_print main.odoc-occurrences | 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 occurrences-main__.odoc | sort + $ occurrences_print main__.odoc-occurrences | sort A only uses "persistent" values: one it defines itself. - $ occurrences_print occurrences-main__A.odoc | sort + $ occurrences_print main__A.odoc-occurrences | sort "Aliased" values are not counted since they become persistent - $ occurrences_print occurrences-main__B.odoc | sort + $ occurrences_print main__B.odoc-occurrences | 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 @@ -85,7 +85,7 @@ A only uses "persistent" values: one it defines itself. Main.A.x was used directly 1 times and indirectly 0 times "Aliased" values are not counted since they become persistent - $ occurrences_print occurrences-main__C.odoc | sort + $ occurrences_print main__C.odoc-occurrences | 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 @@ -93,13 +93,13 @@ A only uses "persistent" values: one it defines itself. Now we can merge all tables $ cat > files.map << EOF - > occurrences-main__A.odoc - > occurrences-main__B.odoc - > occurrences-main__C.odoc + > main__A.odoc-occurrences + > main__B.odoc-occurrences + > main__C.odoc-occurrences > EOF - $ odoc aggregate-occurrences occurrences-main.odoc occurrences-main__.odoc --file-list files.map -o occurrences-aggregated.odoc + $ odoc aggregate-occurrences main.odoc-occurrences main__.odoc-occurrences --file-list files.map -o aggregated.odoc-occurrences - $ occurrences_print occurrences-aggregated.odoc | sort > all_merged + $ occurrences_print aggregated.odoc-occurrences | sort > all_merged $ cat all_merged Main was used directly 0 times and indirectly 11 times Main.A was used directly 4 times and indirectly 6 times @@ -111,14 +111,14 @@ Now we can merge all tables Compare with the one created directly with all occurrences: - $ odoc count-occurrences -I . -o occurrences-all.odoc - $ occurrences_print occurrences-all.odoc | sort > directly_all + $ odoc count-occurrences . -o all.odoc-occurrences + $ occurrences_print all.odoc-occurrences | sort > directly_all $ diff all_merged directly_all We can also include hidden ids: - $ odoc count-occurrences -I main__B -o occurrences-b.odoc --include-hidden - $ occurrences_print occurrences-b.odoc | sort + $ odoc count-occurrences main__B -o b.odoc-occurrences --include-hidden + $ occurrences_print b.odoc-occurrences | 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 @@ -129,8 +129,8 @@ We can also include hidden ids: Main__.C was used directly 1 times and indirectly 1 times Main__.C.y was used directly 1 times and indirectly 0 times - $ odoc count-occurrences -I . -o occurrences-all.odoc --include-hidden - $ occurrences_print occurrences-all.odoc | sort + $ odoc count-occurrences . -o all.odoc-occurrences --include-hidden + $ occurrences_print all.odoc-occurrences | 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 @@ -149,7 +149,7 @@ 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 + $ odoc compile-index --json -o index.json --occurrences all.odoc-occurrences 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":"modMain

Handwritten top-level module

"},"occurrences":{"direct":0,"indirect":11}}