Merge pull request #1250 from panglesd/root-in-sidebar

Dedicated sidebar file

CHANGES.md

@@ -16,8 +16,10 @@
   Absolute (`{!/foo}`), relative (`{!./foo}`) and package-local (`{!//foo}`)
   are added.
 - Add a marshalled search index consumable by sherlodoc (@EmileTrotignon, @panglesd, #1084)
-- Add a `--index` argument to pass indexes to the document generation, currently
-  used for sidebar (@panglesd, #1145)
+- Add a `odoc sidebar-generate` command to generate a sidebar file (@panglesd,
+  #1250)
+- Add a `--sidebar` argument to pass sidebars to the document generation
+  (@panglesd, #1145, #1250)
 - Allow referencing of polymorphic constructors in polymorphic variant type
   aliases (@panglesd, #1115)
 - Added a `--occurrences` argument to the `compile-index` command to output the

src/document/sidebar.ml

@@ -2,16 +2,18 @@ open Odoc_utils
 open Types
 module Id = Odoc_model.Paths.Identifier
 
+type entry = Url.t option * Inline.one
+
 module Toc : sig
-  type t
+  type t = entry Tree.t
 
   val of_page_hierarchy : Odoc_index.Page_hierarchy.t -> t
 
   val of_skeleton : Odoc_index.Skeleton.t -> t
 
   val to_block : prune:bool -> Url.Path.t -> t -> Block.t
 end = struct
-  type t = (Url.t option * Inline.one) Tree.t
+  type t = entry Tree.t
 
   let of_page_hierarchy (dir : Odoc_index.Page_hierarchy.t) : t =
     let f index =

src/document/sidebar.mli

@@ -1,4 +1,12 @@
-type t
+open Odoc_utils
+open Types
+
+type entry = Url.t option * Inline.one
+
+type pages = { name : string; pages : entry Tree.t }
+type library = { name : string; units : entry Tree.t list }
+
+type t = { pages : pages list; libraries : library list }
 
 val of_lang : Odoc_index.t -> t
 

src/driver/compile.ml

@@ -269,15 +269,22 @@ let html_generate ~occurrence_file ~remaps output_dir linked =
   let compile_index : Odoc_unit.index -> _ =
    fun index ->
     let compile_index_one
-        ({ pkg_args; output_file; json; search_dir = _ } as index :
+        ({ pkg_args; output_file; json; search_dir = _; sidebar } as index :
           Odoc_unit.index) =
       let libs_linked = Odoc_unit.Pkg_args.linked_libs pkg_args in
       let pages_linked = Odoc_unit.Pkg_args.linked_pages pkg_args in
       let () =
         Odoc.compile_index ~json ~occurrence_file ~output_file ~libs:libs_linked
           ~docs:pages_linked ()
       in
-      sherlodoc_index_one ~output_dir index
+      let sidebar =
+        match sidebar with
+        | None -> None
+        | Some { output_file; json } ->
+            Odoc.sidebar_generate ~output_file ~json index.output_file ();
+            Some output_file
+      in
+      (sherlodoc_index_one ~output_dir index, sidebar)
     in
     match Hashtbl.find_opt tbl index.output_file with
     | None ->
@@ -306,18 +313,17 @@ let html_generate ~occurrence_file ~remaps output_dir linked =
            Odoc.html_generate_asset ~output_dir ~input_file:l.odoc_file
              ~asset_path:l.input_file ()
        | _ ->
-           let search_uris, index =
+           let search_uris, sidebar =
              match l.index with
              | None -> (None, None)
              | Some index ->
-                 let db_path = compile_index index in
+                 let db_path, sidebar = compile_index index in
                  let search_uris = [ db_path; Sherlodoc.js_file ] in
-                 let index = index.output_file in
-                 (Some search_uris, Some index)
+                 (Some search_uris, sidebar)
            in
-           Odoc.html_generate ?search_uris ?index ?remap:remap_file ~output_dir
-             ~input_file ();
-           Odoc.html_generate ?search_uris ?index ~output_dir ~input_file
+           Odoc.html_generate ?search_uris ?sidebar ?remap:remap_file
+             ~output_dir ~input_file ();
+           Odoc.html_generate ?search_uris ?sidebar ~output_dir ~input_file
              ~as_json:true ());
     Atomic.incr Stats.stats.generated_units
   in

src/driver/odoc.ml

@@ -18,6 +18,8 @@ end
 
 let index_filename = "index.odoc-index"
 
+let sidebar_filename = "sidebar.odoc-sidebar"
+
 type compile_deps = { digest : Digest.t; deps : (string * Digest.t) list }
 
 let odoc = ref (Cmd.v "odoc")
@@ -179,11 +181,26 @@ let compile_index ?(ignore_output = false) ~output_file ?occurrence_file ~json
   in
   ignore @@ Cmd_outputs.submit log desc cmd (Some output_file)
 
-let html_generate ~output_dir ?index ?(ignore_output = false)
+let sidebar_generate ?(ignore_output = false) ~output_file ~json input_file () =
+  let json = if json then Cmd.v "--json" else Cmd.empty in
+  let cmd =
+    Cmd.(
+      !odoc % "sidebar-generate" %% json %% v "-o" % p output_file
+      % p input_file)
+  in
+  let desc =
+    Printf.sprintf "Generating sidebar for %s" (Fpath.to_string output_file)
+  in
+  let log =
+    if ignore_output then None else Some (`Generate, Fpath.to_string output_file)
+  in
+  ignore @@ Cmd_outputs.submit log desc cmd (Some output_file)
+
+let html_generate ~output_dir ?sidebar ?(ignore_output = false)
     ?(search_uris = []) ?remap ?(as_json = false) ~input_file:file () =
   let open Cmd in
   let index =
-    match index with None -> empty | Some idx -> v "--index" % p idx
+    match sidebar with None -> empty | Some idx -> v "--sidebar" % p idx
   in
   let search_uris =
     List.fold_left

src/driver/odoc.mli

@@ -6,6 +6,7 @@ module Id : sig
 end
 
 val index_filename : string
+val sidebar_filename : string
 
 val odoc : Bos.Cmd.t ref
 
@@ -50,9 +51,17 @@ val compile_index :
   unit ->
   unit
 
+val sidebar_generate :
+  ?ignore_output:bool ->
+  output_file:Fpath.t ->
+  json:bool ->
+  Fpath.t ->
+  unit ->
+  unit
+
 val html_generate :
   output_dir:string ->
-  ?index:Fpath.t ->
+  ?sidebar:Fpath.t ->
   ?ignore_output:bool ->
   ?search_uris:Fpath.t list ->
   ?remap:Fpath.t ->

src/driver/odoc_unit.ml

@@ -36,11 +36,14 @@ module Pkg_args = struct
       x.odoc_dir Fpath.pp x.odocl_dir sfp_pp x.pages sfp_pp x.libs
 end
 
+type sidebar = { output_file : Fpath.t; json : bool }
+
 type index = {
   pkg_args : Pkg_args.t;
   output_file : Fpath.t;
   json : bool;
   search_dir : Fpath.t;
+  sidebar : sidebar option;
 }
 
 let pp_index fmt x =

src/driver/odoc_unit.mli

@@ -16,11 +16,13 @@ module Pkg_args : sig
   val pp : t Fmt.t
 end
 
+type sidebar = { output_file : Fpath.t; json : bool }
 type index = {
   pkg_args : Pkg_args.t;
   output_file : Fpath.t;
   json : bool;
   search_dir : Fpath.t;
+  sidebar : sidebar option;
 }
 
 type 'a unit = {

src/driver/odoc_units_of.ml

@@ -84,7 +84,17 @@ let packages ~dirs ~extra_paths ~remap (pkgs : Packages.t list) : t list =
     in
     let pkg_args = base_args pkg pkg_libs in
     let output_file = Fpath.(index_dir / pkg.name / Odoc.index_filename) in
-    { pkg_args; output_file; json = false; search_dir = pkg.pkg_dir }
+    let sidebar =
+      let output_file = Fpath.(index_dir / pkg.name / Odoc.sidebar_filename) in
+      { output_file; json = false }
+    in
+    {
+      pkg_args;
+      output_file;
+      json = false;
+      search_dir = pkg.pkg_dir;
+      sidebar = Some sidebar;
+    }
   in
 
   let make_unit ~name ~kind ~rel_dir ~input_file ~pkg ~lib_deps ~enable_warnings

src/html/generator.ml

@@ -590,3 +590,7 @@ let filepath ~config url = Link.Path.as_filename ~config url
 let doc ~config ~xref_base_uri b =
   let resolve = Link.Base xref_base_uri in
   block ~config ~resolve b
+
+let inline ~config ~xref_base_uri b =
+  let resolve = Link.Base xref_base_uri in
+  inline ~config ~resolve b

src/html/generator.mli

@@ -11,3 +11,9 @@ val doc :
   xref_base_uri:string ->
   Odoc_document.Types.Block.t ->
   Html_types.flow5_without_sectioning_heading_header_footer Tyxml.Html.elt list
+
+val inline :
+  config:Config.t ->
+  xref_base_uri:string ->
+  Odoc_document.Types.Inline.t ->
+  Html_types.phrasing Tyxml.Html.elt list

src/html/html_fragment_json.ml

@@ -1,12 +1,12 @@
 (* Rendering of HTML fragments together with metadata. For embedding the
    generated documentation in existing websites.
 *)
+open Odoc_utils
 
 module Html = Tyxml.Html
 module Url = Odoc_document.Url
 
-let json_of_breadcrumbs (breadcrumbs : Types.breadcrumb list) : Utils.Json.json
-    =
+let json_of_breadcrumbs (breadcrumbs : Types.breadcrumb list) : Json.json =
   let breadcrumb (b : Types.breadcrumb) =
     `Object
       [
@@ -18,7 +18,7 @@ let json_of_breadcrumbs (breadcrumbs : Types.breadcrumb list) : Utils.Json.json
   let json_breadcrumbs = breadcrumbs |> List.map breadcrumb in
   `Array json_breadcrumbs
 
-let json_of_toc (toc : Types.toc list) : Utils.Json.json =
+let json_of_toc (toc : Types.toc list) : Json.json =
   let rec section (s : Types.toc) =
     `Object
       [
@@ -34,7 +34,7 @@ let make ~config ~preamble ~url ~breadcrumbs ~sidebar ~toc ~uses_katex
     ~source_anchor content children =
   let filename = Link.Path.as_filename ~config url in
   let filename = Fpath.add_ext ".json" filename in
-  let json_to_string json = Utils.Json.to_string json in
+  let json_to_string json = Json.to_string json in
   let source_anchor =
     match source_anchor with Some url -> `String url | None -> `Null
   in
@@ -68,7 +68,7 @@ let make_src ~config ~url ~breadcrumbs content =
   let filename = Link.Path.as_filename ~config url in
   let filename = Fpath.add_ext ".json" filename in
   let htmlpp = Html.pp_elt ~indent:(Config.indent config) () in
-  let json_to_string json = Utils.Json.to_string json in
+  let json_to_string json = Json.to_string json in
   let content ppf =
     Format.pp_print_string ppf
       (json_to_string

src/html/odoc_html.ml

@@ -9,4 +9,5 @@ module Html_page = Html_page
 
 module Generator = Generator
 module Link = Link
-module Json = Utils.Json
+module Json = Odoc_utils.Json
+module Sidebar = Sidebar

src/html/sidebar.ml

@@ -0,0 +1,42 @@
+open Odoc_utils
+
+let toc_to_json ((url, inline) : Odoc_document.Sidebar.entry) : Json.json =
+  let config =
+    Config.v ~semantic_uris:true ~indent:true ~flat:false ~open_details:false
+      ~as_json:true ~remap:[] ()
+  in
+  let url, kind =
+    match url with
+    | None -> (`Null, `Null)
+    | Some url ->
+        let href = Link.href ~config ~resolve:(Link.Base "") url in
+        let kind =
+          Format.asprintf "%a" Odoc_document.Url.Anchor.pp_kind url.kind
+        in
+
+        (`String href, `String kind)
+  in
+  let inline =
+    let inline = Generator.inline ~config ~xref_base_uri:"" [ inline ] in
+    let inline =
+      String.concat ""
+      @@ List.map (Format.asprintf "%a" (Tyxml.Html.pp_elt ())) inline
+    in
+    `String inline
+  in
+  `Object [ ("url", url); ("kind", kind); ("content", inline) ]
+
+let pages_to_json ({ name; pages } : Odoc_document.Sidebar.pages) =
+  `Object [ ("name", `String name); ("pages", Tree.to_json toc_to_json pages) ]
+
+let libs_to_json ({ name; units } : Odoc_document.Sidebar.library) =
+  `Object
+    [
+      ("name", `String name);
+      ("modules", `Array (List.map (Tree.to_json toc_to_json) units));
+    ]
+
+let to_json ({ pages; libraries } : Odoc_document.Sidebar.t) =
+  let pages = List.map pages_to_json pages in
+  let libraries = List.map libs_to_json libraries in
+  `Object [ ("pages", `Array pages); ("libraries", `Array libraries) ]

src/html/sidebar.mli

@@ -0,0 +1 @@
+val to_json : Odoc_document.Sidebar.t -> Odoc_utils.Json.json