Driver: package and library arguments

Some general tidying too.

odoc-driver.opam

@@ -46,6 +46,7 @@ depends: [
   "cmdliner"
   "sexplib"
   "ppx_sexp_conv"
+  "opam-state"
 ]
 
 build: [

src/driver/db.ml

@@ -0,0 +1,10 @@
+(* Db - a type to help determine which modules belong in which libraries *)
+
+type t = {
+  all_libs : Util.StringSet.t;
+  all_lib_deps : Util.StringSet.t Util.StringMap.t;
+  lib_dirs_and_archives : (string * Fpath.t * Util.StringSet.t) list;
+  archives_by_dir : Util.StringSet.t Fpath.map;
+  libname_of_archive : string Fpath.map;
+  cmi_only_libs : (Fpath.t * string) list;
+}

src/driver/dune

@@ -17,4 +17,5 @@
   logs.fmt
   eio_main
   sexplib
-  odoc_utils))
+  odoc_utils
+  opam-state))

src/driver/dune_style.ml

@@ -91,6 +91,12 @@ let of_dune_build dir =
             | _ -> None)
           sorted
       in
+      let libname_of_archive =
+        List.fold_left
+          (fun acc (libname, path) ->
+            Fpath.Map.add Fpath.(path / libname) libname acc)
+          Fpath.Map.empty libs
+      in
       let libs =
         List.map
           (fun (libname, path) ->
@@ -99,11 +105,8 @@ let of_dune_build dir =
             in
             let pkg_dir = Fpath.rem_prefix dir path |> Option.get in
             ( pkg_dir,
-              Packages.Lib.v
-                ~libname_of_archive:
-                  (Fpath.Map.singleton Fpath.(path / libname) libname)
-                ~pkg_name:libname ~dir:path ~cmtidir:(Some cmtidir)
-                ~all_lib_deps ~cmi_only_libs:[] ))
+              Packages.Lib.v ~libname_of_archive ~pkg_name:libname ~dir:path
+                ~cmtidir:(Some cmtidir) ~all_lib_deps ~cmi_only_libs:[] ))
           libs
       in
       let packages =

src/driver/global_config.ml

@@ -43,3 +43,9 @@ let parse s =
   of_ast ast
 
 let empty = { deps = { libraries = []; packages = [] } }
+
+let load pkg_name =
+  let config_file =
+    Fpath.(v (Opam.prefix ()) / "doc" / pkg_name / "odoc-config.sexp")
+  in
+  match Bos.OS.File.read config_file with Error _ -> empty | Ok s -> parse s

src/driver/global_config.mli

@@ -5,3 +5,5 @@ type t = { deps : deps }
 val empty : t
 
 val parse : string -> t
+
+val load : string -> t

src/driver/ocamlfind.ml

@@ -16,10 +16,9 @@ let get_dir lib =
   try
     init ();
     Fl_package_base.query lib |> fun x ->
-    Logs.debug (fun m -> m "Package %s is in directory %s@." lib x.package_dir);
     Ok Fpath.(v x.package_dir |> to_dir_path)
   with e ->
-    Printf.eprintf "Error: %s\n" (Printexc.to_string e);
+    Logs.err (fun m -> m "Error: %s\n" (Printexc.to_string e));
     Error (`Msg "Error getting directory")
 
 let archives pkg =
@@ -51,11 +50,165 @@ let sub_libraries top =
       if package = top then Util.StringSet.add lib acc else acc)
     Util.StringSet.empty packages
 
+(* Returns deep dependencies for the given package *)
+let rec dep =
+  let memo = ref Util.StringMap.empty in
+  fun pkg ->
+    init ();
+    try Util.StringMap.find pkg !memo
+    with Not_found -> (
+      try
+        let deps = Fl_package_base.requires ~preds:[ "ppx_driver" ] pkg in
+        let result =
+          List.fold_left
+            (fun acc x ->
+              match dep x with
+              | Ok dep_deps -> Util.StringSet.(union acc (add x dep_deps))
+              | Error _ -> acc)
+            Util.StringSet.empty deps
+        in
+        memo := Util.StringMap.add pkg (Ok result) !memo;
+        Ok result
+      with e ->
+        let result = Error (`Msg (Printexc.to_string e)) in
+        memo := Util.StringMap.add pkg result !memo;
+        result)
+
 let deps pkgs =
