Driver: Reenable sidebar and search

Author: panglesd

src/driver/compile.ml

@@ -85,7 +85,7 @@ let find_partials odoc_dir : Odoc_unit.intf Odoc_unit.unit Util.StringMap.t * _
   | Ok h -> (h, tbl)
   | Error _ -> (* odoc_dir doesn't exist...? *) (Util.StringMap.empty, tbl)
 
-let compile ?partial ~output_dir ?linked_dir:_ (all : Odoc_unit.t list) =
+let compile ?partial ~partial_dir ?linked_dir:_ (all : Odoc_unit.t list) =
   (* let linked_dir = Option.value linked_dir ~default:output_dir in *)
   let intf_units, impl_units, mld_units =
     List.fold_left
@@ -102,7 +102,7 @@ let compile ?partial ~output_dir ?linked_dir:_ (all : Odoc_unit.t list) =
   let hashes = mk_byhash intf_units in
   let other_hashes, tbl =
     match partial with
-    | Some _ -> find_partials output_dir
+    | Some _ -> find_partials partial_dir
     | None -> (Util.StringMap.empty, Hashtbl.create 10)
   in
   let all_hashes =
@@ -127,29 +127,6 @@ let compile ?partial ~output_dir ?linked_dir:_ (all : Odoc_unit.t list) =
                   None)
             deps
         in
