Show packages and libraries in the breadcrumbs

CHANGES.md

@@ -31,6 +31,7 @@
 - Add a 'remap' option to HTML generation for partial docsets (@jonludlam, #1189)
 - Added an `html-generate-asset` command (@panglesd, #1185)
 - Added syntax for images, videos, audio (@panglesd, #1184)
+- Show packages and libraries names in breadcrumbs (@Julow, #1190)
 
 ### Changed
 

src/document/doctree.ml

@@ -329,11 +329,12 @@ end = struct
     | `ClassType -> prefix "Class type"
     | `Class -> prefix "Class"
     | `SourcePage -> prefix "Source file"
+    | `Library -> prefix "Library"
     | `Page | `LeafPage | `File -> []
 
   let make_name_from_path { Url.Path.name; parent; _ } =
     match parent with
-    | None | Some { kind = `Page; _ } -> name
+    | None | Some { kind = `Page | `Library; _ } -> name
     | Some p -> Printf.sprintf "%s.%s" p.name name
 
   let render_title ?source_anchor (p : Page.t) =

src/document/url.ml

@@ -106,7 +106,8 @@ module Path = struct
     | `Class
     | `ClassType
     | `File
-    | `SourcePage ]
+    | `SourcePage
+    | `Library ]
 
   let string_of_kind : kind -> string = function
     | `Page -> "page"
@@ -118,8 +119,7 @@ module Path = struct
     | `ClassType -> "class-type"
     | `File -> "file"
     | `SourcePage -> "source"
-
-  let pp_kind fmt kind = Format.fprintf fmt "%s" (string_of_kind kind)
+    | `Library -> "library"
 
   type t = { kind : kind; parent : t option; name : string }
 
@@ -146,6 +146,13 @@ module Path = struct
         let kind = `Page in
         let name = PageName.to_string page_name in
         mk ?parent kind name
+    | { iv = `Library (parent, _page_name, libname); _ } ->
+        let parent =
+          match parent with
+          | Some p -> Some (from_identifier (p :> any))
+          | None -> None
+        in
+        mk ?parent `Library libname
     | { iv = `LeafPage (parent, page_name); _ } ->
         let parent =
           match parent with
@@ -210,11 +217,13 @@ module Path = struct
     in
     inner None l
 
-  let split :
-      is_dir:(kind -> [ `Always | `Never | `IfNotLast ]) ->
-      (kind * string) list ->
-      (kind * string) list * (kind * string) list =
-   fun ~is_dir l ->
+  let split ~is_flat ~allow_empty l =
+    let is_dir =
+      if is_flat then function
+        | `Page | `Library -> if allow_empty then `Always else `IfNotLast
+        | _ -> `Never
+      else function `LeafPage | `File | `SourcePage -> `Never | _ -> `Always
+    in
     let rec inner dirs = function
       | [ ((kind, _) as x) ] when is_dir kind = `IfNotLast ->
           (List.rev dirs, [ x ])
@@ -252,8 +261,6 @@ module Anchor = struct
     | `Field -> "field"
     | `SourceAnchor -> "source-anchor"
 
-  let pp_kind fmt kind = Format.fprintf fmt "%s" (string_of_kind kind)
-
   type t = { page : Path.t; anchor : string; kind : kind }
 
   let anchorify_path { Path.parent; name; kind } =
@@ -292,6 +299,9 @@ module Anchor = struct
     | { iv = `Page _; _ } as p ->
         let page = Path.from_identifier (p :> Path.any) in
         Ok { page; kind = `Page; anchor = "" }
+    | { iv = `Library _; _ } as p ->
+        let page = Path.from_identifier (p :> Path.any) in
+        Ok { page; kind = `Library; anchor = "" }
     | { iv = `LeafPage _; _ } as p ->
         let page = Path.from_identifier (p :> Path.any) in
         Ok { page; kind = `LeafPage; anchor = "" }
@@ -308,7 +318,7 @@ module Anchor = struct
           {
             page;
             anchor =
-              Format.asprintf "%a-%s" pp_kind kind
+              Format.asprintf "%s-%s" (string_of_kind kind)
                 (TypeName.to_string type_name);
             kind;
           }
@@ -321,7 +331,7 @@ module Anchor = struct
           {
             page;
             anchor =
-              Format.asprintf "%a-%s" pp_kind kind
+              Format.asprintf "%s-%s" (string_of_kind kind)
                 (ExtensionName.to_string name);
             kind;
           }
@@ -332,7 +342,7 @@ module Anchor = struct
           {
             page;
             anchor =
-              Format.asprintf "%a-%s" pp_kind kind
+              Format.asprintf "%s-%s" (string_of_kind kind)
                 (ExtensionName.to_string name);
             kind;
           }
@@ -343,7 +353,7 @@ module Anchor = struct
           {
             page;
             anchor =
-              Format.asprintf "%a-%s" pp_kind kind
+              Format.asprintf "%s-%s" (string_of_kind kind)
                 (ExceptionName.to_string name);
             kind;
           }
@@ -356,21 +366,30 @@ module Anchor = struct
           {
             page;
             anchor =
-              Format.asprintf "%a-%s" pp_kind kind (ValueName.to_string name);
+              Format.asprintf "%s-%s" (string_of_kind kind)
+                (ValueName.to_string name);
             kind;
           }
     | { iv = `Method (parent, name); _ } ->
         let str_name = MethodName.to_string name in
         let page = Path.from_identifier (parent :> Path.any) in
         let kind = `Method in
         Ok
-          { page; anchor = Format.asprintf "%a-%s" pp_kind kind str_name; kind }
+          {
+            page;
+            anchor = Format.asprintf "%s-%s" (string_of_kind kind) str_name;
+            kind;
+          }
     | { iv = `InstanceVariable (parent, name); _ } ->
         let str_name = InstanceVariableName.to_string name in
         let page = Path.from_identifier (parent :> Path.any) in
         let kind = `Val in
         Ok
-          { page; anchor = Format.asprintf "%a-%s" pp_kind kind str_name; kind }
+          {
+            page;
+            anchor = Format.asprintf "%s-%s" (string_of_kind kind) str_name;
+            kind;
+          }
     | { iv = `Constructor (parent, name); _ } ->
         from_identifier (parent :> Identifier.t) >>= fun page ->
         let kind = `Constructor in
@@ -436,7 +455,7 @@ module Anchor = struct
     let page = Path.from_identifier (decl.parent :> Path.any) in
     let kind = `ExtensionDecl in
     let first_cons = Identifier.name (List.hd decl.constructors).id in
