<% (match maptoc with [] -> %>
Package contains no libraries
<% | _ -> %>
@@ -128,11 +132,13 @@ let render
<% | _ -> %>
Legend:
+ Page
Library
Module
Module type
Parameter
Class
- Class type
+ Class type
+ Source
<% ); %>
diff --git a/src/ocamlorg_frontend/components/package_breadcrumbs.eml b/src/ocamlorg_frontend/components/package_breadcrumbs.eml
index 8c43612933..6b071024cc 100644
--- a/src/ocamlorg_frontend/components/package_breadcrumbs.eml
+++ b/src/ocamlorg_frontend/components/package_breadcrumbs.eml
@@ -1,30 +1,33 @@
-type library_path_item =
- | Module of { name: string; href: string; }
- | ModuleType of { name: string; href: string; }
- | Parameter of { name: string; href: string; number: int; }
- | Class of { name: string; href: string; }
- | ClassType of { name: string; href: string; }
+type breadcrumb = {
+ name: string;
+ href: string option;
+}
-type docs_path =
- | Index
- | Page of string
- | Library of string * library_path_item list
+type path_item =
+ | Module of breadcrumb
+ | ModuleType of breadcrumb
+ | Parameter of breadcrumb * int
+ | Class of breadcrumb
+ | ClassType of breadcrumb
+ | Page of breadcrumb
-let kind_tag (m : library_path_item) = match m with
+let kind_tag (m : path_item) = match m with
| Module _ ->
Module
| ModuleType _ ->
Module type
- | Parameter { number; _ } ->
+ | Parameter (_, number) ->
" class="breadcrumbs-tag parameter-tag"><%s "Parameter #" ^ (Int.to_string number) %>
| Class _ ->
Class
| ClassType _ ->
Class type
+ | Page _ ->
+
Page
type path =
| Overview of string option
- | Documentation of (docs_path)
+ | Documentation of path_item list
let render_package_and_version
~path
@@ -57,54 +60,49 @@ let render_package_and_version
-type breadcrumb = {
- name: string;
- href: string;
-}
+let path_item_to_breadcrumb = function
+ | Module x | ModuleType x | Class x | ClassType x | Parameter (x, _) | Page x
+ ->
+ x
-let library_path_item_to_breadcrumb = function
- | Module x -> { name = x.name; href = x.href }
- | ModuleType x -> { name = x.name; href = x.href }
- | Class x -> { name = x.name; href = x.href }
- | ClassType x -> { name = x.name; href = x.href }
- | Parameter x -> { name = x.name; href = x.href }
+let is_page : path_item -> bool = function Page _ -> true | _ -> false
-let render_library_path_breadcrumbs
-~library_name
-~(path: library_path_item list) =
- let render_breadcrumb i b =
- if i < List.length path - 1 then
-
+let render_path_breadcrumbs
+~(path: path_item list) =
+ let pages, modules = List.partition is_page path in
+ let render_breadcrumb max i b =
+ match b.href with
+ | None when i < max ->
+
+ in
+ let page_items = List.fold_left (fun (i, acc) item ->
+ (i+1, acc ^ li (render_breadcrumb (List.length pages - 1) i (path_item_to_breadcrumb item)))) (0,"") pages |> snd in
+ let ms =
+ <%s! String.concat "
" (List.mapi (render_breadcrumb (List.length modules - 1)) (List.map path_item_to_breadcrumb modules)) %>
+ in
+ let last = kind_tag (List.hd (List.rev path)) in
+ if List.length modules > 0 then
+ page_items ^ li (ms ^ last)
+ else
+ page_items
let render_docs_path_breadcrumbs
-~(path: docs_path)
-(package: Package.package)
+~(path: path_item list)
=
- let version = Package.url_version package in
@@ -122,8 +120,7 @@ let render_overview_breadcrumbs
let render
~(path: path)
-(package: Package.package)
=
match path with
| Overview page -> render_overview_breadcrumbs page
- | Documentation (docs_path) -> render_docs_path_breadcrumbs ~path:docs_path package
+ | Documentation (docs_path) -> render_docs_path_breadcrumbs ~path:docs_path
diff --git a/src/ocamlorg_frontend/layouts/package_layout.eml b/src/ocamlorg_frontend/layouts/package_layout.eml
index 4f95ededfe..a8bf7b568b 100644
--- a/src/ocamlorg_frontend/layouts/package_layout.eml
+++ b/src/ocamlorg_frontend/layouts/package_layout.eml
@@ -199,7 +199,7 @@ Layout.base
let list_item = document.createElement("li");
let a = document.createElement("a");
- let href = "/" + entry.url;
+ let href = entry.url;
a.href = href;
a.id = "search-result-"+entry.id;
a.classList.add("search-entry", kind.innerText.slice(0,3));
diff --git a/src/ocamlorg_frontend/pages/package_documentation.eml b/src/ocamlorg_frontend/pages/package_documentation.eml
index 9632889a5b..9c2bd0f5d1 100644
--- a/src/ocamlorg_frontend/pages/package_documentation.eml
+++ b/src/ocamlorg_frontend/pages/package_documentation.eml
@@ -1,49 +1,48 @@
let sidebar
~str_path
-~toc
-~maptoc
+~local_toc
+~global_toc
(package : Package.package)
=
let right_sidebar
-~toc
+~local_toc
=
let render
~(path: Package_breadcrumbs.path)
~page
-~toc
-~maptoc
+~local_toc
+~global_toc
~content
(package : Package.package)
=
let str_path =
match path with
| Overview _ -> []
- | Documentation (docs_path) -> (match docs_path with
- | Package_breadcrumbs.Index -> []
- | Library (s, p) -> s :: List.map (function
- | Package_breadcrumbs.Module { name ; _ } -> name
- | ModuleType { name ; _ } -> name
- | Parameter { name ; _ } -> name
- | Class { name ; _ } -> name
- | ClassType { name ; _ } -> name
- ) p
- | Page s -> [""; s])
+ | Documentation (docs_path) ->
+ List.map (function
+ | Package_breadcrumbs.Module { name ; _ }
+ | ModuleType { name ; _ }
+ | Parameter ({ name ; _ }, _)
+ | Class { name ; _ }
+ | ClassType { name ; _ }
+ | Page { name; _ } -> name
+ ) docs_path |> List.tl
in
Package_layout.render
~title:(Printf.sprintf "%s %s ยท OCaml Package" package.name (Package.render_version package))
@@ -54,10 +53,10 @@ Package_layout.render
~documentation_status:Success
~canonical:(Url.Package.documentation package.name ~version:(Package.specific_version package) ~page:(Url.Package.documentation ?version:(Some (Package.specific_version package)) package.name))
~styles:["css/main.css"; "css/doc.css"]
-~left_sidebar_html:(sidebar ~str_path ~toc ~maptoc package)
-~right_sidebar_html:(right_sidebar ~toc) @@
+~left_sidebar_html:(sidebar ~str_path ~local_toc ~global_toc package)
+~right_sidebar_html:(right_sidebar ~local_toc) @@
- <%s! Package_breadcrumbs.render ~path package %>
+ <%s! Package_breadcrumbs.render ~path %>
<%s! content %>
diff --git a/src/ocamlorg_package/lib/config.ml b/src/ocamlorg_package/lib/config.ml
index 0896651660..dc7425a82d 100644
--- a/src/ocamlorg_package/lib/config.ml
+++ b/src/ocamlorg_package/lib/config.ml
@@ -5,7 +5,7 @@ let opam_polling =
let documentation_url =
Sys.getenv_opt "OCAMLORG_DOC_URL"
- |> Option.value ~default:"https://docs-data.ocaml.org/live/"
+ |> Option.value ~default:"https://sage.ci.dev/current/"
let package_caches_ttl =
env_with_default "OCAMLORG_PACKAGE_CACHES_TTL" "3600" |> float_of_string
diff --git a/src/ocamlorg_package/lib/documentation_status.ml b/src/ocamlorg_package/lib/documentation_status.ml
index b9b4303bf4..483e1137ef 100644
--- a/src/ocamlorg_package/lib/documentation_status.ml
+++ b/src/ocamlorg_package/lib/documentation_status.ml
@@ -1,34 +1,34 @@
-type otherdocs = {
- readme : string option;
- license : string option;
- changes : string option;
+type redirection = { old_path : string; new_path : string } [@@deriving yojson]
+
+type t = {
+ name : string;
+ version : string;
+ failed : bool;
+ files : string list;
+ redirections : redirection list;
}
+[@@deriving yojson]
+
+let has_file (v : t) (options : string list) : string option =
+ let children = v.files in
+ try
+ List.find_map
+ (fun x ->
+ let fname = Fpath.(v x |> rem_ext |> filename) in
+ if List.mem fname options then Some fname else None)
+ children
+ with Not_found -> None
-type t = { failed : bool; otherdocs : otherdocs }
+let license_names = [ "LICENSE"; "LICENCE" ]
+let readme_names = [ "README"; "Readme"; "readme" ]
-let first_opt = function x :: _ -> Some x | [] -> None
+let changelog_names =
+ [ "CHANGELOG"; "Changelog"; "changelog"; "CHANGES"; "Changes"; "changes" ]
-let strip_prefix (p : string option) =
- let v : string list option = Option.map (String.split_on_char '/') p in
- match v with
- | None -> None
- | Some (_ :: _ :: _ :: _ :: _ :: xs) -> Some (String.concat "/" xs)
- | _ -> None
+let is_special =
+ let names = license_names @ readme_names @ changelog_names in
+ fun x -> List.mem x names
-let of_yojson (v : Yojson.Safe.t) : t =
- let status = Voodoo_serialize.Status.of_yojson v in
- {
- failed = status.failed;
- otherdocs =
- {
- readme =
- status.otherdocs.readme |> first_opt |> Option.map Fpath.to_string
- |> strip_prefix;
- license =
- status.otherdocs.license |> first_opt |> Option.map Fpath.to_string
- |> strip_prefix;
- changes =
- status.otherdocs.changes |> first_opt |> Option.map Fpath.to_string
- |> strip_prefix;
- };
- }
+let license (v : t) = has_file v license_names
+let readme (v : t) = has_file v readme_names
+let changelog (v : t) = has_file v changelog_names
diff --git a/src/ocamlorg_package/lib/documentation_status.mli b/src/ocamlorg_package/lib/documentation_status.mli
index 90d1b0ad61..6bfa3e3a95 100644
--- a/src/ocamlorg_package/lib/documentation_status.mli
+++ b/src/ocamlorg_package/lib/documentation_status.mli
@@ -2,13 +2,18 @@
ocaml-docs-ci. If the documentation generation is successful, this file
should exist and contain info about the other pages present in the package. *)
-type otherdocs = {
- readme : string option;
- license : string option;
- changes : string option;
-}
+type redirection = { old_path : string; new_path : string } [@@deriving yojson]
-type t = { failed : bool; otherdocs : otherdocs }
+type t = {
+ name : string;
+ version : string;
+ failed : bool;
+ files : string list;
+ redirections : redirection list;
+}
+[@@deriving yojson]
-val of_yojson : Yojson.Safe.t -> t
-(** Parse the status from the JSON format of `status.json` *)
+val readme : t -> string option
+val license : t -> string option
+val changelog : t -> string option
+val is_special : string -> bool
diff --git a/src/ocamlorg_package/lib/dune b/src/ocamlorg_package/lib/dune
index 141953c717..120a29fd65 100644
--- a/src/ocamlorg_package/lib/dune
+++ b/src/ocamlorg_package/lib/dune
@@ -1,5 +1,7 @@
(library
(name ocamlorg_package)
+ (preprocess
+ (pps ppx_deriving_yojson))
(libraries
opam-format
bos
diff --git a/src/ocamlorg_package/lib/ocamlorg_package.ml b/src/ocamlorg_package/lib/ocamlorg_package.ml
index 086e485114..b4a217e2d0 100644
--- a/src/ocamlorg_package/lib/ocamlorg_package.ml
+++ b/src/ocamlorg_package/lib/ocamlorg_package.ml
@@ -10,6 +10,7 @@ end
module Version = OpamPackage.Version
module Info = Info
module Statistics = Packages_stats
+module Sidebar = Sidebar
type t = { name : Name.t; version : Version.t; info : Info.t }
@@ -240,6 +241,7 @@ module Documentation = struct
| Class
| ClassType
| File
+ | Source
let breadcrumb_kind_from_string s =
match s with
@@ -250,13 +252,18 @@ module Documentation = struct
| "class" -> Class
| "class-type" -> ClassType
| "file" -> File
+ | "source" -> Source
| _ ->
if String.starts_with ~prefix:"argument-" s then
let i = List.hd (List.tl (String.split_on_char '-' s)) in
Parameter (int_of_string i)
else raise (Invalid_argument ("kind not recognized: " ^ s))
- type breadcrumb = { name : string; href : string; kind : breadcrumb_kind }
+ type breadcrumb = {
+ name : string;
+ href : string option;
+ kind : breadcrumb_kind;
+ }
type t = {
uses_katex : bool;
@@ -280,13 +287,17 @@ module Documentation = struct
[
("name", `String name); ("href", `String href); ("kind", `String kind);
] ->
- { name; href; kind = breadcrumb_kind_from_string kind }
+ { name; href = Some href; kind = breadcrumb_kind_from_string kind }
+ | `Assoc [ ("name", `String name); ("href", `Null); ("kind", `String kind) ]
+ ->
+ { name; href = None; kind = breadcrumb_kind_from_string kind }
| _ -> raise (Invalid_argument "malformed breadcrumb field")
let doc_from_string s =
match Yojson.Safe.from_string s with
| `Assoc
[
+ ("header", `String header);
("type", `String _page_type);
("uses_katex", `Bool uses_katex);
("breadcrumbs", `List json_breadcrumbs);
@@ -295,17 +306,24 @@ module Documentation = struct
("preamble", `String preamble);
("content", `String content);
] ->
- let breadcrumbs =
- match List.map breadcrumb_from_json json_breadcrumbs with
- | _ :: _ :: _ :: _ :: breadcrumbs -> breadcrumbs
- | _ -> failwith "Not enough breadcrumbs"
- in
+ let breadcrumbs = List.map breadcrumb_from_json json_breadcrumbs in
{
uses_katex;
breadcrumbs;
toc = List.map toc_of_json json_toc;
- content = preamble ^ content;
+ content = header ^ preamble ^ content;
}
+ | `Assoc
+ [
+ ("type", `String "source");
+ ("breadcrumbs", `List json_breadcrumbs);
+ ("global_toc", _);
+ ("header", `String header);
+ ("content", `String content);
+ ] ->
+ let breadcrumbs = List.map breadcrumb_from_json json_breadcrumbs in
+ let content = header ^ content in
+ { uses_katex = false; breadcrumbs; toc = []; content }
| _ -> raise (Invalid_argument "malformed .html.json file")
end
@@ -345,20 +363,56 @@ let http_get url =
Logs.err (fun m -> m "%s" (Printexc.to_string e));
Lwt.return (Error (`Msg (Printexc.to_string e))))
-let module_map ~kind t =
+module Sidebar_cache : sig
+ val add :
+ Name.t ->
+ Version.t ->
+ [ `Package | `Universe of string ] ->
+ Sidebar.t ->
+ unit
+
+ val get :
+ Name.t ->
+ Version.t ->
+ [ `Package | `Universe of string ] ->
+ Sidebar.t option
+end = struct
+ let cache = Hashtbl.create 100
+
+ let add name version kind sidebar =
+ let name = Name.to_string name in
+ let version = Version.to_string version in
+ Hashtbl.add cache (name, version, kind) sidebar
+
+ let get name version kind =
+ let name = Name.to_string name in
+ let version = Version.to_string version in
+ Hashtbl.find_opt cache (name, version, kind)
+end
+
+let sidebar ~kind t =
let package_url =
package_url ~kind (Name.to_string t.name) (Version.to_string t.version)
in
let open Lwt.Syntax in
- let url = package_url ^ "package.json" in
- let+ content = http_get url in
- match content with
- | Ok v ->
- let json = Yojson.Safe.from_string v in
- Package_info.of_yojson json
- | Error _ ->
- Logs.info (fun m -> m "Failed to fetch module map at %s" url);
- { Package_info.libraries = String.Map.empty }
+ match Sidebar_cache.get t.name t.version kind with
+ | Some sidebar -> Lwt.return sidebar
+ | None -> (
+ let url = package_url ^ "doc/sidebar.json" in
+ let+ content = http_get url in
+ match content with
+ | Ok v -> (
+ let json = Yojson.Safe.from_string v in
+ match Sidebar.of_yojson json with
+ | Ok x ->
+ Sidebar_cache.add t.name t.version kind x;
+ x
+ | Error msg ->
+ Logs.info (fun m -> m "Failed to parse sidebar at %s: %s" url msg);
+ [])
+ | Error _ ->
+ Logs.info (fun m -> m "Failed to fetch sidebar at %s" url);
+ [])
let odoc_page ~url =
let open Lwt.Syntax in
@@ -384,6 +438,24 @@ let documentation_page ~kind t path =
let url = package_url ^ "doc/" ^ path ^ ".json" in
odoc_page ~url
+let odoc_asset ~url =
+ let open Lwt.Syntax in
+ let+ content = http_get url in
+ match content with
+ | Ok content ->
+ Logs.info (fun m -> m "Found documentation page for %s" url);
+ Some content
+ | Error _ ->
+ Logs.info (fun m -> m "Failed to fetch asset for %s" url);
+ None
+
+let documentation_asset ~kind t path =
+ let package_url =
+ package_url ~kind (Name.to_string t.name) (Version.to_string t.version)
+ in
+ let url = package_url ^ "doc/" ^ path in
+ odoc_asset ~url
+
let file ~kind t path =
let package_url =
package_url ~kind (Name.to_string t.name) (Version.to_string t.version)
@@ -395,7 +467,7 @@ let search_index ~kind t =
let package_url =
package_url ~kind (Name.to_string t.name) (Version.to_string t.version)
in
- let url = package_url ^ "index.js" in
+ let url = package_url ^ "doc/index.js" in
let open Lwt.Syntax in
let* content = http_get url in
@@ -448,9 +520,13 @@ let documentation_status ~kind state t : Documentation_status.t option Lwt.t =
let+ content = http_get (package_url ^ "status.json") in
let status =
match content with
- | Ok s ->
- Some (s |> Yojson.Safe.from_string |> Documentation_status.of_yojson)
- | _ -> None
+ | Ok s -> (
+ match
+ s |> Yojson.Safe.from_string |> Documentation_status.of_yojson
+ with
+ | Ok status -> Some status
+ | Error _TODO -> None)
+ | Error _TODO -> None
in
let status_entry =
{ documentation_status = status; time = Unix.gettimeofday () }
diff --git a/src/ocamlorg_package/lib/ocamlorg_package.mli b/src/ocamlorg_package/lib/ocamlorg_package.mli
index 70a3a34100..ef506d44b2 100644
--- a/src/ocamlorg_package/lib/ocamlorg_package.mli
+++ b/src/ocamlorg_package/lib/ocamlorg_package.mli
@@ -80,8 +80,13 @@ module Documentation : sig
| Class
| ClassType
| File
+ | Source
- type breadcrumb = { name : string; href : string; kind : breadcrumb_kind }
+ type breadcrumb = {
+ name : string;
+ href : string option;
+ kind : breadcrumb_kind;
+ }
type t = {
uses_katex : bool;
@@ -92,6 +97,7 @@ module Documentation : sig
end
module Package_info = Package_info
+module Sidebar = Sidebar
type state
type t
@@ -111,15 +117,7 @@ val info : t -> Info.t
val create : name:Name.t -> version:Version.t -> Info.t -> t
(** This is added to enable demo test package to use Package.t with abstraction *)
-module Documentation_status : sig
- type otherdocs = {
- readme : string option;
- license : string option;
- changes : string option;
- }
-
- type t = { failed : bool; otherdocs : otherdocs }
-end
+module Documentation_status = Documentation_status
val documentation_status :
kind:[< `Package | `Universe of string ] ->
@@ -128,9 +126,8 @@ val documentation_status :
Documentation_status.t option Lwt.t
(** Get the build status of the documentation of a package *)
-val module_map :
- kind:[< `Package | `Universe of string ] -> t -> Package_info.t Lwt.t
-(** Get the module map of a package *)
+val sidebar : kind:[ `Package | `Universe of string ] -> t -> Sidebar.t Lwt.t
+(** Get the sidebar of a package *)
val documentation_page :
kind:[< `Package | `Universe of string ] ->
@@ -140,6 +137,11 @@ val documentation_page :
(** Get the rendered content of an HTML page for a package given its URL
relative to the root page of the documentation. *)
+val documentation_asset :
+ kind:[< `Package | `Universe of string ] -> t -> string -> string option Lwt.t
+(** Get the rendered content of an HTML page for a package given its URL
+ relative to the root page of the documentation. *)
+
val file :
kind:[< `Package | `Universe of string ] ->
t ->
diff --git a/src/ocamlorg_package/lib/sidebar.ml b/src/ocamlorg_package/lib/sidebar.ml
new file mode 100644
index 0000000000..dd133c4797
--- /dev/null
+++ b/src/ocamlorg_package/lib/sidebar.ml
@@ -0,0 +1,12 @@
+(** Odoc types for sidebar's global table of content *)
+
+type 'a node = { node : 'a; children : 'a node list }
+
+and sidebar_node = {
+ url : string option;
+ kind : string option;
+ content : string;
+}
+
+and tree = sidebar_node node
+and t = tree list [@@deriving of_yojson]
diff --git a/src/ocamlorg_web/lib/handler.ml b/src/ocamlorg_web/lib/handler.ml
index 2175edba09..5243f3deef 100644
--- a/src/ocamlorg_web/lib/handler.ml
+++ b/src/ocamlorg_web/lib/handler.ml
@@ -891,29 +891,18 @@ module Package_helper = struct
let package_sidebar_data ~kind t package =
let open Lwt.Syntax in
- let* package_documentation_status =
- Ocamlorg_package.documentation_status ~kind t package
- in
+ let* doc_status = Ocamlorg_package.documentation_status ~kind t package in
let readme_filename =
- Option.fold ~none:None
- ~some:(fun (s : Ocamlorg_package.Documentation_status.t) ->
- s.otherdocs.readme)
- package_documentation_status
+ Option.bind doc_status Ocamlorg_package.Documentation_status.readme
in
let changes_filename =
- Option.fold ~none:None
- ~some:(fun (s : Ocamlorg_package.Documentation_status.t) ->
- s.otherdocs.changes)
- package_documentation_status
+ Option.bind doc_status Ocamlorg_package.Documentation_status.changelog
in
let license_filename =
- Option.fold ~none:None
- ~some:(fun (s : Ocamlorg_package.Documentation_status.t) ->
- s.otherdocs.license)
- package_documentation_status
+ Option.bind doc_status Ocamlorg_package.Documentation_status.license
in
let documentation_status =
- match package_documentation_status with
+ match doc_status with
| Some { failed = false; _ } -> Ocamlorg_frontend.Package.Success
| Some { failed = true; _ } -> Failure
| None -> Unknown
@@ -1179,7 +1168,7 @@ let package_overview t kind req =
match sidebar_data.readme_filename with
| Some path ->
let* maybe_readme =
- Ocamlorg_package.file ~kind package (path ^ ".html")
+ Ocamlorg_package.documentation_page ~kind package (path ^ ".html")
in
Lwt.return
(Option.map
@@ -1240,19 +1229,42 @@ let package_documentation t kind req =
in
let path = (Dream.path [@ocaml.warning "-3"]) req |> String.concat "/" in
let hash = match kind with `Package -> None | `Universe u -> Some u in
- let root =
- Url.Package.documentation ?hash ~page:""
- ?version:(Ocamlorg_frontend.Package.url_version frontend_package)
- (Ocamlorg_package.Name.to_string name)
+ let url =
+ Url.Package.documentation ?hash ~page:path ~version:version_from_url
+ @@ Dream.param req "name"
in
+ let* package_documentation_status =
+ Ocamlorg_package.documentation_status ~kind t package
+ in
+ let redirect =
+ match package_documentation_status with
+ | None -> None
+ | Some { redirections; _ } ->
+ List.find_map
+ (function
+ | { Ocamlorg_package.Documentation_status.old_path; new_path } -> (
+ match String.cut ~on:old_path url with
+ | Some (prefix, "") -> Some (prefix ^ new_path)
+ | _ -> None))
+ redirections
+ in
+ let handle_redirect redirect continue =
+ match redirect with Some r -> Dream.redirect req r | None -> continue ()
+ in
+ let handle_asset continue =
+ let* asset = Ocamlorg_package.documentation_asset ~kind package path in
+ match asset with Some asset -> Dream.respond asset | None -> continue ()
+ in
+ handle_redirect redirect @@ fun () ->
let* docs = Ocamlorg_package.documentation_page ~kind package path in
match docs with
| None ->
+ handle_asset @@ fun () ->
let response_404_page =
Dream.html ~code:404
(Ocamlorg_frontend.package_documentation_not_found ~page:path
~search_index_digest:None
- ~path:(Ocamlorg_frontend.Package_breadcrumbs.Documentation Index)
+ ~path:(Ocamlorg_frontend.Package_breadcrumbs.Documentation [])
frontend_package)
in
if version_from_url = "latest" then
@@ -1269,95 +1281,82 @@ let package_documentation t kind req =
(Ocamlorg_package.Name.to_string name))
else response_404_page
| Some doc ->
- let module Package_info = Ocamlorg_package.Package_info in
- let rec toc_of_module ~root
- (module' : Ocamlorg_package.Package_info.Module.t) :
- Ocamlorg_frontend.Navmap.toc =
- let title = Package_info.Module.name module' in
- let kind = Package_info.Module.kind module' in
- let href = Some (root ^ Package_info.Module.path module') in
- let children =
- module' |> Package_info.Module.submodules |> String.Map.bindings
- |> List.map (fun (_, module') -> toc_of_module ~root module')
- in
- let kind =
- match (kind : Package_info.Kind.t) with
- | Page -> Ocamlorg_frontend.Navmap.Page
- | Module -> Module
- | LeafPage -> Leaf_page
- | ModuleType -> Module_type
- | Parameter _ -> Parameter
- | Class -> Class
- | ClassType -> Class_type
- | File -> File
- in
- Ocamlorg_frontend.Navmap.{ title; href; kind; children }
- in
- let toc_of_map ~root (map : Ocamlorg_package.Package_info.t) :
- Ocamlorg_frontend.Navmap.t =
- let libraries = map.libraries in
- String.Map.bindings libraries
- |> List.map (fun (_, (library : Package_info.library)) ->
- let title = library.name in
- let href = None in
- let children =
- String.Map.bindings library.modules
- |> List.map (fun (_, module') -> toc_of_module ~root module')
+ let map_url = Option.map (fun url -> "/" ^ url) in
+ let rec navmap_of_sidebar ?(first_layer = false)
+ (sidebar : Ocamlorg_package.Sidebar.tree) =
+ Ocamlorg_frontend.Navmap.
+ {
+ title = sidebar.node.content;
+ kind =
+ (match sidebar.node.kind with
+ | Some "module" -> Module
+ | (Some ("page" | "leaf-page") | None)
+ when String.starts_with ~prefix:"Library " sidebar.node.content
+ ->
+ Library
+ | Some ("page" | "leaf-page") -> Page
+ | Some "module-type" -> Module_type
+ | Some "parameter" -> Parameter
+ | Some "class" -> Class
+ | Some "class-type" -> Class_type
+ | Some "file" -> File
+ | Some "source" -> Source
+ | None -> Page
+ | _ -> File);
+ href = map_url sidebar.node.url;
+ children =
+ (let children =
+ List.map
+ (navmap_of_sidebar ~first_layer:false)
+ sidebar.children
in
- Ocamlorg_frontend.Navmap.
- { title; href; kind = Library; children })
+ (* The docs CI generates readme files in the wring place, and
+ they end up in the toc, so we filter them out here *)
+ if first_layer then
+ List.filter
+ (function
+ | Ocamlorg_frontend.Navmap.{ title; _ }
+ when Ocamlorg_package.Documentation_status.is_special
+ title ->
+ false
+ | _ -> true)
+ children
+ else children);
+ }
in
- let* module_map = Ocamlorg_package.module_map ~kind package in
+ let* sidebar = Ocamlorg_package.sidebar ~kind package in
let* search_index_digest =
Package_helper.search_index_digest ~kind t package
in
- let toc = Package_helper.frontend_toc doc.toc in
- let (maptoc : Ocamlorg_frontend.Navmap.toc list) =
- toc_of_map ~root module_map
+ let local_toc = Package_helper.frontend_toc doc.toc in
+ let (global_toc : Ocamlorg_frontend.Navmap.toc list) =
+ List.map (navmap_of_sidebar ~first_layer:true) sidebar
in
let (breadcrumb_path : Ocamlorg_frontend.Package_breadcrumbs.path) =
let breadcrumbs = doc.breadcrumbs in
- if breadcrumbs != [] then
- let first_path_item = List.hd breadcrumbs in
- let doc_breadcrumb_to_library_path_item
- (p : Ocamlorg_package.Documentation.breadcrumb) =
- match p.kind with
- | Module ->
- Ocamlorg_frontend.Package_breadcrumbs.Module
- { name = p.name; href = p.href }
- | ModuleType -> ModuleType { name = p.name; href = p.href }
- | Parameter i ->
- Parameter { name = p.name; href = p.href; number = i }
- | Class -> Class { name = p.name; href = p.href }
- | ClassType -> ClassType { name = p.name; href = p.href }
- | Page | LeafPage | File ->
- failwith "library paths do not contain Page, LeafPage or File"
+ let doc_breadcrumb_to_library_path_item
+ (p : Ocamlorg_package.Documentation.breadcrumb) =
+ let b =
+ {
+ Ocamlorg_frontend.Package_breadcrumbs.name = p.name;
+ href = p.href;
+ }
in
+ match p.kind with
+ | Module -> Ocamlorg_frontend.Package_breadcrumbs.Module b
+ | ModuleType -> ModuleType b
+ | Parameter i -> Parameter (b, i)
+ | Class -> Class b
+ | ClassType -> ClassType b
+ | Page | LeafPage | File | Source -> Page b
+ in
- match first_path_item.kind with
- | Page | LeafPage | File ->
- Ocamlorg_frontend.Package_breadcrumbs.Documentation
- (Page first_path_item.name)
- | Module | ModuleType | Parameter _ | Class | ClassType ->
- let library =
- List.find_opt
- (fun (toc : Ocamlorg_frontend.Navmap.toc) ->
- List.exists
- (fun (t : Ocamlorg_frontend.Navmap.toc) ->
- t.title = first_path_item.name)
- toc.children)
- maptoc
- in
-
- Ocamlorg_frontend.Package_breadcrumbs.Documentation
- (Library
- ( (match library with Some l -> l.title | None -> "unknown"),
- List.map doc_breadcrumb_to_library_path_item breadcrumbs ))
- else Ocamlorg_frontend.Package_breadcrumbs.Documentation Index
+ Ocamlorg_frontend.Package_breadcrumbs.Documentation
+ (List.map doc_breadcrumb_to_library_path_item breadcrumbs)
in
Dream.html
(Ocamlorg_frontend.package_documentation ~page:(Some path)
- ~search_index_digest ~path:breadcrumb_path ~toc ~maptoc
+ ~search_index_digest ~path:breadcrumb_path ~local_toc ~global_toc
~content:doc.content frontend_package)
let package_file t kind req =
@@ -1374,7 +1373,9 @@ let package_file t kind req =
| Package -> `Package
| Universe -> `Universe (Dream.param req "hash")
in
- let path = (Dream.path [@ocaml.warning "-3"]) req |> String.concat "/" in
+ let path =
+ "doc" :: (Dream.path [@ocaml.warning "-3"]) req |> String.concat "/"
+ in
let* sidebar_data = Package_helper.package_sidebar_data ~kind t package in
let* search_index_digest =
Package_helper.search_index_digest ~kind t package