Driver: Read a config file to apply the right -P and -L.

odoc-driver.opam

@@ -44,6 +44,7 @@ depends: [
   "eio_main"
   "progress"
   "cmdliner"
+  "sexplib"
 ]
 
 build: [

src/driver/dune

@@ -14,4 +14,5 @@
   logs
   logs.fmt
   eio_main
+  sexplib
   odoc_utils))

src/driver/dune_style.ml

@@ -58,6 +58,7 @@ let of_dune_build dir =
                         (* When dune has a notion of doc assets, do something *);
                       pkg_dir;
                       other_docs = Fpath.Set.empty;
+                      config = Global_config.empty;
                     } )
             | _ -> None)
           libs

src/driver/global_config.ml

@@ -0,0 +1,45 @@
+open Sexplib0
+
+type deps = { packages : string list; libraries : string list }
+
+type t = { deps : deps }
+
+module Ast = struct
+  type item = Libraries of string list | Packages of string list
+
+  type t = item list
+end
+
+let parse_string_list sexps =
+  List.filter_map (function Sexp.Atom s -> Some s | _ -> None) sexps
+
+let parse_entry (sexp : Sexp.t) =
+  match sexp with
+  | Atom _ -> None
+  | List (Atom "libraries" :: libraries) ->
+      Some (Ast.Libraries (parse_string_list libraries))
+  | List (Atom "packages" :: pkgs) ->
+      Some (Ast.Packages (parse_string_list pkgs))
+  | _ -> None
+
+let of_ast (ast : Ast.t) =
+  let libs, pkgs =
+    List.fold_left
+      (fun (libs, pkgs) item ->
+        match item with
+        | Ast.Libraries l -> (l :: libs, pkgs)
+        | Ast.Packages l -> (libs, l :: pkgs))
+      ([], []) ast
+  in
+  let libraries, packages =
+    let f x = x |> List.concat |> List.sort_uniq String.compare in
+    (f libs, f pkgs)
+  in
+  { deps = { libraries; packages } }
+
+let parse s =
+  let entries = Sexplib.Sexp.of_string_many s in
+  let ast = List.filter_map parse_entry entries in
+  of_ast ast
+
+let empty = { deps = { libraries = []; packages = [] } }

src/driver/global_config.mli

@@ -0,0 +1,7 @@
+type deps = { packages : string list; libraries : string list }
+
+type t = { deps : deps }
+
+val empty : t
+
+val parse : string -> t

src/driver/odoc_driver.ml

@@ -516,7 +516,8 @@ let render_stats env nprocs =
       inner (0, 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 =
+    odoc_bin voodoo package_name blessed dune_style compile_grep link_grep
+    generate_grep =
   Option.iter (fun odoc_bin -> Odoc.odoc := Bos.Cmd.v odoc_bin) odoc_bin;
   let _ = Voodoo.find_universe_and_version "foo" in
   Eio_main.run @@ fun env ->
@@ -582,6 +583,17 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers
       (fun () -> render_stats env nb_workers)
   in
 
+  let grep_log l s =
+    let open Astring in
+    let do_ affix =
+      let grep l = if String.is_infix ~affix l then Format.printf "%s\n" l in
+      List.iter grep l
+    in
+    Option.iter do_ s
+  in
+  grep_log !Cmd_outputs.compile_output compile_grep;
+  grep_log !Cmd_outputs.link_output link_grep;
+  grep_log !Cmd_outputs.generate_output generate_grep;
   Format.eprintf "Final stats: %a@.%!" Stats.pp_stats Stats.stats;
   Format.eprintf "Total time: %f@.%!" (Stats.total_time ());
   if stats then Stats.bench_results html_dir
@@ -643,14 +655,26 @@ let dune_style =
   let doc = "Dune style" in
   Arg.(value & opt (some fpath_arg) None & info [ "dune-style" ] ~doc)
 
+let compile_grep =
+  let doc = "Show compile commands containing the string" in
+  Arg.(value & opt (some string) None & info [ "compile-grep" ] ~doc)
+
+let link_grep =
+  let doc = "Show link commands containing the string" in
+  Arg.(value & opt (some string) None & info [ "link-grep" ] ~doc)
+
+let generate_grep =
+  let doc = "Show html-generate commands containing the string" in
+  Arg.(value & opt (some string) None & info [ "html-grep" ] ~doc)
+
 let cmd =
   let doc = "Generate odoc documentation" in
   let info = Cmd.info "odoc_driver" ~doc in
   Cmd.v info
     Term.(
       const run $ packages $ verbose $ packages_dir $ odoc_dir $ odocl_dir
       $ html_dir $ stats $ nb_workers $ odoc_bin $ voodoo $ package_name
-      $ blessed $ dune_style)
+      $ blessed $ dune_style $ compile_grep $ link_grep $ generate_grep)
 
 (* let map = Ocamlfind.package_to_dir_map () in
    let _dirs = List.map (fun lib -> List.assoc lib map) deps in

src/driver/odoc_unit.ml

@@ -42,8 +42,10 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
     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 =
+
+  (* Maps a hash to the corresponding [Package.t], library name and
+     [Packages.modulety]. *)
+  let module_of_hash =
     let open Packages in
     let h = Util.StringMap.empty in
     List.fold_left
@@ -58,40 +60,72 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
           h pkg.libraries)
       h pkgs
   in
