Driver: Add missing library dependencies

Because we are separating libraries which might be co-located in your
opam switch, it sometimes happens that a package is using types from
a library without expressing it in their META files. For example,
`Odoc_classify` is using the `Cmx_format` module interface, which we put
in the `compiler-libs.optcomp` package. It only links against
`compiler-libs.common` though, and there is no explicit dependency on
`compiler-libs.optcomp` which works because the two libraries are in the
same directory.

This commit fixes this problem by post-processing the `Packages.t` datatype,
finding hashes that aren't in any declared library dependency and adding
them to the deps of that library.

Author: jonludlam

src/driver/cmd_outputs.ml

@@ -1,22 +1,27 @@
-let submit desc cmd output_file =
-  match Worker_pool.submit desc cmd output_file with
-  | Ok x -> x
-  | Error exn -> raise exn
-
-let compile_output = ref [ "" ]
-
-let compile_src_output = ref [ "" ]
+type log_dest =
+  [ `Compile
+  | `Compile_src
+  | `Link
+  | `Count_occurrences
+  | `Generate
+  | `Index
+  | `Source_tree
+  | `Sherlodoc
+  | `Classify ]
 
-let link_output = ref [ "" ]
+let outputs : (log_dest * [ `Out | `Err ] * string * string) list ref = ref []
 
-let generate_output = ref [ "" ]
+let maybe_log log_dest r =
+  match log_dest with
+  | Some (dest, prefix) ->
+      let add ty s = outputs := !outputs @ [ (dest, ty, prefix, s) ] in
+      add `Out r.Run.output;
+      add `Err r.Run.errors
+  | None -> ()
 
-let index_output = ref [ "" ]
-
-let source_tree_output = ref [ "" ]
-
-let add_prefixed_output cmd list prefix lines =
-  if List.length lines > 0 then
-    list :=
-      !list
-      @ (Bos.Cmd.to_string cmd :: List.map (fun l -> prefix ^ ": " ^ l) lines)
+let submit log_dest desc cmd output_file =
+  match Worker_pool.submit desc cmd output_file with
+  | Ok x ->
+      maybe_log log_dest x;
+      String.split_on_char '\n' x.output
+  | Error exn -> raise exn

src/driver/compile.ml

@@ -213,20 +213,20 @@ let link : compiled list -> _ =
  fun compiled ->
   let link : compiled -> linked =
    fun c ->
-    let link input_file output_file =
+    let link input_file output_file enable_warnings =
       let libs = Odoc_unit.Pkg_args.compiled_libs c.pkg_args in
       let pages = Odoc_unit.Pkg_args.compiled_pages c.pkg_args in
       let includes = c.include_dirs in
       Odoc.link ~input_file ~output_file ~includes ~libs ~docs:pages
-        ?current_package:c.pkgname ()
+        ~ignore_output:(not enable_warnings) ?current_package:c.pkgname ()
     in
     match c.kind with
     | `Intf { hidden = true; _ } ->
         Logs.debug (fun m -> m "not linking %a" Fpath.pp c.odoc_file);
         c
     | _ ->
         Logs.debug (fun m -> m "linking %a" Fpath.pp c.odoc_file);
-        link c.odoc_file c.odocl_file;
+        link c.odoc_file c.odocl_file c.enable_warnings;
         (match c.kind with
         | `Intf _ -> Atomic.incr Stats.stats.linked_units
         | `Mld -> Atomic.incr Stats.stats.linked_mlds

src/driver/dune_style.ml

@@ -35,9 +35,7 @@ let of_dune_describe txt =
 let dune_describe dir =
   let cmd = Cmd.(!dune % "describe" % "--root" % p dir) in
   let out = Worker_pool.submit "dune describe" cmd None in
-  match out with
-  | Error _ -> []
-  | Ok out -> of_dune_describe (String.concat "\n" out)
+  match out with Error _ -> [] | Ok out -> of_dune_describe out.Run.output
 
 let of_dune_build dir =
   let contents =
@@ -124,6 +122,7 @@ let of_dune_build dir =
                       assets =
                         []
                         (* When dune has a notion of doc assets, do something *);
+                      enable_warnings = false;
                       pkg_dir;
                       other_docs = Fpath.Set.empty;
                       config = Global_config.empty;

src/driver/landing_pages.ml

@@ -18,6 +18,7 @@ let make_index ~dirs ~rel_dir ?index ~content () =
     odoc_file;
     odocl_file;
     include_dirs = Fpath.Set.empty;
+    enable_warnings = false;
     kind = `Mld;
     index;
   }

src/driver/ocamlfind.ml

@@ -77,7 +77,8 @@ let rec dep =
 let deps pkgs =
   let results = List.map dep pkgs in
   Ok
-    (List.fold_left Util.StringSet.union Util.StringSet.empty
+    (List.fold_left Util.StringSet.union
+       (Util.StringSet.singleton "stdlib")
        (List.map (Result.value ~default:Util.StringSet.empty) results))
 
 module Db = struct

src/driver/ocamlobjinfo.ml

@@ -26,7 +26,7 @@ let get_source file srcdirs =
   in
   let lines =
     match lines_res with
-    | Ok l -> l
+    | Ok l -> String.split_on_char '\n' l.output
     | Error e ->
         Logs.err (fun m ->
             m "Error finding source for module %a: %s" Fpath.pp file

src/driver/odoc.ml

@@ -25,7 +25,7 @@ let odoc = ref (Cmd.v "odoc")
 let compile_deps f =
   let cmd = Cmd.(!odoc % "compile-deps" % Fpath.to_string f) in
   let desc = Printf.sprintf "Compile deps for %s" (Fpath.to_string f) in
-  let deps = Cmd_outputs.submit desc cmd None in
+  let deps = Cmd_outputs.submit None desc cmd None in
   let l = List.filter_map (Astring.String.cut ~sep:" ") deps in
   let basename = Fpath.(basename (f |> rem_ext)) |> String.capitalize_ascii in
   match List.partition (fun (n, _) -> basename = n) l with
@@ -49,9 +49,10 @@ let compile ~output_dir ~input_file:file ~includes ~parent_id =
   in
   let cmd = cmd % "--parent-id" % Id.to_string parent_id in
   let desc = Printf.sprintf "Compiling %s" (Fpath.to_string file) in
-  let lines = Cmd_outputs.submit desc cmd output_file in
-  Cmd_outputs.(
-    add_prefixed_output cmd compile_output (Fpath.to_string file) lines)
+  ignore
+  @@ Cmd_outputs.submit
+       (Some (`Compile, Fpath.to_string file))
+       desc cmd output_file
 
 let compile_asset ~output_dir ~name ~parent_id =
   let open Cmd in