-  init ();
-  try
-    let packages =
-      Fl_package_base.requires_deeply ~preds:[ "ppx_driver" ] pkgs
+  let results = List.map dep pkgs in
+  Ok
+    (List.fold_left Util.StringSet.union Util.StringSet.empty
+       (List.map (Result.value ~default:Util.StringSet.empty) results))
+
+module Db = struct
+  type t = {
+    all_libs : Util.StringSet.t;
+    all_lib_deps : Util.StringSet.t Util.StringMap.t;
+    lib_dirs_and_archives : (string * Fpath.t * Util.StringSet.t) list;
+    archives_by_dir : Util.StringSet.t Fpath.map;
+    libname_of_archive : string Fpath.map;
+    cmi_only_libs : (Fpath.t * string) list;
+  }
+
+  let create libs =
+    let _ = Opam.prefix () in
+    let libs = Util.StringSet.to_seq libs |> List.of_seq in
+
+    (* First, find the complete set of libraries - that is, including all of
+       the dependencies of the libraries supplied on the commandline *)
+    let all_libs_deps =
+      match deps libs with
+      | Error (`Msg msg) ->
+          Logs.err (fun m -> m "Error finding dependencies: %s" msg);
+          Util.StringSet.empty
+      | Ok libs -> Util.StringSet.add "stdlib" libs
+    in
+
+    let all_libs_set =
+      Util.StringSet.union all_libs_deps (Util.StringSet.of_list libs)
+    in
+    let all_libs = Util.StringSet.elements all_libs_set in
+
+    (* Now we need the dependency tree of those libraries *)
+    let all_lib_deps =
+      List.fold_right
+        (fun lib_name acc ->
+          match deps [ lib_name ] with
+          | Ok deps -> Util.StringMap.add lib_name deps acc
+          | Error (`Msg msg) ->
+              Logs.err (fun m ->
+                  m
+                    "Error finding dependencies of library '%s' through \
+                     ocamlfind: %s"
+                    lib_name msg);
+              acc)
+        all_libs Util.StringMap.empty
+    in
+
+    (* We also need to find, for each library, the library directory and
+       the list of archives for that library *)
+    let lib_dirs_and_archives =
+      List.filter_map
+        (fun lib ->
+          match get_dir lib with
+          | Error _ ->
+              Logs.err (fun m -> m "No dir for library %s" lib);
+              None
+          | Ok p ->
+              let archives = archives lib in
+              let archives =
+                List.map
+                  (fun x ->
+                    try Filename.chop_extension x
+                    with e ->
+                      Logs.err (fun m -> m "Can't chop extension from %s" x);
+                      raise e)
+                  archives
+              in
+              let archives = Util.StringSet.(of_list archives) in
+              Some (lib, p, archives))
+        all_libs
+    in
+
+    (* An individual directory may contain multiple libraries, each with
+       zero or more archives. We need to know which directories contain
+       which archives *)
+    let archives_by_dir =
+      List.fold_left
+        (fun set (_lib, p, archives) ->
+          Fpath.Map.update p
+            (function
+              | Some set -> Some (Util.StringSet.union set archives)
+              | None -> Some archives)
+            set)
+        Fpath.Map.empty lib_dirs_and_archives
+    in
+
+    (* Compute the mapping between full path of an archive to the
+       name of the libary *)
+    let libname_of_archive =
+      List.fold_left
+        (fun map (lib, dir, archives) ->
+          match Util.StringSet.elements archives with
+          | [] -> map
+          | [ archive ] ->
+              Fpath.Map.update
+                Fpath.(dir / archive)
+                (function
+                  | None -> Some lib
+                  | Some x ->
+                      Logs.info (fun m ->
+                          m
+                            "Multiple libraries for archive %s: %s and %s. \
+                             Arbitrarily picking the latter."
+                            archive x lib);
+                      Some lib)
+                map
+          | xs ->
+              Logs.err (fun m ->
+                  m "multiple archives detected: [%a]"
+                    Fmt.(list ~sep:sp string)
+                    xs);
+              assert false)
+        Fpath.Map.empty lib_dirs_and_archives
+    in
+
+    (* We also need to know about libraries that have no archives at all
+       (these are virtual libraries usually) *)
+    let cmi_only_libs =
+      List.fold_left
+        (fun map (lib, dir, archives) ->
+          match Util.StringSet.elements archives with
+          | [] -> (dir, lib) :: map
+          | _ -> map)
+        [] lib_dirs_and_archives
     in
