More fixes for monorepo mode

- library dependencies need transitive deps too
- added the ability to specify extra pkgs/libs (like odoc-config.sexp)
- minor improvements to landing pages
- pick up jpgs as assets

src/driver/bin/odoc_driver_monorepo.ml

@@ -6,7 +6,7 @@
 
 open Odoc_driver_lib
 
-let run path
+let run path extra_pkgs extra_libs
     {
       Common_args.verbose;
       html_dir;
@@ -35,7 +35,9 @@ let run path
   let () = Worker_pool.start_workers env sw nb_workers in
 
   let all, extra_paths, generate_json =
-    (Monorepo_style.of_dune_build path, Voodoo.empty_extra_paths, generate_json)
+    ( Monorepo_style.of_dune_build path ~extra_pkgs ~extra_libs,
+      Voodoo.empty_extra_paths,
+      generate_json )
   in
 
   let all = Packages.remap_virtual all in
@@ -93,9 +95,18 @@ let path =
     & pos 0 Common_args.fpath_arg (Fpath.v ".")
     & info ~doc ~docv:"PATH" [])
 
+let extra_pkgs =
+  let doc = "Extra packages to link with" in
+  Arg.(value & opt_all string [] & info [ "P" ] ~doc)
+
+let extra_libs =
+  let doc = "Extra libraries to link with" in
+  Arg.(value & opt_all string [] & info [ "L" ] ~doc)
+
 let cmd =
   let doc = "Generate documentation from a dune monorepo" in
   let info = Cmd.info "odoc_driver_monorepo" ~doc in
-  Cmd.v info Term.(const run $ path $ Common_args.term)
+  Cmd.v info
+    Term.(const run $ path $ extra_pkgs $ extra_libs $ Common_args.term)
 
 let _ = exit (Cmd.eval cmd)

src/driver/landing_pages.ml

@@ -132,11 +132,11 @@ let content dir _pkg libs _src subdirs all_libs pfp =
     fpf pfp "{1 Subdirectories}\n";
     Fpath.Set.iter
       (fun subdir ->
-        fpf pfp "- {{!/pkg/%apage-index}%s}\n%!" Fpath.pp subdir
+        fpf pfp "- {{!/%s/%apage-index}%s}\n%!" Monorepo_style.monorepo_pkg_name Fpath.pp subdir
           (Fpath.basename subdir))
       subdirs);
 
-  if List.length libs > 0 then
+  if (not is_root) && List.length libs > 0 then
     List.iter
       (fun (_, lib) ->
         fpf pfp "{1 Library %s}" lib.Packages.lib_name;
@@ -248,8 +248,9 @@ let make_custom dirs index_of (pkg : Packages.t) :
         acc)
       else
         let libs =
+          let is_root = Fpath.to_string p = "./" in
           Fpath.Map.fold
-            (fun p' lib libs -> if p = p' then lib :: libs else libs)
+            (fun p' lib libs -> if p = p' || is_root then lib :: libs else libs)
             lib_dirs []
         in
         let src = Fpath.Map.find_opt p src_dirs in

src/driver/monorepo_style.ml

@@ -68,7 +68,7 @@ let dune_describe dir =
   let out = Worker_pool.submit "dune describe" cmd None in
   match out with Error _ -> [] | Ok out -> of_dune_describe out.Run.output
 
-let of_dune_build dir =
+let of_dune_build dir ~extra_pkgs ~extra_libs =
   let root = Fpath.(dir / "_build" / "default") in
   let contents =
     Bos.OS.Dir.fold_contents ~dotfiles:true (fun p acc -> p :: acc) [] root
@@ -78,16 +78,11 @@ let of_dune_build dir =
   | Ok c ->
       let cset = Fpath.Set.of_list c in
       let libs = dune_describe dir in
-      let local_libs =
-        List.filter_map
-          (function Library l -> if l.local then Some l else None)
-          libs
-      in
 
-      let global_libs =
-        List.filter_map
-          (function Library l -> if l.local then None else Some l)
-          libs
+      let local_libs, global_libs =
+        List.partition
+          (function l -> l.local)
+          (List.filter_map (function Library l -> Some l) libs)
       in
 
       List.iter
@@ -97,11 +92,13 @@ let of_dune_build dir =
                 Fmt.(option (pair string Fpath.pp))
                 (internal_name_of_library lib)))
         local_libs;
+
       let uid_to_libname =
         List.fold_left
           (fun acc l -> Util.StringMap.add l.uid l.name acc)
-          Util.StringMap.empty local_libs
+          Util.StringMap.empty (local_libs @ global_libs)
       in
+
       let all_lib_deps =
         List.fold_left
           (fun acc (l : library) ->
@@ -112,8 +109,35 @@ let of_dune_build dir =
                     l.requires
               |> Util.StringSet.of_list)
               acc)
-          Util.StringMap.empty local_libs
+          Util.StringMap.empty (local_libs @ global_libs)
+      in
+
+      let rec with_trans_deps =
+        let cache = Hashtbl.create (List.length libs) in
+        fun lib_name ->
+          try Hashtbl.find cache lib_name
+          with Not_found ->
+            let libs =
+              try Util.StringMap.find lib_name all_lib_deps
+              with Not_found ->
+                Logs.debug (fun m -> m "No lib deps for library %s" lib_name);
+                Util.StringSet.empty
+            in
+            let result =
+              Util.StringSet.fold
+                (fun l acc -> Util.StringSet.union (with_trans_deps l) acc)
+                libs libs
+            in
+            Hashtbl.add cache lib_name result;
+            result
       in