@@ -65,8 +66,7 @@ let compile_asset ~output_dir ~name ~parent_id =
 
   let cmd = cmd % "--parent-id" % Id.to_string parent_id in
   let desc = Printf.sprintf "Compiling %s" name in
-  let lines = Cmd_outputs.submit desc cmd output_file in
-  Cmd_outputs.(add_prefixed_output cmd compile_output name lines)
+  ignore @@ Cmd_outputs.submit (Some (`Compile, name)) desc cmd output_file
 
 let compile_impl ~output_dir ~input_file:file ~includes ~parent_id ~source_id =
   let open Cmd in
@@ -91,9 +91,10 @@ let compile_impl ~output_dir ~input_file:file ~includes ~parent_id ~source_id =
   let desc =
     Printf.sprintf "Compiling implementation %s" (Fpath.to_string file)
   in
-  let lines = Cmd_outputs.submit desc cmd output_file in
-  Cmd_outputs.(
-    add_prefixed_output cmd compile_output (Fpath.to_string file) lines)
+  ignore
+  @@ Cmd_outputs.submit
+       (Some (`Compile, Fpath.to_string file))
+       desc cmd output_file
 
 let doc_args docs =
   let open Cmd in
@@ -137,11 +138,10 @@ let link ?(ignore_output = false) ~input_file:file ?output_file ~includes ~docs
     if Fpath.to_string file = "stdlib.odoc" then cmd % "--open=\"\"" else cmd
   in
   let desc = Printf.sprintf "Linking %s" (Fpath.to_string file) in