-    Ok packages
-  with e -> Error (`Msg (Printexc.to_string e))
+    {
+      all_libs = all_libs_set;
+      all_lib_deps;
+      lib_dirs_and_archives;
+      archives_by_dir;
+      libname_of_archive;
+      cmi_only_libs;
+    }
+end

src/driver/ocamlfind.mli

@@ -10,5 +10,18 @@ val archives : string -> string list
 val sub_libraries : string -> Util.StringSet.t
 (** Returns the list of sublibraries of a given library *)
 
-val deps : string list -> (string list, [> `Msg of string ]) result
+val deps : string list -> (Util.StringSet.t, [> `Msg of string ]) result
 (** Returns the list of transitive package dependencies of given libraries *)
+
+module Db : sig
+  type t = {
+    all_libs : Util.StringSet.t;
+    all_lib_deps : Util.StringSet.t Util.StringMap.t;
+    lib_dirs_and_archives : (string * Fpath.t * Util.StringSet.t) list;
+    archives_by_dir : Util.StringSet.t Fpath.map;
+    libname_of_archive : string Fpath.map;
+    cmi_only_libs : (Fpath.t * string) list;
+  }
+
+  val create : Util.StringSet.t -> t
+end

src/driver/odoc_driver.ml

@@ -551,9 +551,9 @@ let remap_virtual_interfaces duplicate_hashes pkgs =
       })
     pkgs
 
-let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers
-    odoc_bin voodoo package_name blessed dune_style compile_grep link_grep
-    generate_grep =
+let run libs packages verbose packages_dir odoc_dir odocl_dir html_dir stats
+    nb_workers 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 ->
@@ -564,26 +564,41 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers
   let () = Worker_pool.start_workers env sw nb_workers in
 
   let all, extra_libs_paths =
-    match (voodoo, package_name, dune_style, packages_dir) with
-    | true, Some p, None, None ->
+    match (voodoo, package_name, dune_style, packages_dir, libs, packages) with
+    | true, Some p, None, None, [], [] ->
         let all = Voodoo.of_voodoo p ~blessed in
         let extra_libs_paths = Voodoo.extra_libs_paths odoc_dir in
         (all, extra_libs_paths)
-    | false, None, Some dir, None ->
+    | false, None, Some dir, None, [], [] ->
         (Dune_style.of_dune_build dir, Util.StringMap.empty)
-    | false, None, None, packages_dir ->
-        let libs = if libs = [] then Ocamlfind.all () else libs in
+    | false, None, None, packages_dir, [], [] ->
+        let libs = Ocamlfind.all () in
         let libs =
           List.map Ocamlfind.sub_libraries libs
           |> List.fold_left Util.StringSet.union Util.StringSet.empty
         in
         (Packages.of_libs ~packages_dir libs, Util.StringMap.empty)
-    | true, None, _, _ -> failwith "--voodoo requires --package"
-    | false, Some _, _, _ -> failwith "--package requires --voodoo"
-    | true, _, _, Some _ | false, _, Some _, Some _ ->
+    | false, None, None, packages_dir, libs, [] ->
+        let libs =
+          List.map Ocamlfind.sub_libraries libs
+          |> List.fold_left Util.StringSet.union Util.StringSet.empty
+        in
+        (Packages.of_libs ~packages_dir libs, Util.StringMap.empty)
+    | false, None, None, packages_dir, [], packages ->
+        (Packages.of_packages ~packages_dir packages, Util.StringMap.empty)
+    | true, Some _p, None, None, _, _ ->
+        failwith "--voodoo and -l / -p are mutually exclusive"
+    | false, None, Some _dir, None, _, _ ->
+        failwith "--dune-style and -l / -p are mutually exclusive"
+    | true, None, _, _, _, _ -> failwith "--voodoo requires --package"
+    | false, Some _, _, _, _, _ -> failwith "--package requires --voodoo"
+    | true, _, _, Some _, _, _ | false, _, Some _, Some _, _, _ ->
         failwith "--packages-dir is only useful in opam mode"
-    | true, _, Some _, _ ->
+    | true, _, Some _, _, _, _ ->
         failwith "--voodoo and --dune-style are mutually exclusive"
+    | false, None, None, _packages_dir, _, _ ->
+        failwith
+          "Please specify either packages (-p) or libraries (-l), not both"
   in
 
   let virtual_check =
@@ -691,6 +706,11 @@ let packages =
   let doc = "The packages to document" in
   Arg.(value & opt_all string [] & info [ "p" ] ~doc)
 
+let libs =
+  (* TODO: Is it package or library? *)
+  let doc = "The libraries to document" in
+  Arg.(value & opt_all string [] & info [ "l" ] ~doc)
+
 let verbose =
   let doc = "Enable verbose output" in
   Arg.(value & flag & info [ "v"; "verbose" ] ~doc)
@@ -744,9 +764,10 @@ let cmd =
   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 $ compile_grep $ link_grep $ generate_grep)
+      const run $ libs $ packages $ verbose $ packages_dir $ odoc_dir
+      $ odocl_dir $ html_dir $ stats $ nb_workers $ odoc_bin $ voodoo
+      $ package_name $ 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

@@ -161,7 +161,7 @@ let of_packages ~output_dir ~linked_dir ~index_dir ~extra_libs_paths
     match Util.StringMap.find_opt lib_name lib_dirs with
     | Some dir -> [ (lib_name, dir) ]
     | None ->
-        Logs.err (fun m -> m "Library %s not found" lib_name);
+        Logs.debug (fun m -> m "Library %s not found" lib_name);
         []
   in
   (* Given a pkg,  *)