Collect occurrences information

CHANGES.md

@@ -1,5 +1,11 @@
 # (unreleased)
 
+### Added
+
+- Improve jump to implementation in rendered source code, and add a
+  `count-occurrences` flag and command to count occurrences of every identifiers
+  (@panglesd, #976)
+
 # 2.4.0
 
 ### Added

doc/driver.mld

@@ -135,7 +135,8 @@ Compiling a file with [odoc] requires a few arguments: the file to compile, an
 optional parent, a list of include paths, a list of children for [.mld] files,
 optional parent and name for source implementation, and an output path. Include
 paths can be just ['.'], and we can calculate the output file from the input
-because all of the files are going into the same directory.
+because all of the files are going into the same directory. If we wish to count
+occurrences of each identifier, we need to pass the [--count-occurrences] flag.
 
 Linking a file with [odoc] requires the input file and a list of include paths. As
 for compile, we will hard-code the include path.
@@ -148,6 +149,9 @@ Using the [--source] argument with an [.odocl] file that was not compiled with
 [--source-parent-file] and [--source-name] will result in an error, as will omitting [--source] when generating HTML of an [odocl] that was
 compiled with [--source-parent-file] and [--source-name].
 
+To get the number of uses of each identifier, we can use the [count-occurrences]
+command.
+
 In all of these, we'll capture [stdout] and [stderr] so we can check it later.
 
 {[
@@ -209,7 +213,7 @@ let add_prefixed_output cmd list prefix lines =
       !list
       @ Bos.Cmd.to_string cmd :: List.map (fun l -> prefix ^ ": " ^ l) lines
 
-let compile file ?parent ?(output_dir = Fpath.v "./")
+let compile file ?(count_occurrences = true) ?parent ?(output_dir = Fpath.v "./")
     ?(ignore_output = false) ?source_args children =
   let output_basename =
     let ext = Fpath.get_ext file in
@@ -237,8 +241,9 @@ let compile file ?parent ?(output_dir = Fpath.v "./")
     | _ -> Cmd.empty
     else Cmd.empty
   in
+  let occ = if count_occurrences then Cmd.v "--count-occurrences" else Cmd.empty in
   let cmd =
-    odoc % "compile" % Fpath.to_string file %% source_args %% cmt_arg
+    odoc % "compile" % Fpath.to_string file %% source_args %% occ %% cmt_arg
     % "-I" % "." % "-o" % p output_file
     |> List.fold_right (fun child cmd -> cmd % "--child" % child) children
   in
@@ -289,6 +294,11 @@ let support_files () =
   let open Cmd in
   let cmd = odoc % "support-files" % "-o" % "html/odoc" in
   run cmd
+
+let count_occurrences output =
+  let open Cmd in
+  let cmd = odoc % "count-occurrences" % "-I" % "." % "-o" % p output in
+  run cmd
 ]}
 
 
@@ -750,6 +760,7 @@ let compiled = compile_all () in
 let linked = link_all compiled in
 let () = index_generate () in
 let _ = js_index () in
+let _ = count_occurrences (Fpath.v "occurrences-odoc_and_deps.odoc") in
 generate_all linked
 ]}
 

src/document/generator.ml

@@ -252,18 +252,43 @@ module Make (Syntax : SYNTAX) = struct
     let path id = Url.Path.from_identifier id
     let url id = Url.from_path (path id)
 