-
-  let lines = Cmd_outputs.submit desc cmd (Some output_file) in
-  if not ignore_output then
-    Cmd_outputs.(
-      add_prefixed_output cmd link_output (Fpath.to_string file) lines)
+  let log =
+    if ignore_output then None else Some (`Link, Fpath.to_string file)
+  in
+  ignore @@ Cmd_outputs.submit log desc cmd (Some output_file)
 
 let compile_index ?(ignore_output = false) ~output_file ?occurrence_file ~json
     ~docs ~libs () =
@@ -161,10 +161,10 @@ let compile_index ?(ignore_output = false) ~output_file ?occurrence_file ~json
   let desc =
     Printf.sprintf "Generating index for %s" (Fpath.to_string output_file)
   in
-  let lines = Cmd_outputs.submit desc cmd (Some output_file) in
-  if not ignore_output then
-    Cmd_outputs.(
-      add_prefixed_output cmd index_output (Fpath.to_string output_file) lines)
+  let log =
+    if ignore_output then None else Some (`Index, Fpath.to_string output_file)
+  in
+  ignore @@ Cmd_outputs.submit log desc cmd (Some output_file)
 
 let html_generate ~output_dir ?index ?(ignore_output = false)
     ?(search_uris = []) ?(as_json = false) ~input_file:file () =
@@ -182,10 +182,10 @@ let html_generate ~output_dir ?index ?(ignore_output = false)
   in
   let cmd = if as_json then cmd % "--as-json" else cmd in
   let desc = Printf.sprintf "Generating HTML for %s" (Fpath.to_string file) in
-  let lines = Cmd_outputs.submit desc cmd None in
-  if not ignore_output then
-    Cmd_outputs.(
-      add_prefixed_output cmd generate_output (Fpath.to_string file) lines)
+  let log =
+    if ignore_output then None else Some (`Generate, Fpath.to_string file)
+  in
+  ignore @@ Cmd_outputs.submit log desc cmd None
 
 let html_generate_asset ~output_dir ?(ignore_output = false) ~input_file:file
     ~asset_path () =
@@ -195,10 +195,10 @@ let html_generate_asset ~output_dir ?(ignore_output = false) ~input_file:file
     % p asset_path
   in
   let desc = Printf.sprintf "Copying asset %s" (Fpath.to_string file) in
-  let lines = Cmd_outputs.submit desc cmd None in
-  if not ignore_output then
-    Cmd_outputs.(
-      add_prefixed_output cmd generate_output (Fpath.to_string file) lines)
+  let log =
+    if ignore_output then None else Some (`Generate, Fpath.to_string file)
+  in
+  ignore @@ Cmd_outputs.submit log desc cmd None
 
 let html_generate_source ~output_dir ?(ignore_output = false) ~source
     ?(search_uris = []) ?(as_json = false) ~input_file:file () =
@@ -216,26 +216,25 @@ let html_generate_source ~output_dir ?(ignore_output = false) ~source
   let cmd = if as_json then cmd % "--as-json" else cmd in
 
   let desc = Printf.sprintf "Generating HTML for %s" (Fpath.to_string source) in
