diff --git a/CHANGES.md b/CHANGES.md
index cad669168d..9024de5471 100644
--- a/CHANGES.md
+++ b/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
diff --git a/src/document/sidebar.ml b/src/document/sidebar.ml
index f1d69e1429..38895dceff 100644
--- a/src/document/sidebar.ml
+++ b/src/document/sidebar.ml
@@ -2,8 +2,10 @@ 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
@@ -11,7 +13,7 @@ module Toc : sig
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 =
diff --git a/src/document/sidebar.mli b/src/document/sidebar.mli
index eecb0c8c15..c42e32ec5b 100644
--- a/src/document/sidebar.mli
+++ b/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
diff --git a/src/driver/compile.ml b/src/driver/compile.ml
index df065acd17..c26f20e285 100644
--- a/src/driver/compile.ml
+++ b/src/driver/compile.ml
@@ -269,7 +269,7 @@ 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
@@ -277,7 +277,14 @@ let html_generate ~occurrence_file ~remaps output_dir linked =
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
diff --git a/src/driver/odoc.ml b/src/driver/odoc.ml
index e34394c3f5..61980645bc 100644
--- a/src/driver/odoc.ml
+++ b/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
diff --git a/src/driver/odoc.mli b/src/driver/odoc.mli
index bcfb718c6c..4b62f65106 100644
--- a/src/driver/odoc.mli
+++ b/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 ->
diff --git a/src/driver/odoc_unit.ml b/src/driver/odoc_unit.ml
index 9c40809c78..ad5d0735f0 100644
--- a/src/driver/odoc_unit.ml
+++ b/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 =
diff --git a/src/driver/odoc_unit.mli b/src/driver/odoc_unit.mli
index 950cb7bf2d..1717166af4 100644
--- a/src/driver/odoc_unit.mli
+++ b/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 = {
diff --git a/src/driver/odoc_units_of.ml b/src/driver/odoc_units_of.ml
index bc7ba9d8ad..e572b1846c 100644
--- a/src/driver/odoc_units_of.ml
+++ b/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
diff --git a/src/html/generator.ml b/src/html/generator.ml
index ab1c5da09e..2eaf198a65 100644
--- a/src/html/generator.ml
+++ b/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
diff --git a/src/html/generator.mli b/src/html/generator.mli
index fa95d3249b..1474390ce8 100644
--- a/src/html/generator.mli
+++ 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
diff --git a/src/html/html_fragment_json.ml b/src/html/html_fragment_json.ml
index 54dac13473..3fe6a9bdbb 100644
--- a/src/html/html_fragment_json.ml
+++ b/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
diff --git a/src/html/odoc_html.ml b/src/html/odoc_html.ml
index e7150f71e5..de2bdb54ca 100644
--- a/src/html/odoc_html.ml
+++ b/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
diff --git a/src/html/sidebar.ml b/src/html/sidebar.ml
new file mode 100644
index 0000000000..8ae7f99af2
--- /dev/null
+++ b/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) ]
diff --git a/src/html/sidebar.mli b/src/html/sidebar.mli
new file mode 100644
index 0000000000..77458ad0f3
--- /dev/null
+++ b/src/html/sidebar.mli
@@ -0,0 +1 @@
+val to_json : Odoc_document.Sidebar.t -> Odoc_utils.Json.json
diff --git a/src/html/utils.ml b/src/html/utils.ml
index 99281c0cb6..c575214450 100644
--- a/src/html/utils.ml
+++ b/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
diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml
index 21c3ef234a..27e1b54ec4 100644
--- a/src/odoc/bin/main.ml
+++ b/src/odoc/bin/main.ml
@@ -476,6 +476,7 @@ module Indexing = struct
Antichain.check (lib_roots |> List.map ~f:snd) ~opt:"-L" >>= fun () ->
Indexing.compile marshall ~output ~warnings_options ~occurrences ~lib_roots
~page_roots ~inputs_in_file ~odocls:inputs
+
let cmd =
let dst =
let doc =
@@ -544,6 +545,59 @@ module Indexing = struct
Term.info "compile-index" ~docs ~doc
end
+module Sidebar = struct
+ open Or_error
+
+ let output_file ~dst marshall =
+ match (dst, marshall) with
+ | Some file, `JSON when not (Fpath.has_ext "json" (Fpath.v file)) ->
+ Error
+ (`Msg
+ "When generating a sidebar with --json, the output must have a \
+ .json file extension")
+ | Some file, `Marshall
+ when not (Fpath.has_ext "odoc-sidebar" (Fpath.v file)) ->
+ Error
+ (`Msg
+ "When generating sidebar, the output must have a .odoc-sidebar \
+ file extension")
+ | Some file, _ -> Ok (Fs.File.of_string file)
+ | None, `JSON -> Ok (Fs.File.of_string "sidebar.json")
+ | None, `Marshall -> Ok (Fs.File.of_string "sidebar.odoc-sidebar")
+
+ let generate dst json warnings_options input =
+ let marshall = if json then `JSON else `Marshall in
+ output_file ~dst marshall >>= fun output ->
+ Sidebar.generate ~marshall ~output ~warnings_options ~index:input
+
+ let cmd =
+ let dst =
+ let doc =
+ "Output file path. Non-existing intermediate directories are created. \
+ Defaults to sidebar.odoc-sidebar, or sidebar.json if --json is \
+ passed."
+ in
+ Arg.(
+ value & opt (some string) None & info ~docs ~docv:"PATH" ~doc [ "o" ])
+ in
+ let json =
+ let doc = "whether to output a json file, or a binary .odoc-index file" in
+ Arg.(value & flag & info ~doc [ "json" ])
+ in
+ let inputs =
+ let doc = ".odoc-index file to generate a value from" in
+ Arg.(
+ required & pos 0 (some convert_fpath) None & info ~doc ~docv:"FILE" [])
+ in
+ Term.(
+ const handle_error
+ $ (const generate $ dst $ json $ warnings_options $ inputs))
+
+ let info ~docs =
+ let doc = "Generate a sidebar from an index file." in
+ Term.info "sidebar-generate" ~docs ~doc
+end
+
module Support_files_command = struct
let support_files without_theme output_dir =
Support_files.write ~without_theme output_dir
@@ -809,7 +863,7 @@ end = struct
Arg.(
value
& opt (some convert_fpath) None
- & info [ "index" ] ~doc ~docv:"FILE.odoc-index")
+ & info [ "sidebar" ] ~doc ~docv:"FILE.odoc-index")
let cmd =
let syntax =
@@ -1575,6 +1629,7 @@ let () =
Support_files_command.(cmd, info ~docs:section_pipeline);
Compile_impl.(cmd, info ~docs:section_pipeline);
Indexing.(cmd, info ~docs:section_pipeline);
+ Sidebar.(cmd, info ~docs:section_pipeline);
Odoc_manpage.generate ~docs:section_generators;
Odoc_latex.generate ~docs:section_generators;
Odoc_html_url.(cmd, info ~docs:section_support);
diff --git a/src/odoc/odoc_file.ml b/src/odoc/odoc_file.ml
index 8a531eaa3c..732994f9a6 100644
--- a/src/odoc/odoc_file.ml
+++ b/src/odoc/odoc_file.ml
@@ -116,3 +116,7 @@ let load_root file =
let save_index dst idx = save_ dst (fun oc -> Marshal.to_channel oc idx [])
let load_index file = load_ file (fun ic -> Ok (Marshal.from_channel ic))
+
+let save_sidebar dst idx = save_ dst (fun oc -> Marshal.to_channel oc idx [])
+
+let load_sidebar file = load_ file (fun ic -> Ok (Marshal.from_channel ic))
diff --git a/src/odoc/odoc_file.mli b/src/odoc/odoc_file.mli
index 0f6c076efe..79e6c14dbf 100644
--- a/src/odoc/odoc_file.mli
+++ b/src/odoc/odoc_file.mli
@@ -56,4 +56,9 @@ val save_index : Fs.File.t -> Odoc_index.t -> unit
val load_index : Fs.File.t -> (Odoc_index.t, [> msg ]) result
(** Load a [.odoc-index] file. *)
+val save_sidebar : Fs.File.t -> Odoc_document.Sidebar.t -> unit
+
+val load_sidebar : Fs.File.t -> (Odoc_document.Sidebar.t, [> msg ]) result
+(** Load a [.odoc-index] file. *)
+
val save_asset : Fpath.t -> warnings:Error.t list -> Lang.Asset.t -> unit
diff --git a/src/odoc/rendering.ml b/src/odoc/rendering.ml
index 173562805f..a1652f8d76 100644
--- a/src/odoc/rendering.ml
+++ b/src/odoc/rendering.ml
@@ -68,9 +68,7 @@ let generate_odoc ~syntax ~warnings_options:_ ~renderer ~output ~extra_suffix
~sidebar extra file =
(match sidebar with
| None -> Ok None
- | Some x ->
- Odoc_file.load_index x >>= fun index ->
- Ok (Some (Odoc_document.Sidebar.of_lang index)))
+ | Some x -> Odoc_file.load_sidebar x >>= fun sidebar -> Ok (Some sidebar))
>>= fun sidebar ->
document_of_odocl ~syntax file >>= fun doc ->
render_document renderer ~output ~sidebar ~extra_suffix ~extra doc;
diff --git a/src/odoc/sidebar.ml b/src/odoc/sidebar.ml
new file mode 100644
index 0000000000..73d73144d8
--- /dev/null
+++ b/src/odoc/sidebar.ml
@@ -0,0 +1,19 @@
+open Or_error
+open Odoc_utils
+
+let compile_to_json ~output sidebar =
+ let json = Odoc_html.Sidebar.to_json sidebar in
+ let text = Json.to_string json in
+ let output_channel =
+ Fs.Directory.mkdir_p (Fs.File.dirname output);
+ open_out_bin (Fs.File.to_string output)
+ in
+ Fun.protect ~finally:(fun () -> close_out output_channel) @@ fun () ->
+ Printf.fprintf output_channel "%s" text
+
+let generate ~marshall ~output ~warnings_options:_ ~index =
+ Odoc_file.load_index index >>= fun index ->
+ let sidebar = Odoc_document.Sidebar.of_lang index in
+ match marshall with
+ | `JSON -> Ok (compile_to_json ~output sidebar)
+ | `Marshall -> Ok (Odoc_file.save_sidebar output sidebar)
diff --git a/src/utils/json.ml b/src/utils/json.ml
new file mode 100644
index 0000000000..33b7d37093
--- /dev/null
+++ b/src/utils/json.ml
@@ -0,0 +1,78 @@
+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
diff --git a/src/utils/odoc_utils.ml b/src/utils/odoc_utils.ml
index 41294e1785..dab50a7f3e 100644
--- a/src/utils/odoc_utils.ml
+++ b/src/utils/odoc_utils.ml
@@ -77,3 +77,4 @@ end
module Tree = Tree
module Forest = Tree.Forest
+module Json = Json
diff --git a/src/utils/tree.ml b/src/utils/tree.ml
index 2bbc78a141..da9bb9c3bf 100644
--- a/src/utils/tree.ml
+++ b/src/utils/tree.ml
@@ -9,10 +9,16 @@ module type S = sig
val fold_left : f:('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc
val iter : f:('a -> unit) -> 'a t -> unit
val map : f:('a -> 'b) -> 'a t -> 'b t
+ val to_json : ('a -> Json.json) -> 'a t -> Json.json
end
type 'a t = 'a tree
+let rec to_json json_of { node; children } : Json.json =
+ `Object [ ("node", json_of node); ("children", to_json_f json_of children) ]
+
+and to_json_f json_of f = `Array (List.map (to_json json_of) f)
+
let leaf node = { node; children = [] }
let rec fold_left ~f acc { node; children } =
@@ -50,4 +56,5 @@ module Forest = struct
let iter = iter_forest
let map = map_forest
let filter_map = filter_map_forest
+ let to_json = to_json_f
end
diff --git a/src/utils/tree.mli b/src/utils/tree.mli
index 8f3e558dd1..7dc5c68628 100644
--- a/src/utils/tree.mli
+++ b/src/utils/tree.mli
@@ -9,6 +9,7 @@ module type S = sig
val fold_left : f:('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc
val iter : f:('a -> unit) -> 'a t -> unit
val map : f:('a -> 'b) -> 'a t -> 'b t
+ val to_json : ('a -> Json.json) -> 'a t -> Json.json
end
include S with type 'a t = 'a tree
diff --git a/test/frontmatter/toc_order.t/run.t b/test/frontmatter/toc_order.t/run.t
index 8c0ee1d01b..74f42bdf9d 100644
--- a/test/frontmatter/toc_order.t/run.t
+++ b/test/frontmatter/toc_order.t/run.t
@@ -20,12 +20,15 @@
File "index.mld", line 1, characters 0-40:
Warning: (children) doesn't include 'omitted'.
- $ odoc html-generate --indent --index index.odoc-index -o _html _odoc/pkg/page-index.odocl
- $ odoc html-generate --index index.odoc-index -o _html _odoc/pkg/page-content.odocl
- $ odoc html-generate --index index.odoc-index -o _html _odoc/pkg/page-omitted.odocl
- $ odoc html-generate --index index.odoc-index -o _html _odoc/pkg/dir1/page-index.odocl
- $ odoc html-generate --index index.odoc-index -o _html _odoc/pkg/dir1/page-content_in_dir.odocl
- $ odoc html-generate --index index.odoc-index -o _html _odoc/pkg/dir1/page-dontent.odocl
+Turn the index into a sidebar (removes all unnecessary entries)
+ $ odoc sidebar-generate index.odoc-index
+
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o _html _odoc/pkg/page-index.odocl
+ $ odoc html-generate --sidebar sidebar.odoc-sidebar -o _html _odoc/pkg/page-content.odocl
+ $ odoc html-generate --sidebar sidebar.odoc-sidebar -o _html _odoc/pkg/page-omitted.odocl
+ $ odoc html-generate --sidebar sidebar.odoc-sidebar -o _html _odoc/pkg/dir1/page-index.odocl
+ $ odoc html-generate --sidebar sidebar.odoc-sidebar -o _html _odoc/pkg/dir1/page-content_in_dir.odocl
+ $ odoc html-generate --sidebar sidebar.odoc-sidebar -o _html _odoc/pkg/dir1/page-dontent.odocl
$ odoc support-files -o _html
$ odoc_print _odoc/pkg/page-index.odocl | jq .frontmatter
diff --git a/test/parent_id/missing_indexes.t/run.t b/test/parent_id/missing_indexes.t/run.t
index d95367923b..d9a0188d7e 100644
--- a/test/parent_id/missing_indexes.t/run.t
+++ b/test/parent_id/missing_indexes.t/run.t
@@ -8,8 +8,9 @@
$ odoc link _odoc/page-bar.odoc
$ odoc link _odoc/baz/page-bli.odoc
$ odoc compile-index -P _:_odoc
+ $ odoc sidebar-generate index.odoc-index
- $ odoc html-generate --index index.odoc-index --indent --output-dir _html _odoc/page-foo.odocl
+ $ odoc html-generate --sidebar sidebar.odoc-sidebar --indent --output-dir _html _odoc/page-foo.odocl
Missing index for Baz makes it unclickable but use the ID for the name.
Root is used for the missing index in the unnamed root directory.
diff --git a/test/roots_and_hierarchy/canonical_hierarchy.t/run.t b/test/roots_and_hierarchy/canonical_hierarchy.t/run.t
index 7ddd5a0d48..e403217635 100644
--- a/test/roots_and_hierarchy/canonical_hierarchy.t/run.t
+++ b/test/roots_and_hierarchy/canonical_hierarchy.t/run.t
@@ -23,12 +23,14 @@ Let's link it:
Let's html-generate it (with a sidebar):
- $ odoc compile-index -P pkg:_odoc/pkg/ -L libname:_odoc/pkg/libname -o sidebar.odoc-index
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/page-file.odocl
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/dir1/page-my_page.odocl
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/dir1/page-index.odocl
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/page-index.odocl
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/libname/unit.odocl
+ $ odoc compile-index -P pkg:_odoc/pkg/ -L libname:_odoc/pkg/libname
+ $ odoc sidebar-generate index.odoc-index
+
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/page-file.odocl
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/dir1/page-my_page.odocl
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/dir1/page-index.odocl
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/page-index.odocl
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/libname/unit.odocl
Now, let's see the result
diff --git a/test/roots_and_hierarchy/separate_doc_lib_folders.t/run.t b/test/roots_and_hierarchy/separate_doc_lib_folders.t/run.t
index eea1616534..eb652977df 100644
--- a/test/roots_and_hierarchy/separate_doc_lib_folders.t/run.t
+++ b/test/roots_and_hierarchy/separate_doc_lib_folders.t/run.t
@@ -23,12 +23,14 @@ Let's link it:
Let's html-generate it (with a sidebar):
- $ odoc compile-index -P pkg:_odoc/pkg/doc/ -L libname:_odoc/pkg/lib/libname -o sidebar.odoc-index
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/doc/page-file.odocl
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/doc/dir1/page-my_page.odocl
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/doc/dir1/page-index.odocl
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/doc/page-index.odocl
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/lib/libname/unit.odocl
+ $ odoc compile-index -P pkg:_odoc/pkg/doc/ -L libname:_odoc/pkg/lib/libname
+ $ odoc sidebar-generate index.odoc-index
+
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/doc/page-file.odocl
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/doc/dir1/page-my_page.odocl
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/doc/dir1/page-index.odocl
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/doc/page-index.odocl
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/lib/libname/unit.odocl
Now, let's see the result
diff --git a/test/roots_and_hierarchy/sidebar.t/run.t b/test/roots_and_hierarchy/sidebar.t/run.t
index 8c0ec9d6b2..7323b58aed 100644
--- a/test/roots_and_hierarchy/sidebar.t/run.t
+++ b/test/roots_and_hierarchy/sidebar.t/run.t
@@ -12,12 +12,109 @@
$ odoc link -P pkg:_odoc/pkg/ _odoc/pkg/page-index.odoc
$ odoc link -P pkg:_odoc/pkg/ _odoc/pkg/libname/unit.odoc
- $ odoc compile-index -P pkg:_odoc/pkg/ -L libname:_odoc/pkg/libname -o sidebar.odoc-index
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/page-file.odocl
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/dir1/page-my_page.odocl
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/dir1/page-index.odocl
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/page-index.odocl
- $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/libname/unit.odocl
+ $ odoc compile-index -P pkg:_odoc/pkg/ -L libname:_odoc/pkg/libname
+ $ odoc sidebar-generate index.odoc-index
+
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/page-file.odocl
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/dir1/page-my_page.odocl
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/dir1/page-index.odocl
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/page-index.odocl
+ $ odoc html-generate --indent --sidebar sidebar.odoc-sidebar -o html _odoc/pkg/libname/unit.odocl
+
+A json version of a sidebar can be obtained using the sidebar-generate command:
+
+ $ odoc sidebar-generate --json index.odoc-index
+ $ cat sidebar.json | jq
+ {
+ "pages": [
+ {
+ "name": "pkg",
+ "pages": {
+ "node": {
+ "url": "pkg/index.html",
+ "kind": "leaf-page",
+ "content": "Package pkg"
+ },
+ "children": [
+ {
+ "node": {
+ "url": "pkg/dir1/index.html",
+ "kind": "leaf-page",
+ "content": "A directory"
+ },
+ "children": [
+ {
+ "node": {
+ "url": "pkg/dir1/my_page.html",
+ "kind": "leaf-page",
+ "content": "My page"
+ },
+ "children": []
+ }
+ ]
+ },
+ {
+ "node": {
+ "url": "pkg/file.html",
+ "kind": "leaf-page",
+ "content": "File"
+ },
+ "children": []
+ }
+ ]
+ }
+ }
+ ],
+ "libraries": [
+ {
+ "name": "libname",
+ "modules": [
+ {
+ "node": {
+ "url": "pkg/libname/Unit/index.html",
+ "kind": "module",
+ "content": "Unit"
+ },
+ "children": [
+ {
+ "node": {
+ "url": "pkg/libname/Unit/X/index.html",
+ "kind": "module",
+ "content": "X"
+ },
+ "children": [
+ {
+ "node": {
+ "url": "pkg/libname/Unit/X/Y/index.html",
+ "kind": "module",
+ "content": "Y"
+ },
+ "children": []
+ },
+ {
+ "node": {
+ "url": "pkg/libname/Unit/X/index.html#module-Z",
+ "kind": "module",
+ "content": "Z"
+ },
+ "children": []
+ }
+ ]
+ },
+ {
+ "node": {
+ "url": "pkg/libname/Unit/module-type-Foo/index.html",
+ "kind": "module-type",
+ "content": "Foo"
+ },
+ "children": []
+ }
+ ]
+ }
+ ]
+ }
+ ]
+ }
$ cat html/pkg/index.html | grep odoc-global-toc -A 15