Driver: allow overriding main package index

src/driver/bin/odoc_driver.ml

@@ -7,7 +7,7 @@ let with_dir dir pat f =
   | Some dir -> f dir ()
 
 let run_inner ~odoc_dir ~odocl_dir ~index_dir ~mld_dir ~compile_grep ~link_grep
-    ~generate_grep ~index_grep ~remap packages
+    ~generate_grep ~index_grep ~remap ~index_mld packages
     {
       Common_args.verbose;
       html_dir;
@@ -45,8 +45,9 @@ let run_inner ~odoc_dir ~odocl_dir ~index_dir ~mld_dir ~compile_grep ~link_grep
       (fun () ->
         let units =
           let dirs = { Odoc_unit.odoc_dir; odocl_dir; index_dir; mld_dir } in
-          Odoc_units_of.packages ~dirs ~indices_style:Odoc_units_of.Normal
-            ~extra_paths ~remap all
+          Odoc_units_of.packages ~dirs
+            ~indices_style:(Odoc_units_of.Normal index_mld) ~extra_paths ~remap
+            all
         in
         Compile.init_stats units;
         let compiled = Compile.compile ~partial_dir:odoc_dir units in
@@ -124,14 +125,14 @@ let run_inner ~odoc_dir ~odocl_dir ~index_dir ~mld_dir ~compile_grep ~link_grep
   if stats then Stats.bench_results html_dir
 
 let run odoc_dir odocl_dir index_dir mld_dir compile_grep link_grep
-    generate_grep index_grep remap packages common () =
+    generate_grep index_grep remap packages index_mld common () =
   with_dir odoc_dir "odoc-%s" @@ fun odoc_dir () ->
   with_dir odocl_dir "odocl-%s" @@ fun odocl_dir () ->
   with_dir index_dir "index-%s" @@ fun index_dir () ->
   with_dir mld_dir "mld-%s" @@ fun mld_dir () ->
   let () =
     run_inner ~odoc_dir ~odocl_dir ~index_dir ~mld_dir ~compile_grep ~link_grep
-      ~generate_grep ~index_grep ~remap packages common
+      ~generate_grep ~index_grep ~remap ~index_mld packages common
   in
   ()
 
@@ -189,10 +190,20 @@ let remap =
 
 let packages = Arg.(value & pos_all string [] & info [] ~docv:"PACKAGES")
 
+let index_mld =
+  let doc =
+    "Provide an index.mld file to serve as the top-level index of the \
+     documentation"
+  in
+  Arg.(
+    value
+    & opt (some Common_args.fpath_arg) None
+    & info [ "index-mld" ] ~docv:"INDEX" ~doc)
+
 let cmd_term =
   Term.(
     const run $ odoc_dir $ odocl_dir $ index_dir $ mld_dir $ compile_grep
-    $ link_grep $ generate_grep $ index_grep $ remap $ packages
+    $ link_grep $ generate_grep $ index_grep $ remap $ packages $ index_mld
     $ Common_args.term $ const ())
 
 let cmd =

src/driver/landing_pages.ml

@@ -1,9 +1,12 @@
+type u = unit
+
 open Odoc_unit
 open Packages
 
 let fpf = Format.fprintf
 
-let make_index ~dirs ~rel_dir ?(libs = []) ?(pkgs = []) ?index ~content () =
+let make_index ~dirs ~rel_dir ?(libs = []) ?(pkgs = []) ?index ~enable_warnings
+    ~content () =
   let { odoc_dir; odocl_dir; mld_dir; _ } = dirs in
   let input_file = Fpath.(mld_dir // rel_dir / "index.mld") in
   let odoc_file = Fpath.(odoc_dir // rel_dir / "page-index.odoc") in
@@ -29,7 +32,7 @@ let make_index ~dirs ~rel_dir ?(libs = []) ?(pkgs = []) ?index ~content () =
     input_file;
     odoc_file;
     odocl_file;
-    enable_warnings = false;
+    enable_warnings;
     to_output = true;
     kind = `Mld;
     index;
@@ -56,7 +59,7 @@ let library ~dirs ~pkg ~index lib =
   in
   let rel_dir = lib_dir pkg lib in
   let libs = [ (pkg, lib) ] in
-  make_index ~dirs ~rel_dir ~libs ~index ~content ()
+  make_index ~dirs ~rel_dir ~libs ~index ~content ~enable_warnings:false ()
 
 let package ~dirs ~pkg ~index =
   let library_list ppf pkg =
@@ -83,7 +86,8 @@ let package ~dirs ~pkg ~index =
   let content = content pkg in
   let rel_dir = doc_dir pkg in
   let libs = List.map (fun lib -> (pkg, lib)) pkg.libraries in
-  make_index ~dirs ~rel_dir ~index ~content ~pkgs:[ pkg ] ~libs ()
+  make_index ~dirs ~rel_dir ~index ~content ~pkgs:[ pkg ] ~libs
+    ~enable_warnings:false ()
 
 let src ~dirs ~pkg ~index =
   let content ppf =
@@ -95,7 +99,7 @@ let src ~dirs ~pkg ~index =
       pkg.name
   in
   let rel_dir = src_dir pkg in
-  make_index ~dirs ~rel_dir ~index ~content ()
+  make_index ~dirs ~rel_dir ~index ~content ~enable_warnings:true ()
 
 let package_list ~dirs ~remap all =
   let content all ppf =
@@ -111,7 +115,7 @@ let package_list ~dirs ~remap all =
   in
   let content = content all in
   let rel_dir = Fpath.v "./" in
-  make_index ~dirs ~rel_dir ~pkgs:all ~content ()
+  make_index ~dirs ~rel_dir ~pkgs:all ~content ~enable_warnings:true ()
 
 let content dir _pkg libs _src subdirs all_libs pfp =
   let is_root = Fpath.to_string dir = "./" in
@@ -278,7 +282,7 @@ let make_custom dirs index_of (pkg : Packages.t) :
         let idx =
           make_index ~dirs ~rel_dir:p ~libs ~pkgs
             ~content:(content p pkg libs src subdirs all_libs)
-            ?index ()
+            ?index ~enable_warnings:false ()
         in
         idx :: acc)
     all_dirs []

src/driver/landing_pages.mli

@@ -1,5 +1,18 @@
+type u = unit
+
 open Odoc_unit
 
+val make_index :
+  dirs:dirs ->
+  rel_dir:Fpath.t ->
+  ?libs:(Packages.t * Packages.libty) list ->
+  ?pkgs:Packages.t list ->
+  ?index:index ->
+  enable_warnings:bool ->
+  content:(Format.formatter -> u) ->
+  u ->
+  [> `Mld ] Odoc_unit.unit
+
 val library :
   dirs:dirs -> pkg:Packages.t -> index:index -> Packages.libty -> mld unit
 

src/driver/odoc_units_of.ml

@@ -1,6 +1,6 @@
 open Odoc_unit
 
-type indices_style = Voodoo | Normal | Automatic
+type indices_style = Voodoo | Normal of Fpath.t option | Automatic
 
 let packages ~dirs ~extra_paths ~remap ~indices_style (pkgs : Packages.t list) :
     t list =
@@ -283,10 +283,31 @@ let packages ~dirs ~extra_paths ~remap ~indices_style (pkgs : Packages.t list) :
                pkgs)
         in
         others @ List.concat std_units
-    | Normal | Voodoo | Automatic ->
+    | Normal _ | Voodoo | Automatic ->
         List.concat (pkg_index () :: src_index () :: std_units)
   in
-  if indices_style = Normal then
-    let gen_indices :> t = Landing_pages.package_list ~dirs ~remap pkgs in
-    gen_indices :: List.concat_map of_package pkgs
-  else List.concat_map of_package pkgs
+  match indices_style with
+  | Normal None ->
+      let gen_indices :> t = Landing_pages.package_list ~dirs ~remap pkgs in
+      gen_indices :: List.concat_map of_package pkgs
+  | Normal (Some index_mld) -> (
+      match Bos.OS.File.read index_mld with
+      | Error (`Msg msg) ->
+          Logs.err (fun m ->
+              m "Failed to read index_mld file '%a': %s" Fpath.pp index_mld msg);
+          []
+      | Ok content ->
+          let content ppf = Format.fprintf ppf "%s" content in
+          let libs =
+            List.concat_map
+              (fun pkg ->
+                List.map (fun lib -> (pkg, lib)) pkg.Packages.libraries)
+              pkgs
+          in
+          let index =
+            Landing_pages.make_index ~dirs
+              ~rel_dir:Fpath.(v "./")
+              ~libs ~pkgs ~enable_warnings:true ~content ()
+          in
+          index :: List.concat_map of_package pkgs)
+  | Voodoo | Automatic -> List.concat_map of_package pkgs

src/driver/odoc_units_of.mli

@@ -1,6 +1,6 @@
 open Odoc_unit
 
-type indices_style = Voodoo | Normal | Automatic
+type indices_style = Voodoo | Normal of Fpath.t option | Automatic
 
 val packages :
   dirs:dirs ->