-  let lines = Cmd_outputs.submit desc cmd None in
-  if not ignore_output then
-    Cmd_outputs.(
-      add_prefixed_output cmd generate_output (Fpath.to_string source) lines)
+  let log =
+    if ignore_output then None else Some (`Generate, Fpath.to_string source)
+  in
+  ignore @@ Cmd_outputs.submit log desc cmd None
 
 let support_files path =
   let open Cmd in
   let cmd = !odoc % "support-files" % "-o" % Fpath.to_string path in
   let desc = "Generating support files" in
-  Cmd_outputs.submit desc cmd None
+  Cmd_outputs.submit None desc cmd None
 
 let count_occurrences ~input ~output =
   let open Cmd in
   let input = Cmd.of_values Fpath.to_string input in
   let output_c = v "-o" % p output in
   let cmd = !odoc % "count-occurrences" %% input %% output_c in
   let desc = "Counting occurrences" in
-  let lines = Cmd_outputs.submit desc cmd None in
-  Cmd_outputs.(
-    add_prefixed_output cmd generate_output (Fpath.to_string output) lines)
+  let log = Some (`Count_occurrences, Fpath.to_string output) in
+  ignore @@ Cmd_outputs.submit log desc cmd None
 
 let source_tree ?(ignore_output = false) ~parent ~output file =
   let open Cmd in
@@ -244,19 +243,22 @@ let source_tree ?(ignore_output = false) ~parent ~output file =
     !odoc % "source-tree" % "-I" % "." %% parent % "-o" % p output % p file
   in
   let desc = Printf.sprintf "Source tree for %s" (Fpath.to_string file) in
-  let lines = Cmd_outputs.submit desc cmd None in
-  if not ignore_output then
-    Cmd_outputs.(
-      add_prefixed_output cmd source_tree_output (Fpath.to_string file) lines)
+  let log =
+    if ignore_output then None else Some (`Source_tree, Fpath.to_string file)
+  in
+  ignore @@ Cmd_outputs.submit log desc cmd None
 
 let classify dirs =
   let open Cmd in
   let cmd = List.fold_left (fun cmd d -> cmd % p d) (!odoc % "classify") dirs in
   let desc =
     Format.asprintf "Classifying [%a]" (Fmt.(list ~sep:sp) Fpath.pp) dirs
   in
+  let log =
+    Some (`Classify, String.concat "," (List.map Fpath.to_string dirs))
+  in
   let lines =
-    Cmd_outputs.submit desc cmd None |> List.filter (fun l -> l <> "")
+    Cmd_outputs.submit log desc cmd None |> List.filter (fun l -> l <> "")
   in
   List.map
     (fun line ->

src/driver/odoc_driver.ml

@@ -667,17 +667,36 @@ let run mode
       (fun () -> render_stats env nb_workers)
   in
 
-  let grep_log l s =
+  let grep_log ty 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
+      let grep (dst, _err, prefix, content) =
+        if dst = ty then
+          let lines = String.cuts ~sep:"\n" content in
+          List.iter
+            (fun l ->
+              if String.is_infix ~affix l then Format.printf "%s: %s\n" prefix l)
+            lines
+      in
+      List.iter grep !Cmd_outputs.outputs
     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;
+  grep_log `Compile compile_grep;
+  grep_log `Link link_grep;
+  grep_log `Generate generate_grep;
+
+  List.iter
+    (fun (dst, _err, prefix, content) ->
+      match dst with
+      | `Link ->
+          if String.length content = 0 then ()
+          else
+            let lines = String.split_on_char '\n' content in
+            List.iter (fun l -> Format.printf "%s: %s\n" prefix l) lines
+      | _ -> ())
+    !Cmd_outputs.outputs;
+
   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

src/driver/odoc_unit.ml

@@ -58,6 +58,7 @@ type 'a unit = {
   pkgname : string option;
   include_dirs : Fpath.Set.t;
   index : index option;
+  enable_warnings : bool;
   kind : 'a;
 }
 

src/driver/odoc_unit.mli

@@ -33,6 +33,7 @@ type 'a unit = {
   pkgname : string option;
   include_dirs : Fpath.Set.t;
   index : index option;
+  enable_warnings : bool;
   kind : 'a;
 }