Preliminary work to allow table-of-contents to be output as json

Author: jonludlam

src/html/generator.ml

@@ -338,32 +338,34 @@ and items ~resolve l : item Html.elt list =
 module Toc = struct
   open Odoc_document.Doctree
 
-  let render_toc ~resolve (toc : Toc.t) =
+  type t = Tree.toc = {
+    title : Html_types.flow5_without_interactive Html.elt list;
+    title_str : string;
+    href : string;
+    children : t list;
+  }
+
+  let on_sub : Subpage.status -> bool = function
+    | `Closed | `Open | `Default -> false
+    | `Inline -> true
+
+  let gen_toc ~resolve ~path i =
+    let toc = Toc.compute path ~on_sub i in
     let rec section { Toc.url; text; children } =
       let text = inline_nolink text in
-      let text =
+      let title =
         (text
           : non_link_phrasing Html.elt list
           :> Html_types.flow5_without_interactive Html.elt list)
       in
+      let title_str =
+        List.map (Format.asprintf "%a" (Tyxml.Html.pp_elt ())) text
+        |> String.concat " "
+      in
       let href = Link.href ~resolve url in
-      let link = Html.a ~a:[ Html.a_href href ] text in
-      match children with [] -> [ link ] | _ -> [ link; sections children ]
-    and sections the_sections =
-      the_sections
-      |> List.map (fun the_section -> Html.li (section the_section))
-      |> Html.ul
+      { title; title_str; href; children = List.map section children }
     in
-    match toc with
-    | [] -> []
-    | _ -> [ Html.nav ~a:[ Html.a_class [ "odoc-toc" ] ] [ sections toc ] ]
-
-  let on_sub : Subpage.status -> bool = function
-    | `Closed | `Open | `Default -> false
-    | `Inline -> true
-
-  let from_items ~resolve ~path i =
-    render_toc ~resolve @@ Toc.compute path ~on_sub i
+    List.map section toc
 end
 
 module Page = struct
@@ -390,7 +392,7 @@ module Page = struct
     in
     let resolve = Link.Current url in
     let i = Doctree.Shift.compute ~on_sub i in
-    let toc = Toc.from_items ~resolve ~path:url i in
+    let toc = Toc.gen_toc ~resolve ~path:url i in
     let header = items ~resolve header in
     let content = (items ~resolve i :> any Html.elt list) in
     Tree.make ?theme_uri ?support_uri ~indent ~header ~toc ~url title content

src/html/tree.ml

@@ -18,6 +18,26 @@ module Html = Tyxml.Html
 
 type uri = Absolute of string | Relative of Odoc_document.Url.Path.t option
 
+type toc = {
+  title : Html_types.flow5_without_interactive Html.elt list;
+  title_str : string;
+  href : string;
+  children : toc list;
+}
+
+let html_of_toc toc =
+  let rec section section =
+    let link = Html.a ~a:[ Html.a_href section.href ] section.title in
+    match section.children with [] -> [ link ] | cs -> [ link; sections cs ]
+  and sections the_sections =
+    the_sections
+    |> List.map (fun the_section -> Html.li (section the_section))
+    |> Html.ul
+  in
+  match toc with
+  | [] -> []
+  | _ -> [ Html.nav ~a:[ Html.a_class [ "odoc-toc" ] ] [ sections toc ] ]
+
 let page_creator ?(theme_uri = Relative None) ?(support_uri = Relative None)
     ~url name header toc content =
   let path = Link.Path.for_printing url in
@@ -119,7 +139,7 @@ let page_creator ?(theme_uri = Relative None) ?(support_uri = Relative None)
   let body =
     breadcrumbs
     @ [ Html.header ~a:[ Html.a_class [ "odoc-preamble" ] ] header ]
-    @ toc
+    @ html_of_toc toc
     @ [ Html.div ~a:[ Html.a_class [ "odoc-content" ] ] content ]
   in
   Html.html head (Html.body ~a:[ Html.a_class [ "odoc" ] ] body)

src/html/tree.mli

@@ -19,6 +19,13 @@ module Html = Tyxml.Html
 
 (** Supported languages for printing code parts. *)
 
+type toc = {
+  title : Html_types.flow5_without_interactive Html.elt list;
+  title_str : string;
+  href : string;
+  children : toc list;
+}
+
 type uri =
   | Absolute of string
   | Relative of Odoc_document.Url.Path.t option
@@ -33,7 +40,7 @@ val make :
   indent:bool ->
   url:Url.Path.t ->
   header:Html_types.flow5_without_header_footer Html.elt list ->
-  toc:Html_types.flow5 Html.elt list ->
+  toc:toc list ->
   string ->
   Html_types.div_content Html.elt list ->
   Renderer.page list ->