Dedicated sidebar file

CHANGES.md

@@ -17,8 +17,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 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 ->
@@ -305,17 +312,16 @@ let html_generate ~occurrence_file 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 ~output_dir ~input_file ();
-        Odoc.html_generate ?search_uris ?index ~output_dir ~input_file
+        Odoc.html_generate ?search_uris ?sidebar ~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 = []) ?(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 ->
   ?as_json:bool ->

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 (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,4 @@ module Html_page = Html_page
 
 module Generator = Generator
 module Link = Link
-module Json = Utils.Json
+module Json = Odoc_utils.Json

src/html/utils.ml

@@ -1,87 +1,3 @@
 (* Shared utility functions *)
 
 let optional_elt f ?a = function [] -> [] | l -> [ f ?a l ]
-
-module Json = struct
-  type json =
-    [ `Null
-    | `Bool of bool
-    | `Float of float
-    | `String of string
-    | `Array of json list
-    | `Object of (string * json) list ]
-
-  let rec buffer_add_json b = function
-    | `Null -> Buffer.add_string b "null"
-    | `Bool bool -> Buffer.add_string b (if bool then "true" else "false")
-    | `Float f -> Buffer.add_string b (Printf.sprintf "%.16g" f)
-    | `String s -> buffer_add_json_string b s
-    | `Array els -> (
-        match els with
-        | [] -> Buffer.add_string b "[]"
-        | el :: els ->
-            let add_sep_el b e =
-              Buffer.add_char b ',';
-              buffer_add_json b e
-            in
-            Buffer.add_char b '[';
-            buffer_add_json b el;
-            List.iter (add_sep_el b) els;
-            Buffer.add_char b ']')
-    | `Object mems -> (
-        match mems with
-        | [] -> Buffer.add_string b "{}"
-        | mem :: mems ->
-            let add_mem b (k, v) =
-              buffer_add_json_string b k;
-              Buffer.add_char b ':';
-              buffer_add_json b v
-            in
-            let add_sep_mem b mem =
-              Buffer.add_char b ',';
-              add_mem b mem
-            in
-            Buffer.add_char b '{';
-            add_mem b mem;
-            List.iter (add_sep_mem b) mems;
-            Buffer.add_char b '}')
-
-  and buffer_add_json_string b s =
-    let is_control = function
-      | '\x00' .. '\x1F' | '\x7F' -> true
-      | _ -> false
-    in
-    let len = String.length s in
-    let max_idx = len - 1 in
-    let flush b start i =
-      if start < len then Buffer.add_substring b s start (i - start)
-    in
-    let rec loop start i =
-      match i > max_idx with
-      | true -> flush b start i
-      | false -> (
-          let next = i + 1 in
-          match String.get s i with
-          | '"' ->
-              flush b start i;
-              Buffer.add_string b "\\\"";
-              loop next next
-          | '\\' ->
-              flush b start i;
-              Buffer.add_string b "\\\\";
-              loop next next
-          | c when is_control c ->
-              flush b start i;
-              Buffer.add_string b (Printf.sprintf "\\u%04X" (Char.code c));
-              loop next next
-          | _c -> loop start next)
-    in
-    Buffer.add_char b '"';
-    loop 0 0;
-    Buffer.add_char b '"'
-
-  let to_string json =
-    let b = Buffer.create 1024 in
-    buffer_add_json b json;
-    Buffer.contents b
-end