+4 -2

src/document/sidebar.ml

··· 2 2 open Types 3 3 module Id = Odoc_model.Paths.Identifier 4 4 5 5 + type entry = Url.t option * Inline.one 6 6 + 5 7 module Toc : sig 6 6 - type t 8 8 + type t = entry Tree.t 7 9 8 10 val of_page_hierarchy : Odoc_index.Page_hierarchy.t -> t 9 11 ··· 11 13 12 14 val to_block : prune:bool -> Url.Path.t -> t -> Block.t 13 15 end = struct 14 14 - type t = (Url.t option * Inline.one) Tree.t 16 16 + type t = entry Tree.t 15 17 16 18 let of_page_hierarchy (dir : Odoc_index.Page_hierarchy.t) : t = 17 19 let f index =

+9 -1

src/document/sidebar.mli

··· 1 1 - type t 1 1 + open Odoc_utils 2 2 + open Types 3 3 + 4 4 + type entry = Url.t option * Inline.one 5 5 + 6 6 + type pages = { name : string; pages : entry Tree.t } 7 7 + type library = { name : string; units : entry Tree.t list } 8 8 + 9 9 + type t = { pages : pages list; libraries : library list } 2 10 3 11 val of_lang : Odoc_index.t -> t 4 12

+4

src/html/generator.ml

··· 590 590 let doc ~config ~xref_base_uri b = 591 591 let resolve = Link.Base xref_base_uri in 592 592 block ~config ~resolve b 593 593 + 594 594 + let inline ~config ~xref_base_uri b = 595 595 + let resolve = Link.Base xref_base_uri in 596 596 + inline ~config ~resolve b

+6

src/html/generator.mli

··· 11 11 xref_base_uri:string -> 12 12 Odoc_document.Types.Block.t -> 13 13 Html_types.flow5_without_sectioning_heading_header_footer Tyxml.Html.elt list 14 14 + 15 15 + val inline : 16 16 + config:Config.t -> 17 17 + xref_base_uri:string -> 18 18 + Odoc_document.Types.Inline.t -> 19 19 + Html_types.phrasing Tyxml.Html.elt list

+55

src/odoc/bin/main.ml

··· 476 476 Antichain.check (lib_roots |> List.map ~f:snd) ~opt:"-L" >>= fun () -> 477 477 Indexing.compile marshall ~output ~warnings_options ~occurrences ~lib_roots 478 478 ~page_roots ~inputs_in_file ~odocls:inputs 479 479 + 479 480 let cmd = 480 481 let dst = 481 482 let doc = ··· 542 543 in the given directories." 543 544 in 544 545 Term.info "compile-index" ~docs ~doc 546 546 + end 547 547 + 548 548 + module Sidebar = struct 549 549 + open Or_error 550 550 + 551 551 + let output_file ~dst marshall = 552 552 + match (dst, marshall) with 553 553 + | Some file, `JSON when not (Fpath.has_ext "json" (Fpath.v file)) -> 554 554 + Error 555 555 + (`Msg 556 556 + "When generating a json index, the output must have a .json file \ 557 557 + extension") 558 558 + | Some file, `Marshall when not (Fpath.has_ext "odoc-index" (Fpath.v file)) 559 559 + -> 560 560 + Error 561 561 + (`Msg 562 562 + "When generating a binary index, the output must have a \ 563 563 + .odoc-sidebar file extension") 564 564 + | Some file, _ -> Ok (Fs.File.of_string file) 565 565 + | None, `JSON -> Ok (Fs.File.of_string "sidebar.json") 566 566 + | None, `Marshall -> Ok (Fs.File.of_string "sidebar.odoc-sidebar") 567 567 + 568 568 + let generate dst json warnings_options input = 569 569 + let marshall = if json then `JSON else `Marshall in 570 570 + output_file ~dst marshall >>= fun output -> 571 571 + Sidebar.generate ~marshall ~output ~warnings_options ~index:input 572 572 + 573 573 + let cmd = 574 574 + let dst = 575 575 + let doc = 576 576 + "Output file path. Non-existing intermediate directories are created. \ 577 577 + Defaults to sidebar.odoc-sidebar, or sidebar.json if --json is \ 578 578 + passed." 579 579 + in 580 580 + Arg.( 581 581 + value & opt (some string) None & info ~docs ~docv:"PATH" ~doc [ "o" ]) 582 582 + in 583 583 + let json = 584 584 + let doc = "whether to output a json file, or a binary .odoc-index file" in 585 585 + Arg.(value & flag & info ~doc [ "json" ]) 586 586 + in 587 587 + let inputs = 588 588 + let doc = ".odoc-index file to generate a value from" in 589 589 + Arg.( 590 590 + required & pos 0 (some convert_fpath) None & info ~doc ~docv:"FILE" []) 591 591 + in 592 592 + Term.( 593 593 + const handle_error 594 594 + $ (const generate $ dst $ json $ warnings_options $ inputs)) 595 595 + 596 596 + let info ~docs = 597 597 + let doc = "Generate a sidebar from an index file." in 598 598 + Term.info "sidebar-generate" ~docs ~doc 545 599 end 546 600 547 601 module Support_files_command = struct ··· 1575 1629 Support_files_command.(cmd, info ~docs:section_pipeline); 1576 1630 Compile_impl.(cmd, info ~docs:section_pipeline); 1577 1631 Indexing.(cmd, info ~docs:section_pipeline); 1632 1632 + Sidebar.(cmd, info ~docs:section_pipeline); 1578 1633 Odoc_manpage.generate ~docs:section_generators; 1579 1634 Odoc_latex.generate ~docs:section_generators; 1580 1635 Odoc_html_url.(cmd, info ~docs:section_support);