-
-        (* let includes = Fpath.Set.add output_dir includes in ?????????? *)
-
-        (* TOOOODOOOOO *)
-        (* let impl = *)
-        (*   match modty.m_impl with *)
-        (*   | Some impl -> ( *)
-        (*       match impl.mip_src_info with *)
-        (*       | Some si -> *)
-        (*           let odoc_file = Fpath.(output_dir // impl.mip_odoc_file) in *)
-        (*           let odocl_file = Fpath.(linked_dir // impl.mip_odocl_file) in *)
-        (*           Odoc.compile_impl ~output_dir ~input_file:impl.mip_path *)
-        (*             ~includes ~parent_id:impl.mip_parent_id ~source_id:si.src_id; *)
-        (*           Atomic.incr Stats.stats.compiled_impls; *)
-        (*           Some *)
-        (*             { *)
-        (*               impl_odoc = odoc_file; *)
-        (*               impl_odocl = odocl_file; *)
-        (*               src = si.src_path; *)
-        (*             } *)
-        (*       | None -> None) *)
-        (*   | None -> None *)
-        (* in *)
         let includes = Fpath.Set.of_list unit.include_dirs in
         Odoc.compile ~output_dir:unit.output_dir ~input_file:unit.input_file
           ~includes ~parent_id:unit.parent_id;
@@ -229,61 +206,52 @@ let link : compiled list -> _ =
   in
   Fiber.List.map link compiled
 
-(* let index_one ~odocl_dir pkg_name pkg = *)
-(*   let dir = pkg.Packages.pkg_dir in *)
-(*   let output_file = Fpath.(odocl_dir // dir / Odoc.index_filename) in *)
-(*   let libs = *)
-(*     List.map *)
-(*       (fun lib -> (lib.Packages.lib_name, Fpath.(odocl_dir // lib.odoc_dir))) *)
-(*       pkg.Packages.libraries *)
-(*   in *)
-(*   Odoc.compile_index ~json:false ~output_file ~libs *)
-(*     ~docs:[ (pkg_name, Fpath.(odocl_dir // pkg.mld_odoc_dir)) ] *)
-(*     () *)
-
-(* let index ~odocl_dir pkgs = Util.StringMap.iter (index_one ~odocl_dir) pkgs *)
-
-(* let sherlodoc_index_one ~html_dir ~odocl_dir _ pkg_content = *)
-(*   let inputs = *)
-(*     [ Fpath.(odocl_dir // pkg_content.Packages.pkg_dir / Odoc.index_filename) ] *)
-(*   in *)
-(*   let dst = Fpath.(html_dir // Sherlodoc.db_js_file pkg_content.pkg_dir) in *)
-(*   let dst_dir, _ = Fpath.split_base dst in *)
-(*   Util.mkdir_p dst_dir; *)
-(*   Sherlodoc.index ~format:`js ~inputs ~dst () *)
-
-(* let sherlodoc ~html_dir ~odocl_dir pkgs = *)
-(*   ignore @@ Bos.OS.Dir.create html_dir; *)
-(*   Sherlodoc.js Fpath.(html_dir // Sherlodoc.js_file); *)
-(*   Util.StringMap.iter (sherlodoc_index_one ~html_dir ~odocl_dir) pkgs; *)
-(*   let format = `marshal in *)
-(*   let dst = Fpath.(html_dir // Sherlodoc.db_marshal_file) in *)
-(*   let dst_dir, _ = Fpath.split_base dst in *)
-(*   Util.mkdir_p dst_dir; *)
-(*   let inputs = *)
-(*     pkgs |> Util.StringMap.bindings *)
-(*     |> List.map (fun (_pkgname, pkg) -> *)
-(*            Fpath.(odocl_dir // pkg.Packages.pkg_dir / Odoc.index_filename)) *)
-(*   in *)
-(*   Sherlodoc.index ~format ~inputs ~dst () *)
+let sherlodoc_index_one ~output_dir (index : Odoc_unit.index) =
+  let inputs = [ index.output_file ] in
+  let rel_path = Fpath.(index.search_dir / "sherlodoc_db.js") in
+  let dst = Fpath.(output_dir // rel_path) in
+  let dst_dir, _ = Fpath.split_base dst in
+  Util.mkdir_p dst_dir;
+  Sherlodoc.index ~format:`js ~inputs ~dst ();
+  rel_path
 
-let html_generate output_dir (* ~odocl_dir *) linked =
+let html_generate output_dir linked =
+  let tbl = Hashtbl.create 10 in
+  Sherlodoc.js Fpath.(output_dir // Sherlodoc.js_file);
+  let compile_index : Odoc_unit.index -> _ =
+   fun index ->
+    let compile_index_one
+        ({ pkg_args = { pages; libs }; output_file; json; search_dir = _ } as
+         index :
+          Odoc_unit.index) =
+      let () = Odoc.compile_index ~json ~output_file ~libs ~docs:pages () in
+      sherlodoc_index_one ~output_dir index
+    in
+    match Hashtbl.find_opt tbl index.output_file with
+    | None ->
+        let p, r = Promise.create () in
+        Hashtbl.add tbl index.output_file p;
+        let rel_path = compile_index_one index in
+        Atomic.incr Stats.stats.generated_indexes;
+        Promise.resolve r rel_path;
+        rel_path
+    | Some p -> Promise.await p
+  in
   let html_generate : linked -> unit =
    fun l ->
+    let output_dir = Fpath.to_string output_dir in
+    let input_file = l.odocl_file in
     match l.kind with
     | `Intf { hidden = true; _ } -> ()
     | `Impl { src_path; _ } ->
-        Odoc.html_generate ~search_uris:[] ?index:None
-          ~output_dir:(Fpath.to_string output_dir)
-          ~input_file:l.odocl_file ~source:src_path ();
+        Odoc.html_generate ~search_uris:[] ~output_dir ~input_file
+          ~source:src_path ();
         Atomic.incr Stats.stats.generated_units
     | _ ->
-        (* let pkg_dir = l. in *)
-        (* let search_uris = [ Sherlodoc.db_js_file pkg_dir; Sherlodoc.js_file ] in *)
-        (* let index = Some Fpath.(odocl_dir // pkg_dir / Odoc.index_filename) in *)
-        Odoc.html_generate ~search_uris:[] ?index:None
-          ~output_dir:(Fpath.to_string output_dir)
-          ~input_file:l.odocl_file ?source:None (* l.src *) ();
+        let db_path = compile_index l.index in
+        let search_uris = [ db_path; Sherlodoc.js_file ] in
+        let index = l.index.output_file in
+        Odoc.html_generate ~search_uris ~index ~output_dir ~input_file ();
         Atomic.incr Stats.stats.generated_units
   in
   Fiber.List.iter html_generate linked

src/driver/compile.mli

@@ -4,9 +4,9 @@ val init_stats : Packages.set -> unit
 
 val compile :
   ?partial:Fpath.t ->
-  output_dir:Fpath.t ->
+  partial_dir:Fpath.t ->
   ?linked_dir:Fpath.t ->
-  (* Packages.set *) Odoc_unit.t list (* Util.StringMap.t *) ->
+  Odoc_unit.t list ->
   compiled list
 (** Use [partial] to reuse the output of a previous call to [compile]. Useful in
     the voodoo context.
@@ -18,8 +18,4 @@ type linked
 
 val link : compiled list -> linked list
 
-(* val index : odocl_dir:Fpath.t -> Packages.set -> unit *)
-
-(* val sherlodoc : html_dir:Fpath.t -> odocl_dir:Fpath.t -> Packages.set -> unit *)
-
-val html_generate : Fpath.t (* -> odocl_dir:Fpath.t *) -> linked list -> unit
+val html_generate : Fpath.t -> linked list -> unit

src/driver/odoc_driver.ml

@@ -470,17 +470,19 @@ let render_stats env nprocs =
       ++ dline "Linking" non_hidden
       ++ dline "Linking impls" total_impls
       ++ dline "Linking mlds" total_mlds
+      ++ dline "Indexes" 10000
       ++ dline "HTML" (total_impls + non_hidden + total_mlds)
       ++ line (procs nprocs))
-    (fun comp compimpl compmld link linkimpl linkmld html procs ->
-      let rec inner (a, b, c, d, e, f, g, h) =
+    (fun comp compimpl compmld link linkimpl linkmld indexes html procs ->
+      let rec inner (a, b, c, d, e, f, i, g, h) =
         Eio.Time.sleep clock 0.1;
         let a' = Atomic.get Stats.stats.compiled_units in
         let b' = Atomic.get Stats.stats.compiled_impls in
         let c' = Atomic.get Stats.stats.compiled_mlds in
         let d' = Atomic.get Stats.stats.linked_units in
         let e' = Atomic.get Stats.stats.linked_impls in
         let f' = Atomic.get Stats.stats.linked_mlds in
+        let i' = Atomic.get Stats.stats.generated_indexes in
         let g' = Atomic.get Stats.stats.generated_units in
         let h' = Atomic.get Stats.stats.processes in
 
@@ -490,12 +492,13 @@ let render_stats env nprocs =
         link (d' - d);
         linkimpl (e' - e);
         linkmld (f' - f);
+        indexes (i' - i);
         html (g' - g);
         procs (h' - h);
         if g' < non_hidden + total_impls + total_mlds then
-          inner (a', b', c', d', e', f', g', h')
+          inner (a', b', c', d', e', f', i', g', h')
       in
-      inner (0, 0, 0, 0, 0, 0, 0, 0))
+      inner (0, 0, 0, 0, 0, 0, 0, 0, 0))
 
 let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers
     odoc_bin voodoo package_name blessed dune_style =
@@ -540,17 +543,15 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers
       (fun () ->
         let all =
           let all = Util.StringMap.bindings all |> List.map snd in
-          Odoc_unit.of_packages ~output_dir:odoc_dir ~linked_dir:odocl_dir all
+          Odoc_unit.of_packages ~output_dir:odoc_dir ~linked_dir:odocl_dir
+            ~index_dir:None all
         in
         let compiled =
-          Compile.compile ?partial ~output_dir:odoc_dir ?linked_dir:odocl_dir
+          Compile.compile ?partial ~partial_dir:odoc_dir ?linked_dir:odocl_dir
             all
         in
         let linked = Compile.link compiled in
-        (* let odocl_dir = match odocl_dir with Some l -> l | None -> odoc_dir in *)
-        (* let () = Compile.index ~odocl_dir all in *)
-        (* let () = Compile.sherlodoc ~html_dir ~odocl_dir all in *)
-        let () = Compile.html_generate html_dir (* ~odocl_dir *) linked in
+        let () = Compile.html_generate html_dir linked in
         let _ = Odoc.support_files html_dir in
         ())
       (fun () -> render_stats env nb_workers)

src/driver/odoc_unit.ml

@@ -3,6 +3,13 @@ type pkg_args = {
   libs : (string * Fpath.t) list;
 }
 
+type index = {
+  pkg_args : pkg_args;
+  output_file : Fpath.t;
+  json : bool;
+  search_dir : Fpath.t;
+}
+
 type 'a unit = {
   parent_id : Odoc.id;
   odoc_dir : Fpath.t;
@@ -13,6 +20,7 @@ type 'a unit = {
   pkg_args : pkg_args;
   pkgname : string;
   include_dirs : Fpath.t list;
+  index : index;
   kind : 'a;
 }
 
@@ -26,10 +34,12 @@ type mld = [ `Mld ]
 
 type t = [ impl | intf | mld ] unit
 
-let of_packages ~output_dir ~linked_dir (pkgs : Packages.t list) : t list =
+let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
+    t list =
   let linked_dir =
     match linked_dir with None -> output_dir | Some dir -> dir
   in
+  let index_dir = match index_dir with None -> output_dir | Some dir -> dir in
   (* This isn't a hashtable, but a table of hashes! Yay! *)
   let hashtable =
     let open Packages in
@@ -48,29 +58,38 @@ let of_packages ~output_dir ~linked_dir (pkgs : Packages.t list) : t list =
   in
   (* This one is a hashtable *)
   let cache = Hashtbl.create 10 in
+  let pkg_args_of pkg : pkg_args =
+    let pages =
+      [
+        (pkg.Packages.name, Fpath.(output_dir // pkg.Packages.pkg_dir / "doc"));
+      ]
+    in
+    let libs =
+      List.map
+        (fun lib ->
+          ( lib.Packages.lib_name,
+            Fpath.(output_dir // pkg.Packages.pkg_dir / "lib" / lib.lib_name) ))
+        pkg.libraries
+    in
+    { pages; libs }
+  in
   let pkg_args : pkg_args =
     let pages, libs =
       List.fold_left
-        (fun (pages, libs) pkg ->
-          let page =
-            ( pkg.Packages.name,
-              Fpath.(output_dir // pkg.Packages.pkg_dir / "doc") )
-          in
-          let new_libs =
-            List.map
-              (fun lib ->
-                ( lib.Packages.lib_name,
-                  Fpath.(
-                    output_dir // pkg.Packages.pkg_dir / "lib" / lib.lib_name)
-                ))
-              pkg.libraries
-          in
-          (page :: pages, new_libs :: libs))
+        (fun (all_pages, all_libs) pkg ->
+          let { pages; libs } = pkg_args_of pkg in
+          (pages :: all_pages, libs :: all_libs))
         ([], []) pkgs
     in
+    let pages = List.concat pages in
     let libs = List.concat libs in
     { pages; libs }
   in
+  let index_of pkg =
+    let pkg_args = pkg_args_of pkg in
+    let output_file = Fpath.(index_dir / pkg.name / Odoc.index_filename) in
+    { pkg_args; output_file; json = false; search_dir = pkg.pkg_dir }
+  in
   let rec of_intf hidden pkg libname (intf : Packages.intf) : intf unit =
     match Hashtbl.find_opt cache intf.mif_hash with
     | Some unit -> unit
@@ -107,6 +126,7 @@ let of_packages ~output_dir ~linked_dir (pkgs : Packages.t list) : t list =
           odocl_file;
           include_dirs;
           kind;
+          index = index_of pkg;
         }
   in
   let of_impl pkg libname (impl : Packages.impl) : impl unit option =
@@ -152,6 +172,7 @@ let of_packages ~output_dir ~linked_dir (pkgs : Packages.t list) : t list =
             pkg_args;
             include_dirs;
             kind;
+            index = index_of pkg;
           }
   in
 
@@ -198,6 +219,7 @@ let of_packages ~output_dir ~linked_dir (pkgs : Packages.t list) : t list =
         kind;
         pkg_args;
         include_dirs;
+        index = index_of pkg;
       };
     ]
   in

src/driver/odoc_unit.mli

@@ -3,6 +3,13 @@ type pkg_args = {
   libs : (string * Fpath.t) list;
 }
 
+type index = {
+  pkg_args : pkg_args;
+  output_file : Fpath.t;
+  json : bool;
+  search_dir : Fpath.t;
+}
+
 type 'a unit = {
   parent_id : Odoc.id;
   odoc_dir : Fpath.t;
@@ -13,6 +20,7 @@ type 'a unit = {
   pkg_args : pkg_args;
   pkgname : string;
   include_dirs : Fpath.t list;
+  index : index;
   kind : 'a;
 }
 
@@ -27,4 +35,8 @@ type mld = [ `Mld ]
 type t = [ impl | intf | mld ] unit
 
 val of_packages :
-  output_dir:Fpath.t -> linked_dir:Fpath.t option -> Packages.t list -> t list
+  output_dir:Fpath.t ->
+  linked_dir:Fpath.t option ->
+  index_dir:Fpath.t option ->
+  Packages.t list ->
+  t list

src/driver/stats.ml

@@ -13,6 +13,7 @@ type stats = {
   mutable linked_units : int Atomic.t;
   mutable linked_impls : int Atomic.t;
   mutable linked_mlds : int Atomic.t;
+  mutable generated_indexes : int Atomic.t;
   mutable generated_units : int Atomic.t;
   mutable processes : int Atomic.t;
 }
@@ -30,6 +31,7 @@ let stats =
     linked_impls = Atomic.make 0;
     linked_mlds = Atomic.make 0;
     generated_units = Atomic.make 0;
+    generated_indexes = Atomic.make 0;
     processes = Atomic.make 0;
   }