Sidebar generate: Update driver

Author: panglesd

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/odoc/bin/main.ml

@@ -553,14 +553,14 @@ module Sidebar = struct
     | Some file, `JSON when not (Fpath.has_ext "json" (Fpath.v file)) ->
         Error
           (`Msg
-            "When generating a json index, the output must have a .json file \
-             extension")
-    | Some file, `Marshall when not (Fpath.has_ext "odoc-index" (Fpath.v file))
-      ->
+            "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 a binary index, the output must have a \
-             .odoc-sidebar file extension")
+            "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")