+4

src/odoc/odoc_file.ml

··· 116 116 let save_index dst idx = save_ dst (fun oc -> Marshal.to_channel oc idx []) 117 117 118 118 let load_index file = load_ file (fun ic -> Ok (Marshal.from_channel ic)) 119 119 + 120 120 + let save_sidebar dst idx = save_ dst (fun oc -> Marshal.to_channel oc idx []) 121 121 + 122 122 + let load_sidebar file = load_ file (fun ic -> Ok (Marshal.from_channel ic))

+5

src/odoc/odoc_file.mli

··· 56 56 val load_index : Fs.File.t -> (Odoc_index.t, [> msg ]) result 57 57 (** Load a [.odoc-index] file. *) 58 58 59 59 + val save_sidebar : Fs.File.t -> Odoc_document.Sidebar.t -> unit 60 60 + 61 61 + val load_sidebar : Fs.File.t -> (Odoc_document.Sidebar.t, [> msg ]) result 62 62 + (** Load a [.odoc-index] file. *) 63 63 + 59 64 val save_asset : Fpath.t -> warnings:Error.t list -> Lang.Asset.t -> unit

+60

src/odoc/sidebar.ml

··· 1 1 + open Or_error 2 2 + open Odoc_utils 3 3 + 4 4 + let toc_to_json ((url, inline) : Odoc_document.Sidebar.entry) : Json.json = 5 5 + let config = 6 6 + Odoc_html.Config.v ~semantic_uris:true ~indent:true ~flat:false 7 7 + ~open_details:false ~as_json:true ~remap:[] () 8 8 + in 9 9 + let url = 10 10 + match url with 11 11 + | None -> `Null 12 12 + | Some url -> 13 13 + let href = 14 14 + Odoc_html.Link.href ~config ~resolve:(Odoc_html.Link.Base "") url 15 15 + in 16 16 + `String href 17 17 + in 18 18 + let inline = 19 19 + let inline = 20 20 + Odoc_html.Generator.inline ~config ~xref_base_uri:"" [ inline ] 21 21 + in 22 22 + let inline = 23 23 + String.concat "" 24 24 + @@ List.map (Format.asprintf "%a" (Tyxml.Html.pp_elt ())) inline 25 25 + in 26 26 + `String inline 27 27 + in 28 28 + `Object [ ("url", url); ("content", inline) ] 29 29 + 30 30 + let pages_to_json ({ name; pages } : Odoc_document.Sidebar.pages) = 31 31 + `Object [ ("name", `String name); ("pages", Tree.to_json toc_to_json pages) ] 32 32 + 33 33 + let libs_to_json ({ name; units } : Odoc_document.Sidebar.library) = 34 34 + `Object 35 35 + [ 36 36 + ("name", `String name); 37 37 + ("modules", `Array (List.map (Tree.to_json toc_to_json) units)); 38 38 + ] 39 39 + 40 40 + let sidebar_to_json ({ pages; libraries } : Odoc_document.Sidebar.t) = 41 41 + let pages = List.map pages_to_json pages in 42 42 + let libraries = List.map libs_to_json libraries in 43 43 + `Object [ ("pages", `Array pages); ("libraries", `Array libraries) ] 44 44 + 45 45 + let compile_to_json ~output sidebar = 46 46 + let json = sidebar_to_json sidebar in 47 47 + let text = Json.to_string json in 48 48 + let output_channel = 49 49 + Fs.Directory.mkdir_p (Fs.File.dirname output); 50 50 + open_out_bin (Fs.File.to_string output) 51 51 + in 52 52 + let output = Format.formatter_of_out_channel output_channel in 53 53 + Format.fprintf output "%s" text 54 54 + 55 55 + let generate ~marshall ~output ~warnings_options:_ ~index = 56 56 + Odoc_file.load_index index >>= fun index -> 57 57 + let sidebar = Odoc_document.Sidebar.of_lang index in 58 58 + match marshall with 59 59 + | `JSON -> Ok (compile_to_json ~output sidebar) 60 60 + | `Marshall -> Ok (Odoc_file.save_sidebar output sidebar)

+7

src/utils/tree.ml

··· 9 9 val fold_left : f:('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc 10 10 val iter : f:('a -> unit) -> 'a t -> unit 11 11 val map : f:('a -> 'b) -> 'a t -> 'b t 12 12 + val to_json : ('a -> Json.json) -> 'a t -> Json.json 12 13 end 13 14 14 15 type 'a t = 'a tree 16 16 + 17 17 + let rec to_json json_of { node; children } : Json.json = 18 18 + `Object [ ("node", json_of node); ("children", to_json_f json_of children) ] 19 19 + 20 20 + and to_json_f json_of f = `Array (List.map (to_json json_of) f) 15 21 16 22 let leaf node = { node; children = [] } 17 23 ··· 50 56 let iter = iter_forest 51 57 let map = map_forest 52 58 let filter_map = filter_map_forest 59 59 + let to_json = to_json_f 53 60 end