+    let to_link { Lang.Source_info.documentation; implementation } =
+      let documentation =
+        (* Since documentation link are not rendered, we comment the code to
+           extract the href, and always output [None] *)
+        ignore documentation;
+        None
+        (* let open Paths.Path.Resolved in *)
+        (* match documentation with *)
+        (* | Some (`Resolved p) when not (is_hidden (p :> t)) -> ( *)
+        (*     let id = identifier (p :> t) in *)
+        (*     match Url.from_identifier ~stop_before:false id with *)
+        (*     | Ok link -> Some link *)
+        (*     | _ -> None) *)
+        (* | _ -> None *)
+      in
+      let implementation =
+        match implementation with
+        | Some (Odoc_model.Lang.Source_info.Resolved id) -> (
+            match Url.Anchor.from_identifier (id :> Paths.Identifier.t) with
+            | Ok url -> Some url
+            | Error _ -> None)
+        | _ -> None
+      in
+      Some (Source_page.Link { implementation; documentation })
+
     let info_of_info : Lang.Source_info.annotation -> Source_page.info option =
       function
-      | Value id -> (
-          match Url.Anchor.from_identifier (id :> Paths.Identifier.t) with
-          | Ok url -> Some (Link url)
-          | Error _ -> None)
       | Definition id -> (
           match id.iv with
           | `SourceLocation (_, def) -> Some (Anchor (DefName.to_string def))
           | `SourceLocationInternal (_, local) ->
               Some (Anchor (LocalName.to_string local))
           | _ -> None)
+      | Module v -> to_link v
+      | ModuleType v -> to_link v
+      | Type v -> to_link v
+      | Value v -> to_link v
 
     let source id syntax_info infos source_code =
       let url = path id in
@@ -1784,8 +1809,8 @@ module Make (Syntax : SYNTAX) = struct
       in
       let source_anchor =
         match t.source_info with
-        | Some src -> Some (Source_page.url src.id)
-        | None -> None
+        | Some { id = Some id; _ } -> Some (Source_page.url id)
+        | _ -> None
       in
       let page = make_expansion_page ~source_anchor url [ unit_doc ] items in
       Document.Page page

src/document/types.ml

@@ -183,7 +183,11 @@ end =
   Page
 
 and Source_page : sig
-  type info = Syntax of string | Anchor of string | Link of Url.Anchor.t
+  type target = {
+    documentation : Url.Anchor.t option;
+    implementation : Url.Anchor.t option;
+  }
+  type info = Syntax of string | Anchor of string | Link of target
 
   type code = span list
   and span = Tagged_code of info * code | Plain_code of string

src/document/url.ml

@@ -33,8 +33,6 @@ let render_path : Odoc_model.Paths.Path.t -> string =
     | `CanonicalModuleType (p, _) -> render_resolved (p :> t)
     | `CanonicalType (_, `Resolved p) -> render_resolved (p :> t)
     | `CanonicalType (p, _) -> render_resolved (p :> t)
-    | `CanonicalDataType (_, `Resolved p) -> render_resolved (p :> t)
-    | `CanonicalDataType (p, _) -> render_resolved (p :> t)
     | `Apply (rp, p) ->
         render_resolved (rp :> t)
         ^ "("
@@ -44,8 +42,6 @@ let render_path : Odoc_model.Paths.Path.t -> string =
         render_resolved (p :> t) ^ "." ^ ModuleTypeName.to_string s
     | `Type (p, s) -> render_resolved (p :> t) ^ "." ^ TypeName.to_string s
     | `Value (p, s) -> render_resolved (p :> t) ^ "." ^ ValueName.to_string s
-    | `Constructor (p, s) ->
-        render_resolved (p :> t) ^ "." ^ ConstructorName.to_string s
     | `Class (p, s) -> render_resolved (p :> t) ^ "." ^ ClassName.to_string s
     | `ClassType (p, s) ->
         render_resolved (p :> t) ^ "." ^ ClassTypeName.to_string s

src/html/html_source.ml

@@ -24,7 +24,9 @@ let html_of_doc ~config ~resolve docs =
         let children = List.concat @@ List.map (doc_to_html ~is_in_a) docs in
         match info with
         | Syntax tok -> [ span ~a:[ a_class [ tok ] ] children ]
-        | Link anchor ->
+        (* Currently, we do not render links to documentation *)
+        | Link { documentation = _; implementation = None } -> children
+        | Link { documentation = _; implementation = Some anchor } ->
             let href = Link.href ~config ~resolve anchor in
             [ a ~a:[ a_href href ] children ]
         | Anchor lbl -> [ span ~a:[ a_id lbl ] children ])

src/html_support_files/odoc.css

@@ -1390,4 +1390,4 @@ td.def-doc *:first-child {
    WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
    ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
    OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-  ---------------------------------------------------------------------------*/
+  ---------------------------------------------------------------------------*/

src/loader/cmi.ml

@@ -967,7 +967,7 @@ and read_module_declaration env parent ident (md : Odoc_model.Compat.module_decl
   let hidden =
     match canonical with
     | Some _ -> false
-    | None -> Odoc_model.Root.contains_double_underscore (Ident.name ident)
+    | None -> Odoc_model.Names.contains_double_underscore (Ident.name ident)
   in
   {id; locs; doc; type_; canonical; hidden }
 

src/loader/cmt.ml

@@ -449,11 +449,11 @@ and read_module_binding env parent mb =
   let hidden =
 #if OCAML_VERSION >= (4,10,0)
     match canonical, mb.mb_id with
-    | None, Some id -> Odoc_model.Root.contains_double_underscore (Ident.name id)
+    | None, Some id -> Odoc_model.Names.contains_double_underscore (Ident.name id)
     | _, _ -> false
 #else
     match canonical with
-    | None -> Odoc_model.Root.contains_double_underscore (Ident.name mb.mb_id)
+    | None -> Odoc_model.Names.contains_double_underscore (Ident.name mb.mb_id)
     | _ -> false
 #endif
   in

src/loader/cmti.ml

@@ -628,11 +628,11 @@ and read_module_declaration env parent md =
   let hidden =
 #if OCAML_VERSION >= (4,10,0)
     match canonical, md.md_id with
-    | None, Some id -> Odoc_model.Root.contains_double_underscore (Ident.name id)
+    | None, Some id -> Odoc_model.Names.contains_double_underscore (Ident.name id)
     | _,_ -> false
 #else
     match canonical with
-    | None -> Odoc_model.Root.contains_double_underscore (Ident.name md.md_id)
+    | None -> Odoc_model.Names.contains_double_underscore (Ident.name md.md_id)
     | _ -> false
 #endif
   in

src/loader/ident_env.cppo.ml

@@ -547,7 +547,7 @@ let add_items : Id.Signature.t -> item list -> t -> t = fun parent items env ->
 
     | `Module (t, is_hidden_item, loc) :: rest ->
       let name = Ident.name t in
-      let double_underscore = Odoc_model.Root.contains_double_underscore name in
+      let double_underscore = Odoc_model.Names.contains_double_underscore name in
       let is_hidden = is_hidden_item || module_name_exists name rest || double_underscore in
       let identifier, hidden =
         if is_hidden 
@@ -708,6 +708,9 @@ module Path = struct
       `Identifier (find_type env id, false)
     with Not_found -> assert false
 
+  let read_value_ident env id : Paths.Path.Value.t =
+    `Identifier (find_value_identifier env id, false)
+
   let read_class_type_ident env id : Paths.Path.ClassType.t =
     try
       `Identifier (find_class_type env id, false)
@@ -786,6 +789,18 @@ module Path = struct
     | Path.Pextra_ty (p,_) -> read_type env p
 #endif
 
+  let read_value env = function
+    | Path.Pident id -> read_value_ident env id
+#if OCAML_VERSION >= (4,8,0)
+    | Path.Pdot(p, s) -> `Dot(read_module env p, s)
+#else
+    | Path.Pdot(p, s, _) -> `Dot(read_module env p, s)
+#endif
+    | Path.Papply(_, _) -> assert false
+#if OCAML_VERSION >= (5,1,0)
+    | Path.Pextra_ty _ -> assert false
+#endif
+
 end
 
 module Fragment = struct

src/loader/ident_env.cppo.mli

@@ -40,6 +40,8 @@ module Path : sig
   val read_type : t -> Path.t -> Paths.Path.Type.t
 
   val read_class_type : t -> Path.t -> Paths.Path.ClassType.t
+
+  val read_value : t -> Path.t -> Paths.Path.Value.t
 end
 
 val find_module : t -> Ident.t -> Paths.Path.Module.t