diff --git a/CHANGES.md b/CHANGES.md index 6c0522c64d..b9f7f065bd 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -21,6 +21,9 @@ used for sidebar (@panglesd, #1145) - Allow referencing of polymorphic constructors in polymorphic variant type aliases (@panglesd, #1115) +- Added a `--occurrences` argument to the `compile-index` command to output the + number of occurrences of each entry of the index in the json output + (@panglesd, #1076). ### Changed diff --git a/doc/driver.mld b/doc/driver.mld index 138da96f05..dd3d51c535 100644 --- a/doc/driver.mld +++ b/doc/driver.mld @@ -774,12 +774,16 @@ Some more details about the json format: {- ["display"], which is a json object. It contains two fields: {ul {- ["url"], a string. It is the URL to the entry in the documentation, relative to the base of the documentation} - {- ["html"], also a string. It is the html odoc uses to display the entry in the search results.}}}}}} + {- ["html"], also a string. It is the html odoc uses to display the entry in the search results.}}} + {- Additionally, the ["occurrences"] field exists if and only if the [--occurrences] flag was given to the [odoc compile-index] command. When it exists, it contains a json object, with two fields: + {ul + {- ["direct"], an integer. It is the number of direct uses of the entry. For instance, [open M] and [Make(M)] contain direct uses of [M], while [1 + M.v] contains an indirect use of [M] and a direct use of [M.v].} + {- ["indirect"], an integer containing the number of indirect uses of the entry.}}}}}} Search engines written in OCaml can also call the [Odoc_model.Fold.unit] and [Odoc_model.Fold.page] function, in conjunction with [Odoc_search.Entry.entry_of_item] in order to get an OCaml value of each element to be indexed. {[ -let index_generate ?(ignore_output = false) () = +let index_generate ?(ignore_output = false) occurrence_file = let open Cmd in let files = OS.Dir.contents (Fpath.v ".") @@ -792,7 +796,7 @@ let index_generate ?(ignore_output = false) () = let index_map = Fpath.v "index.map" in let () = Bos.OS.File.write_lines index_map files |> get_ok in let cmd = - odoc % "compile-index" % "-o" % "html/index.json" % "--file-list" + odoc % "compile-index" % "-o" % "html/index.json" % "--occurrences" % p occurrence_file % "--file-list" % p index_map in let lines = run cmd in @@ -851,7 +855,9 @@ The following code executes all of the above, and we're done! {[ let compiled = compile_all () in let linked = link_all compiled in -let () = index_generate () in +let occurrence_file = Fpath.v "occurrences-odoc_and_deps.odoc" in +let _ = count_occurrences occurrence_file in +let () = index_generate occurrence_file in let _ = js_index () in let _ = count_occurrences (Fpath.v "occurrences-from-odoc.odoc") in generate_all linked diff --git a/src/occurrences/dune b/src/occurrences/dune new file mode 100644 index 0000000000..8cf8ce1920 --- /dev/null +++ b/src/occurrences/dune @@ -0,0 +1,4 @@ +(library + (name odoc_occurrences) + (public_name odoc.occurrences) + (libraries odoc_model)) diff --git a/src/occurrences/odoc_occurrences.ml b/src/occurrences/odoc_occurrences.ml new file mode 100644 index 0000000000..1bf5b40f1b --- /dev/null +++ b/src/occurrences/odoc_occurrences.ml @@ -0,0 +1,24 @@ +module Table = Table + +let of_impl ~include_hidden unit htbl = + let incr tbl p = + let open Odoc_model.Paths.Path.Resolved in + let p = (p :> t) in + let id = identifier p in + if (not (is_hidden p)) || include_hidden then Table.add tbl id + in + let open Odoc_model.Lang in + List.iter + (function + | Source_info.Module { documentation = Some (`Resolved p); _ }, _ -> + incr htbl p + | Value { documentation = Some (`Resolved p); _ }, _ -> incr htbl p + | ModuleType { documentation = Some (`Resolved p); _ }, _ -> incr htbl p + | Type { documentation = Some (`Resolved p); _ }, _ -> incr htbl p + | _ -> ()) + unit.Implementation.source_info + +let aggregate ~tbl ~data = + Table.iter + (fun id { Table.direct; _ } -> Table.add ~quantity:direct tbl id) + data diff --git a/src/occurrences/odoc_occurrences.mli b/src/occurrences/odoc_occurrences.mli new file mode 100644 index 0000000000..99b55a10d9 --- /dev/null +++ b/src/occurrences/odoc_occurrences.mli @@ -0,0 +1,9 @@ +open Odoc_model.Lang + +module Table = Table + +val of_impl : include_hidden:bool -> Implementation.t -> Table.t -> unit +(** Add all occurrences from implementation of a compilation unit into a table *) + +val aggregate : tbl:Table.t -> data:Table.t -> unit +(** Aggregate [data] into [tbl] *) diff --git a/src/occurrences/table.ml b/src/occurrences/table.ml new file mode 100644 index 0000000000..5004d97aa2 --- /dev/null +++ b/src/occurrences/table.ml @@ -0,0 +1,95 @@ +module H = Hashtbl.Make (Odoc_model.Paths.Identifier) + +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 + +let add ?(quantity = 1) tbl id = + let rec add ?(kind = `Indirect) id = + let incr htbl id = + let { direct; indirect; sub } = + try H.find htbl id with Not_found -> v_item () + in + let direct, indirect = + match kind with + | `Direct -> (direct + quantity, indirect) + | `Indirect -> (direct, indirect + quantity) + in + H.replace htbl id { direct; indirect; sub }; + sub + in + let do_ parent = + let htbl = add (parent :> key) in + incr htbl id + in + match id.iv with + | `InstanceVariable (parent, _) -> do_ parent + | `Parameter (parent, _) -> do_ parent + | `Module (parent, _) -> do_ parent + | `ModuleType (parent, _) -> do_ parent + | `Method (parent, _) -> do_ parent + | `Field (parent, _) -> do_ parent + | `Extension (parent, _) -> do_ parent + | `Type (parent, _) -> do_ parent + | `CoreType _ -> incr tbl id + | `Constructor (parent, _) -> do_ parent + | `Exception (parent, _) -> do_ parent + | `ExtensionDecl (parent, _, _) -> do_ parent + | `Class (parent, _) -> do_ parent + | `Value (parent, _) -> do_ parent + | `ClassType (parent, _) -> do_ parent + | `Root _ -> incr tbl id + | `SourcePage _ | `Page _ | `LeafPage _ | `SourceLocation _ + | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _ + | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ -> + assert false + in + let _htbl = add ~kind:`Direct id in + () + +let rec get t id = + let do_ parent = + get t (parent :> key) |> function + | None -> None + | Some { sub; _ } -> ( try Some (H.find sub id) with Not_found -> None) + in + match id.iv with + | `InstanceVariable (parent, _) -> do_ parent + | `Parameter (parent, _) -> do_ parent + | `Module (parent, _) -> do_ parent + | `ModuleType (parent, _) -> do_ parent + | `Method (parent, _) -> do_ parent + | `Field (parent, _) -> do_ parent + | `Extension (parent, _) -> do_ parent + | `ExtensionDecl (parent, _, _) -> do_ parent + | `Type (parent, _) -> do_ parent + | `Constructor (parent, _) -> do_ parent + | `Exception (parent, _) -> do_ parent + | `Class (parent, _) -> do_ parent + | `Value (parent, _) -> do_ parent + | `ClassType (parent, _) -> do_ parent + | `Root _ -> ( try Some (H.find t id) with Not_found -> None) + | `SourcePage _ | `Page _ | `LeafPage _ | `CoreType _ | `SourceLocation _ + | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _ + | `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 new file mode 100644 index 0000000000..954aaba55f --- /dev/null +++ b/src/occurrences/table.mli @@ -0,0 +1,11 @@ +type t +type item = { direct : int; indirect : int } +type key = Odoc_model.Paths.Identifier.t + +val v : unit -> t + +val add : ?quantity:int -> t -> key -> unit + +val iter : (key -> item -> unit) -> t -> unit + +val get : t -> key -> item option diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index 94aa46784b..41dddc29f4 100644 --- a/src/odoc/bin/main.ml +++ b/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 = diff --git a/src/odoc/dune b/src/odoc/dune index 3b967f805f..6cf692f2ed 100644 --- a/src/odoc/dune +++ b/src/odoc/dune @@ -12,6 +12,7 @@ odoc_model odoc_json_index odoc_xref2 + odoc_occurrences tyxml unix) (instrumentation diff --git a/src/odoc/indexing.ml b/src/odoc/indexing.ml index 243ab062fa..086315f96f 100644 --- a/src/odoc/indexing.ml +++ b/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,13 +110,23 @@ 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 = let current_dir = Fs.File.dirname output in 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: @@ -175,5 +185,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 diff --git a/src/odoc/indexing.mli b/src/odoc/indexing.mli index 57d1f784e0..104a6e5aa5 100644 --- a/src/odoc/indexing.mli +++ b/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 -> diff --git a/src/odoc/occurrences.ml b/src/odoc/occurrences.ml index ceb20dc874..696ab8c71d 100644 --- a/src/odoc/occurrences.ml +++ b/src/odoc/occurrences.ml @@ -34,130 +34,10 @@ let fold_dirs ~dirs ~f ~init = acc dir) (Ok init) -module H = Hashtbl.Make (Odoc_model.Paths.Identifier) - -module Occtbl : sig - type item = { direct : int; indirect : int; sub : item H.t } - type t = item H.t - type key = Odoc_model.Paths.Identifier.t - val v : unit -> t - - val add : t -> key -> unit - - val iter : (key -> item -> unit) -> t -> unit - - val get : t -> key -> item option -end = struct - type item = { direct : int; indirect : int; sub : item H.t } - type t = item H.t - type key = Odoc_model.Paths.Identifier.t - - let v_item () = { direct = 0; indirect = 0; sub = H.create 0 } - - let v () = H.create 0 - - let add tbl id = - let rec add ?(kind = `Indirect) id = - let incr htbl id = - let { direct; indirect; sub } = - try H.find htbl id with Not_found -> v_item () - in - let direct, indirect = - match kind with - | `Direct -> (direct + 1, indirect) - | `Indirect -> (direct, indirect + 1) - in - H.replace htbl id { direct; indirect; sub }; - sub - in - let do_ parent = - let htbl = add (parent :> key) in - incr htbl id - in - match id.iv with - | `InstanceVariable (parent, _) -> do_ parent - | `Parameter (parent, _) -> do_ parent - | `Module (parent, _) -> do_ parent - | `ModuleType (parent, _) -> do_ parent - | `Method (parent, _) -> do_ parent - | `Field (parent, _) -> do_ parent - | `Extension (parent, _) -> do_ parent - | `Type (parent, _) -> do_ parent - | `CoreType _ -> incr tbl id - | `Constructor (parent, _) -> do_ parent - | `Exception (parent, _) -> do_ parent - | `ExtensionDecl (parent, _, _) -> do_ parent - | `Class (parent, _) -> do_ parent - | `Value (parent, _) -> do_ parent - | `ClassType (parent, _) -> do_ parent - | `Root _ -> incr tbl id - | `SourcePage _ | `Page _ | `LeafPage _ | `SourceLocation _ - | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _ - | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ -> - assert false - in - let _htbl = add ~kind:`Direct id in - () - - let rec get t id = - let do_ parent = - get t (parent :> key) |> function - | None -> None - | Some { sub; _ } -> ( try Some (H.find sub id) with Not_found -> None) - in - match id.iv with - | `InstanceVariable (parent, _) -> do_ parent - | `Parameter (parent, _) -> do_ parent - | `Module (parent, _) -> do_ parent - | `ModuleType (parent, _) -> do_ parent - | `Method (parent, _) -> do_ parent - | `Field (parent, _) -> do_ parent - | `Extension (parent, _) -> do_ parent - | `ExtensionDecl (parent, _, _) -> do_ parent - | `Type (parent, _) -> do_ parent - | `Constructor (parent, _) -> do_ parent - | `Exception (parent, _) -> do_ parent - | `Class (parent, _) -> do_ parent - | `Value (parent, _) -> do_ parent - | `ClassType (parent, _) -> do_ parent - | `Root _ -> ( try Some (H.find t id) with Not_found -> None) - | `SourcePage _ | `Page _ | `LeafPage _ | `CoreType _ | `SourceLocation _ - | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _ - | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ -> - assert false - - let rec iter f tbl = - H.iter - (fun id v -> - iter f v.sub; - f id v) - tbl -end - let count ~dst ~warnings_options:_ directories include_hidden = - let htbl = H.create 100 in + let htbl = Odoc_occurrences.Table.v () in let f () (unit : Odoc_model.Lang.Implementation.t) = - let incr tbl p = - let p = (p :> Odoc_model.Paths.Path.Resolved.t) in - let id = Odoc_model.Paths.Path.Resolved.identifier p in - if (not (Odoc_model.Paths.Path.Resolved.is_hidden p)) || include_hidden - then Occtbl.add tbl id - in - let () = - List.iter - (function - | ( Odoc_model.Lang.Source_info.Module - { documentation = Some (`Resolved p); _ }, - _ ) -> - incr htbl p - | Value { documentation = Some (`Resolved p); _ }, _ -> incr htbl p - | ModuleType { documentation = Some (`Resolved p); _ }, _ -> - incr htbl p - | Type { documentation = Some (`Resolved p); _ }, _ -> incr htbl p - | _ -> ()) - unit.source_info - in - () + Odoc_occurrences.of_impl ~include_hidden unit htbl in fold_dirs ~dirs:directories ~f ~init:() >>= fun () -> Fs.Directory.mkdir_p (Fs.File.dirname dst); @@ -188,27 +68,18 @@ let aggregate files file_list ~warnings_options:_ ~dst = try parse_input_files file_list >>= fun new_files -> let files = files @ new_files in - let from_file file : Occtbl.t = + let from_file file : Odoc_occurrences.Table.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 + | [] -> Odoc_occurrences.Table.v () + | file :: files -> + let acc = from_file file in List.iter (fun file -> - Occtbl.iter - (fun id { direct; _ } -> - loop direct (fun () -> Occtbl.add acc id)) - (from_file file)) + Odoc_occurrences.aggregate ~tbl:acc ~data:(from_file file)) files; acc in diff --git a/src/search/json_index/dune b/src/search/json_index/dune index f625f79a5c..9776729fde 100644 --- 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 index f4f54fd34f..f7a5c3e697 100644 --- 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,25 @@ 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 { Odoc_occurrences.Table.direct; indirect } -> + [ + ( "occurrences", + `Object + [ + ("direct", `Float (float_of_int direct)); + ("indirect", `Float (float_of_int indirect)); + ] ); + ] + | None -> [] + 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)) | Error _ as e -> e let output_json ppf first entries = @@ -180,8 +194,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 +206,23 @@ 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 -> ( + match Odoc_occurrences.Table.get occurrences id with + | Some x -> Some x + | None -> Some { direct = 0; indirect = 0 }) + 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 +234,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 +245,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 diff --git a/src/search/json_index/json_search.mli b/src/search/json_index/json_search.mli index 018ab445a9..89d9e2e9d6 100644 --- a/src/search/json_index/json_search.mli +++ b/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 -> diff --git a/test/occurrences/double_wrapped.t/run.t b/test/occurrences/double_wrapped.t/run.t index 4c2ff752f9..8a883e67a0 100644 --- a/test/occurrences/double_wrapped.t/run.t +++ b/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":"modMain

Handwritten top-level module

"},"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":"modMain.A
"},"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":"modMain.B
"},"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":"modMain.B.M
"},"occurrences":{"direct":0,"indirect":0}} + {"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":"modMain.B.Y
"},"occurrences":{"direct":0,"indirect":0}} + {"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":"modMain.B.Z
"},"occurrences":{"direct":0,"indirect":0}} + {"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":"modMain.B.Z.Y
"},"occurrences":{"direct":0,"indirect":0}} + {"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":"sigMain.A.M
"},"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":"sigMain.B.Y
"},"occurrences":{"direct":0,"indirect":0}} + {"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":"typeMain.A.t = string
"},"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":"valMain.A.(||>) : int -> int -> int
"},"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":"valMain.A.x : int
"},"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":"valMain.B.y : int
"},"occurrences":{"direct":0,"indirect":0}} + {"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":"valMain.B.Z.y : int
"},"occurrences":{"direct":0,"indirect":0}} + + $ 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": "modMain

Handwritten top-level module

" + }, + "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: 0, indirect: 0 + Root-Main.Module-B.Module-Y, direct: 0, indirect: 0 + Root-Main.Module-B.Module-Z, direct: 0, indirect: 0 + Root-Main.Module-B.Module-Z.Module-Y, direct: 0, indirect: 0 + Root-Main.Module-B.Module-Z.Value-y, direct: 0, indirect: 0 + Root-Main.Module-B.ModuleType-Y, direct: 0, indirect: 0 + Root-Main.Module-B.Value-y, direct: 0, indirect: 0 diff --git a/test/odoc_print/occurrences_print.ml b/test/odoc_print/occurrences_print.ml index eb2f8c4284..b8adaea436 100644 --- a/test/odoc_print/occurrences_print.ml +++ b/test/odoc_print/occurrences_print.ml @@ -2,9 +2,9 @@ module H = Hashtbl.Make (Odoc_model.Paths.Identifier) let run inp = let ic = open_in_bin inp in - let htbl : Odoc_odoc.Occurrences.Occtbl.t = Marshal.from_channel ic in - Odoc_odoc.Occurrences.Occtbl.iter - (fun id { Odoc_odoc.Occurrences.Occtbl.direct; indirect; _ } -> + let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in + Odoc_occurrences.Table.iter + (fun id { Odoc_occurrences.Table.direct; indirect; _ } -> let id = String.concat "." (Odoc_model.Paths.Identifier.fullname id) in Format.printf "%s was used directly %d times and indirectly %d times\n" id direct indirect)