-    let anchor = Format.asprintf "%a-%s" pp_kind kind first_cons in
+    let anchor = Format.asprintf "%s-%s" (string_of_kind kind) first_cons in
     { page; kind; anchor }
 
   let source_anchor path anchor = { page = path; anchor; kind = `SourceAnchor }

src/document/url.mli

@@ -21,9 +21,8 @@ module Path : sig
     | `Class
     | `ClassType
     | `File
-    | `SourcePage ]
-
-  val pp_kind : Format.formatter -> kind -> unit
+    | `SourcePage
+    | `Library ]
 
   val string_of_kind : kind -> string
 
@@ -45,18 +44,16 @@ module Path : sig
   val of_list : (kind * string) list -> t option
 
   val split :
-    is_dir:(kind -> [ `Always | `Never | `IfNotLast ]) ->
+    is_flat:bool ->
+    allow_empty:bool ->
     (kind * string) list ->
     (kind * string) list * (kind * string) list
-  (** [split is_dir path] splits the list [path] into a directory
-      and filename, based on the [is_dir] function. The function
-      [is_dir] should return whether or not the path element [kind]
-      should be a directory or not. If the function [is_dir] returns
-      [`IfNotLast] then the element will be a directory only if it
-      is not the last element in the path. The return value is a tuple
-      of directory-type elements and filename-type elements. If the
-      [is_dir] function can return [`Always], the caller must be prepared
-      to handle the case where the filename part is empty. *)
+  (** [split ~is_flat path] splits the list [path] into a directory
+      and filename. Returns a tuple
+      of directory-type elements and filename-type elements. If [allow_empty]
+      is [true], the filename part will be empty if all components are
+      directory-type. If [allow_empty] is [false], the last element will part
+      of the filename, even if it is a directory-type. *)
 end
 
 module Anchor : sig