-  (* This one is a hashtable *)
-  let cache = Hashtbl.create 10 in
-  let pkg_args_of pkg : pkg_args =
+  let pkg_map =
+    Util.StringMap.of_list (List.map (fun pkg -> (pkg.Packages.name, pkg)) pkgs)
+  in
+
+  let lib_map =
+    Util.StringMap.of_list
+      (List.concat_map
+         (fun pkg ->
+           List.map
+             (fun lib -> (lib.Packages.lib_name, (pkg, lib)))
+             pkg.Packages.libraries)
+         pkgs)
+  in
+  let doc_dir pkg = Fpath.(pkg.Packages.pkg_dir / "doc") in
+  let lib_dir pkg libname = Fpath.(pkg.Packages.pkg_dir / "lib" / libname) in
+  let make_absolute = Fpath.( // ) output_dir in
+
+  let dash_p pkg = (pkg.Packages.name, doc_dir pkg |> make_absolute) in
+  let dash_l pkg lib =
+    (lib.Packages.lib_name, lib_dir pkg lib.lib_name |> make_absolute)
+  in
+  (* Given a pkg,  *)
+  let pkg_args_of_pkg pkg : pkg_args =
+    let own_page = dash_p pkg in
+    let own_libs = List.map (dash_l pkg) pkg.libraries in
+    { pages = [ own_page ]; libs = own_libs }
+  in
+  let pkg_args_of_config config : pkg_args =
+    let { Global_config.deps = { packages; libraries } } = config in
     let pages =
-      [
-        (pkg.Packages.name, Fpath.(output_dir // pkg.Packages.pkg_dir / "doc"));
-      ]
+      List.filter_map
+        (fun pkgname ->
+          match Util.StringMap.find_opt pkgname pkg_map with
+          | None -> None
+          | Some pkg -> Some (dash_p pkg))
+        packages
     in
     let libs =
-      List.map
-        (fun lib ->
-          ( lib.Packages.lib_name,
-            Fpath.(output_dir // pkg.Packages.pkg_dir / "lib" / lib.lib_name) ))
-        pkg.libraries
+      List.filter_map
+        (fun libname ->
+          match Util.StringMap.find_opt libname lib_map with
+          | None -> None
+          | Some (pkg, lib) -> Some (dash_l pkg lib))
+        libraries
     in
     { pages; libs }
   in
-  let pkg_args : pkg_args =
-    let pages, libs =
-      List.fold_left
-        (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 }
+  let pkg_args =
+    let cache = Hashtbl.create 10 in
+    fun pkg : pkg_args ->
+      match Hashtbl.find_opt cache pkg with
+      | Some res -> res
+      | None ->
+          let { pages = own_page; libs = own_libs } = pkg_args_of_pkg pkg in
+          let { pages = config_pages; libs = config_libs } =
+            pkg_args_of_config pkg.Packages.config
+          in
+          { pages = own_page @ config_pages; libs = own_libs @ config_libs }
   in
+
   let index_of pkg =
-    let pkg_args = pkg_args_of pkg in
+    let pkg_args = pkg_args_of_pkg 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 make_unit ~name ~kind ~rel_dir ~input_file ~pkg ~include_dirs : _ unit =
     let ( // ) = Fpath.( // ) in
     let ( / ) = Fpath.( / ) in
@@ -102,7 +136,7 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
     {
       output_dir;
       pkgname = pkg.Packages.name;
-      pkg_args;
+      pkg_args = pkg_args pkg;
       parent_id;
       odoc_dir;
       input_file;
@@ -113,22 +147,24 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
       index = Some (index_of pkg);
     }
   in
+
   let rec build_deps deps =
     List.filter_map
       (fun (_name, hash) ->
-        match Util.StringMap.find_opt hash hashtable with
+        match Util.StringMap.find_opt hash module_of_hash with
         | None -> None
         | Some (pkg, lib, mod_) ->
             let result = of_intf mod_.m_hidden pkg lib mod_.m_intf in
-            Hashtbl.add cache mod_.m_intf.mif_hash result;
             Some result)
       deps
-  and of_intf hidden pkg libname (intf : Packages.intf) : intf unit =
-    match Hashtbl.find_opt cache intf.mif_hash with
-    | Some unit -> unit
-    | None ->
-        let open Fpath in
-        let rel_dir = pkg.Packages.pkg_dir / "lib" / libname in
+  and of_intf =
+    (* Memoize (using the hash as the key) the creation of interface units, to
+       avoid creating them twice *)
+    let intf_cache : (string, intf unit) Hashtbl.t = Hashtbl.create 10 in
+
+    fun hidden pkg libname (intf : Packages.intf) : intf unit ->
+      let do_ () : intf unit =
+        let rel_dir = lib_dir pkg libname in
         let include_dirs, kind =
           let deps = build_deps intf.mif_deps in
           let include_dirs = List.map (fun u -> u.odoc_dir) deps in
@@ -138,13 +174,20 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
         let name = intf.mif_path |> Fpath.rem_ext |> Fpath.basename in
         make_unit ~name ~kind ~rel_dir ~input_file:intf.mif_path ~pkg
           ~include_dirs
+      in
+      match Hashtbl.find_opt intf_cache intf.mif_hash with
+      | Some unit -> unit
+      | None ->
+          let result = do_ () in
+          Hashtbl.add intf_cache intf.mif_hash result;
+          result
   in
+
   let of_impl pkg libname (impl : Packages.impl) : impl unit option =
-    let open Fpath in
     match impl.mip_src_info with
     | None -> None
     | Some { src_path } ->
-        let rel_dir = pkg.Packages.pkg_dir / "lib" / libname in
+        let rel_dir = lib_dir pkg libname in
         let include_dirs =
           let deps = build_deps impl.mip_deps in
           List.map (fun u -> u.odoc_dir) deps
@@ -180,14 +223,10 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
   let of_mld pkg (mld : Packages.mld) : mld unit list =
     let open Fpath in
     let { Packages.mld_path; mld_rel_path } = mld in
-    let rel_dir =
-      pkg.Packages.pkg_dir / "doc" // Fpath.parent mld_rel_path
-      |> Fpath.normalize
-    in
+    let rel_dir = doc_dir pkg // Fpath.parent mld_rel_path |> Fpath.normalize in
     let include_dirs =
       List.map
-        (fun (lib : Packages.libty) ->
-          Fpath.(output_dir // pkg.pkg_dir / "lib" / lib.lib_name))
+        (fun (lib : Packages.libty) -> lib_dir pkg lib.lib_name)
         pkg.libraries
     in
     let include_dirs = (output_dir // rel_dir) :: include_dirs in
@@ -202,8 +241,7 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
     let open Fpath in
     let { Packages.asset_path; asset_rel_path } = asset in
     let rel_dir =
-      pkg.Packages.pkg_dir / "doc" // Fpath.parent asset_rel_path
-      |> Fpath.normalize
+      doc_dir pkg // Fpath.parent asset_rel_path |> Fpath.normalize
     in
     let include_dirs = [] in
     let kind = `Asset in
@@ -213,6 +251,7 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) :
     in
     [ unit ]
   in
+
   let of_package (pkg : Packages.t) : t list =
     let lib_units :> t list list = List.map (of_lib pkg) pkg.libraries in
     let mld_units :> t list list = List.map (of_mld pkg) pkg.mlds in