+1

src/utils/tree.mli

··· 9 9 val fold_left : f:('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc 10 10 val iter : f:('a -> unit) -> 'a t -> unit 11 11 val map : f:('a -> 'b) -> 'a t -> 'b t 12 12 + val to_json : ('a -> Json.json) -> 'a t -> Json.json 12 13 end 13 14 14 15 include S with type 'a t = 'a tree

+79

test/roots_and_hierarchy/sidebar.t/run.t

··· 19 19 $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/page-index.odocl 20 20 $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/libname/unit.odocl 21 21 22 22 + A json version of a sidebar can be obtained using the sidebar-generate command: 23 23 + 24 24 + $ odoc sidebar-generate --json sidebar.odoc-index 25 25 + $ cat sidebar.json | jq 26 26 + { 27 27 + "pages": [ 28 28 + { 29 29 + "name": "pkg", 30 30 + "pages": { 31 31 + "node": { 32 32 + "url": "pkg/index.html", 33 33 + "content": "<a href=\"pkg/index.html\">Package <code>pkg</code></a>" 34 34 + }, 35 35 + "children": [ 36 36 + { 37 37 + "node": { 38 38 + "url": "pkg/dir1/index.html", 39 39 + "content": "<a href=\"pkg/dir1/index.html\">A directory</a>" 40 40 + }, 41 41 + "children": [ 42 42 + { 43 43 + "node": { 44 44 + "url": "pkg/dir1/my_page.html", 45 45 + "content": "<a href=\"pkg/dir1/my_page.html\">My page</a>" 46 46 + }, 47 47 + "children": [] 48 48 + } 49 49 + ] 50 50 + }, 51 51 + { 52 52 + "node": { 53 53 + "url": "pkg/file.html", 54 54 + "content": "<a href=\"pkg/file.html\">File</a>" 55 55 + }, 56 56 + "children": [] 57 57 + } 58 58 + ] 59 59 + } 60 60 + } 61 61 + ], 62 62 + "libraries": [ 63 63 + { 64 64 + "name": "libname", 65 65 + "modules": [ 66 66 + { 67 67 + "node": { 68 68 + "url": "pkg/libname/Unit/index.html", 69 69 + "content": "<a href=\"pkg/libname/Unit/index.html\">Unit</a>" 70 70 + }, 71 71 + "children": [ 72 72 + { 73 73 + "node": { 74 74 + "url": "pkg/libname/Unit/X/index.html", 75 75 + "content": "<a href=\"pkg/libname/Unit/X/index.html\">X</a>" 76 76 + }, 77 77 + "children": [ 78 78 + { 79 79 + "node": { 80 80 + "url": "pkg/libname/Unit/X/Y/index.html", 81 81 + "content": "<a href=\"pkg/libname/Unit/X/Y/index.html\">Y</a>" 82 82 + }, 83 83 + "children": [] 84 84 + }, 85 85 + { 86 86 + "node": { 87 87 + "url": "pkg/libname/Unit/X/index.html#module-Z", 88 88 + "content": "<a href=\"pkg/libname/Unit/X/index.html#module-Z\">Z</a>" 89 89 + }, 90 90 + "children": [] 91 91 + } 92 92 + ] 93 93 + } 94 94 + ] 95 95 + } 96 96 + ] 97 97 + } 98 98 + ] 99 99 + } 100 100 + 22 101 $ cat html/pkg/index.html | grep odoc-global-toc -A 15 23 102 <nav class="odoc-toc odoc-global-toc"> 24 103 <ul class="odoc-modules">