@@ -73,8 +70,6 @@ module Anchor : sig
     | `Field
     | `SourceAnchor ]
 
-  val pp_kind : Format.formatter -> kind -> unit
-
   val string_of_kind : kind -> string
 
   type t = {

src/html/generator.ml

@@ -14,7 +14,10 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 module HLink = Link
+
+open Odoc_utils
 open Odoc_document.Types
+
 module Html = Tyxml.Html
 module Doctree = Odoc_document.Doctree
 module Url = Odoc_document.Url
@@ -499,23 +502,27 @@ module Breadcrumbs = struct
   open Types
 
   let gen_breadcrumbs ~config ~url =
-    let rec get_parent_paths x =
-      match x with
-      | [] -> []
-      | x :: xs -> (
-          match Odoc_document.Url.Path.of_list (List.rev (x :: xs)) with
-          | Some x -> x :: get_parent_paths xs
-          | None -> get_parent_paths xs)
+    let resolve = Link.Current url in
+    let breadcrumb ?(prefix = "") url =
+      let href = Link.href ~config ~resolve (Url.from_path url) in
+      { href; name = prefix ^ url.name; kind = url.kind }
     in
-    let to_breadcrumb path =
-      let href =
-        Link.href ~config ~resolve:(Current url)
-          (Odoc_document.Url.from_path path)
-      in
-      { href; name = path.name; kind = path.kind }
+    let rec package url =
+      match url.Url.Path.parent with
+      | None -> breadcrumb ~prefix:"Package " url
+      | Some url -> package url
+    in
+    let rec rhs (url : Url.Path.t) =
+      match url with
+      | { kind = `Library; parent; _ } ->
+          let package = Option.map package parent in
+          (* Don't list components that separates the package and library names. *)
+          breadcrumb ~prefix:"Library " url :: Option.to_list package
+      | { parent = None; kind = `Page; _ } -> [ package url ]
+      | { parent = None; _ } -> [ breadcrumb url ]
+      | { parent = Some parent; _ } -> breadcrumb url :: rhs parent
     in
-    get_parent_paths (List.rev (Odoc_document.Url.Path.to_list url))
-    |> List.rev |> List.map to_breadcrumb
+    List.rev (rhs url)
 end
 
 module Page = struct

src/html/link.ml

@@ -8,8 +8,8 @@ module Path = struct
 
   let segment_to_string (kind, name) =
     match kind with
-    | `Module | `Page | `File | `SourcePage -> name
-    | _ -> Format.asprintf "%a-%s" Url.Path.pp_kind kind name
+    | `Module | `Page | `File | `Library | `SourcePage -> name
+    | _ -> Format.asprintf "%s-%s" (Url.Path.string_of_kind kind) name
 
   let is_leaf_page url = url.Url.Path.kind = `LeafPage
 
@@ -29,11 +29,8 @@ module Path = struct
 
   let get_dir_and_file ~config url =
     let l = Url.Path.to_list url in
-    let is_dir =
-      if Config.flat config then function `Page -> `Always | _ -> `Never
-      else function `LeafPage | `File | `SourcePage -> `Never | _ -> `Always
-    in
-    let dir, file = Url.Path.split ~is_dir l in
+    let is_flat = Config.flat config in
+    let dir, file = Url.Path.split ~is_flat ~allow_empty:true l in
     let dir = List.map segment_to_string dir in
     let file =
       match file with

src/latex/generator.ml

@@ -4,11 +4,10 @@ module Doctree = Odoc_document.Doctree
 
 module Link = struct
   let rec flatten_path ppf (x : Odoc_document.Url.Path.t) =
+    let kind = Odoc_document.Url.Path.string_of_kind x.kind in
     match x.parent with
-    | Some p ->
-        Fmt.pf ppf "%a-%a-%s" flatten_path p Odoc_document.Url.Path.pp_kind
-          x.kind x.name
-    | None -> Fmt.pf ppf "%a-%s" Odoc_document.Url.Path.pp_kind x.kind x.name
+    | Some p -> Fmt.pf ppf "%a-%s-%s" flatten_path p kind x.name
+    | None -> Fmt.pf ppf "%s-%s" kind x.name
 
   let page p = Format.asprintf "%a" flatten_path p
 
@@ -19,7 +18,7 @@ module Link = struct
 
   let rec is_class_or_module_path (url : Odoc_document.Url.Path.t) =
     match url.kind with
-    | `Module | `LeafPage | `Class | `Page -> (
+    | `Module | `LeafPage | `Class | `Page | `Library -> (
         match url.parent with
         | None -> true
         | Some url -> is_class_or_module_path url)
@@ -34,8 +33,7 @@ module Link = struct
   let get_dir_and_file url =
     let open Odoc_document in
     let l = Url.Path.to_list url in
-    let is_dir = function `Page -> `IfNotLast | _ -> `Never in
-    let dir, file = Url.Path.split ~is_dir l in
+    let dir, file = Url.Path.split ~is_flat:true ~allow_empty:false l in
     let segment_to_string (_kind, name) = name in
     ( List.map segment_to_string dir,
       String.concat "." (List.map segment_to_string file) )

src/loader/implementation.ml

@@ -221,7 +221,7 @@ let anchor_of_identifier id =
     | `Class (parent, name) ->
         let anchor = anchor `Class (TypeName.to_string name) in
         continue anchor parent
-    | `Page _ -> assert false
+    | `Page _ | `Library _ -> assert false
     | `LeafPage _ -> assert false
     | `CoreType _ -> assert false
     | `SourceLocation _ -> assert false

src/manpage/link.ml

@@ -4,24 +4,21 @@ let for_printing url = List.map snd @@ Url.Path.to_list url
 
 let segment_to_string (kind, name) =
   match kind with
-  | `Module | `Page | `LeafPage | `Class -> name
-  | _ -> Format.asprintf "%a-%s" Odoc_document.Url.Path.pp_kind kind name
+  | `Module | `Page | `Library | `LeafPage | `Class -> name
+  | _ ->
+      Format.asprintf "%s-%s" (Odoc_document.Url.Path.string_of_kind kind) name
 
 let as_filename ?(add_ext = true) (url : Url.Path.t) =
   let components = Url.Path.to_list url in
-  let dir, path =
-    Url.Path.split
-      ~is_dir:(function `Page -> `IfNotLast | _ -> `Never)
-      components
-  in
+  let dir, path = Url.Path.split ~is_flat:true ~allow_empty:false components in
   let dir = List.map segment_to_string dir in
   let path = String.concat "." (List.map segment_to_string path) in
   let str_path = String.concat Fpath.dir_sep (dir @ [ path ]) in
   if add_ext then Fpath.(v str_path + ".3o") else Fpath.v str_path
 
 let rec is_class_or_module_path (url : Url.Path.t) =
   match url.kind with
-  | `Module | `LeafPage | `Page | `Class -> (
+  | `Module | `LeafPage | `Page | `Library | `Class -> (
       match url.parent with
       | None -> true
       | Some url -> is_class_or_module_path url)