+
+      let all_lib_deps =
+        Util.StringMap.mapi
+          (fun lib_name _ -> with_trans_deps lib_name)
+          all_lib_deps
+      in
+
       let colon = Fmt.any ":" in
       Format.eprintf "all_lib_deps: %a@."
         Fmt.(list ~sep:comma (pair ~sep:colon string (list ~sep:semi string)))
@@ -141,29 +165,31 @@ let of_dune_build dir =
       in
       let libs =
         List.filter_map
-          (fun (Library lib) ->
+          (fun lib ->
             match internal_name_of_library lib with
             | None -> None
-            | Some (_, cmtidir) ->
+            | Some (libname, cmtidir) ->
                 let cmtidir = Fpath.(append dir cmtidir) in
                 let id_override =
                   Fpath.relativize
                     ~root:Fpath.(v "_build/default")
                     Fpath.(v lib.source_dir)
                   |> Option.map Fpath.to_string
                 in
-                Logs.debug (fun m ->
-                    m "this should never be 'None': %a"
-                      Fmt.Dump.(option string)
-                      id_override);
+                (match id_override with
+                | None ->
+                    Logs.warn (fun m ->
+                        m "Could not determine id_override for library '%s'"
+                          libname)
+                | _ -> ());
                 if Fpath.Set.mem cmtidir cset then
                   Some
                     (Packages.Lib.v ~libname_of_archive ~pkg_name:lib.name
                        ~dir:(Fpath.append dir (Fpath.v lib.source_dir))
                        ~cmtidir:(Some cmtidir) ~all_lib_deps ~cmi_only_libs:[]
                        ~id_override)
                 else None)
-          libs
+          local_libs
       in
       let find_docs ext =
         List.filter_map
@@ -182,22 +208,37 @@ let of_dune_build dir =
         find_docs ".mld"
         |> List.map (fun (p, r) -> { Packages.mld_path = p; mld_rel_path = r })
       in
-
+      let assets =
+        find_docs ".jpg"
+        |> List.map (fun (p, r) ->
+               { Packages.asset_path = p; asset_rel_path = r })
+      in
       let libs = List.flatten libs in
+      let global_config =
+        {
+          Global_config.deps =
+            {
+              packages = extra_pkgs;
+              libraries =
+                extra_libs
+                @ List.map (fun (lib : Packages.libty) -> lib.lib_name) libs;
+            };
+        }
+      in
       let local =
         [
           {
             Packages.name = monorepo_pkg_name;
             version = "1.0";
             libraries = libs;
             mlds;
-            assets = [];
+            assets;
             selected = true;
             remaps = [];
             pkg_dir = Fpath.v ".";
             doc_dir = Fpath.v ".";
             other_docs;
-            config = Global_config.empty;
+            config = global_config;
           };
         ]
       in

src/driver/monorepo_style.mli

@@ -1,3 +1,4 @@
 val monorepo_pkg_name : string
 
-val of_dune_build : Fpath.t -> Packages.t list
+val of_dune_build :
+  Fpath.t -> extra_pkgs:string list -> extra_libs:string list -> Packages.t list

src/driver/odoc.ml

@@ -44,6 +44,7 @@ let compile ~output_dir ~input_file:file ~includes ~suppress_warnings ~parent_id
       (fun path acc -> Cmd.(acc % "-I" % p path))
       includes Cmd.empty
   in
+
   let output_file =
     let _, f = Fpath.split_base file in
     Some Fpath.(output_dir // Id.to_fpath parent_id // set_ext "odoc" f)
@@ -54,6 +55,11 @@ let compile ~output_dir ~input_file:file ~includes ~suppress_warnings ~parent_id
   in
   let cmd = cmd % "--parent-id" % Id.to_string parent_id in
   let cmd = if suppress_warnings then cmd % "--suppress-warnings" else cmd in
+  let dirname = Id.to_fpath parent_id |> Fpath.filename in
+  let cmd =
+    if Fpath.filename file = "index.mld" then cmd % "--short-title" % dirname
+    else cmd
+  in
   let desc = Printf.sprintf "Compiling %s" (Fpath.to_string file) in
   ignore
   @@ Cmd_outputs.submit

src/driver/odoc_units_of.ml

@@ -1,9 +1,6 @@
 open Odoc_unit
 
-type indices_style =
-  | Voodoo
-  | Normal
-  | Automatic
+type indices_style = Voodoo | Normal | Automatic
 
 let packages ~dirs ~extra_paths ~remap ~indices_style (pkgs : Packages.t list) :
     t list =
@@ -279,11 +276,15 @@ let packages ~dirs ~extra_paths ~remap ~indices_style (pkgs : Packages.t list) :
     let std_units = mld_units @ asset_units @ md_units @ lib_units in
     match indices_style with
     | Automatic when pkg.name = Monorepo_style.monorepo_pkg_name ->
-      let others :> t list = Landing_pages.make_custom dirs index_of (List.find (fun p -> p.Packages.name = Monorepo_style.monorepo_pkg_name) pkgs) in
-      others @ List.concat std_units
+        let others :> t list =
+          Landing_pages.make_custom dirs index_of
+            (List.find
+               (fun p -> p.Packages.name = Monorepo_style.monorepo_pkg_name)
+               pkgs)
+        in
+        others @ List.concat std_units
     | Normal | Voodoo | Automatic ->
-      List.concat
-        (pkg_index () :: src_index () :: std_units)
+        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

src/driver/packages.mli

@@ -89,6 +89,8 @@ type t = {
 
 val pp : Format.formatter -> t -> unit
 
+val fix_missing_deps : t list -> t list
+
 val mk_mlds : Opam.doc_file list -> mld list * asset list * md list
 
 val of_libs : packages_dir:Fpath.t option -> Util.StringSet.t -> t list