diff --git a/odoc-driver.opam b/odoc-driver.opam index 546f23397f..e36f3e4572 100644 --- a/odoc-driver.opam +++ b/odoc-driver.opam @@ -46,6 +46,7 @@ depends: [ "cmdliner" "sexplib" "ppx_sexp_conv" + "opam-state" ] build: [ diff --git a/src/driver/cmd_outputs.ml b/src/driver/cmd_outputs.ml index f9d2be4ff0..8fbff16415 100644 --- a/src/driver/cmd_outputs.ml +++ b/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 diff --git a/src/driver/compile.ml b/src/driver/compile.ml index 58013e4c7d..839cface3d 100644 --- a/src/driver/compile.ml +++ b/src/driver/compile.ml @@ -213,12 +213,12 @@ 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; _ } -> @@ -226,7 +226,7 @@ let link : compiled list -> _ = 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 diff --git a/src/driver/db.ml b/src/driver/db.ml new file mode 100644 index 0000000000..0eaae4a8a8 --- /dev/null +++ b/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; +} diff --git a/src/driver/dune b/src/driver/dune index ee90fcce52..c1a3013f2f 100644 --- a/src/driver/dune +++ b/src/driver/dune @@ -17,4 +17,5 @@ logs.fmt eio_main sexplib - odoc_utils)) + odoc_utils + opam-state)) diff --git a/src/driver/dune_style.ml b/src/driver/dune_style.ml index 9241a16a7b..e64c6b0779 100644 --- a/src/driver/dune_style.ml +++ b/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 = @@ -91,6 +89,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 +103,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 = @@ -121,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; diff --git a/src/driver/global_config.ml b/src/driver/global_config.ml index 9dd3bf1a11..1e235f691f 100644 --- a/src/driver/global_config.ml +++ b/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 diff --git a/src/driver/global_config.mli b/src/driver/global_config.mli index eaa1944726..5d11ed96c9 100644 --- a/src/driver/global_config.mli +++ b/src/driver/global_config.mli @@ -5,3 +5,5 @@ type t = { deps : deps } val empty : t val parse : string -> t + +val load : string -> t diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index 52720b6b14..2da462870f 100644 --- a/src/driver/landing_pages.ml +++ b/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; } diff --git a/src/driver/ocamlfind.ml b/src/driver/ocamlfind.ml index a886292b4b..13ae221408 100644 --- a/src/driver/ocamlfind.ml +++ b/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,166 @@ 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.singleton "stdlib") + (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 diff --git a/src/driver/ocamlfind.mli b/src/driver/ocamlfind.mli index b33054e5a5..6a9fead18b 100644 --- a/src/driver/ocamlfind.mli +++ b/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 diff --git a/src/driver/ocamlobjinfo.ml b/src/driver/ocamlobjinfo.ml index 805859de86..82d848214b 100644 --- a/src/driver/ocamlobjinfo.ml +++ b/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 diff --git a/src/driver/odoc.ml b/src/driver/odoc.ml index a36708afd8..ac99f9c0b7 100644 --- a/src/driver/odoc.ml +++ b/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,16 +216,16 @@ 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 @@ -233,9 +233,8 @@ let count_occurrences ~input ~output = 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,10 +243,10 @@ 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 @@ -255,8 +254,11 @@ let classify dirs = 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 -> diff --git a/src/driver/odoc_driver.ml b/src/driver/odoc_driver.ml index 0dd1270e14..aad1666aba 100644 --- a/src/driver/odoc_driver.ml +++ b/src/driver/odoc_driver.ml @@ -554,7 +554,11 @@ let remap_virtual_interfaces duplicate_hashes pkgs = type mode = | Voodoo of { package_name : string; blessed : bool } | Dune of { path : Fpath.t } - | Opam of { packages : string list; packages_dir : Fpath.t option } + | Opam of { + libs : string list; + packages : string list; + packages_dir : Fpath.t option; + } let run mode { @@ -587,13 +591,19 @@ let run mode let extra_libs_paths = Voodoo.extra_libs_paths odoc_dir in (all, extra_libs_paths) | Dune { path } -> (Dune_style.of_dune_build path, Util.StringMap.empty) - | Opam { packages; packages_dir } -> - let libs = if packages = [] then Ocamlfind.all () else packages 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) + | Opam { libs; packages; packages_dir } -> ( + match (libs, packages) with + | [], packages -> + (Packages.of_packages ~packages_dir packages, Util.StringMap.empty) + | 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) + | _, _ -> + failwith + "Please specify either packages (-p) or libraries (-l), not both") in let virtual_check = @@ -657,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 @@ -705,13 +734,19 @@ module Dune_mode = struct end module Opam_mode = struct - let run packages packages_dir = run (Opam { packages; packages_dir }) + let run libs packages packages_dir = + run (Opam { libs; packages; packages_dir }) let packages = (* TODO: Is it package or library? *) - let doc = "The packages to document" in + let doc = "The packages to document (mutually exclusive with -l)" in Arg.(value & opt_all string [] & info [ "p" ] ~doc) + let libs = + (* TODO: Is it package or library? *) + let doc = "The libraries to document (mutually exclusive with -p)" in + Arg.(value & opt_all string [] & info [ "l" ] ~doc) + let packages_dir = let doc = "Packages directory under which packages should be output." in Arg.( @@ -720,9 +755,10 @@ module Opam_mode = struct & info [ "packages-dir" ] ~doc) let cmd = - let doc = "Opam mode" in + let doc = "Documents the packages present in your opam switch." in let info = Cmd.info "opam" ~doc in - Cmd.v info Term.(const run $ packages $ packages_dir $ Common_args.term) + Cmd.v info + Term.(const run $ libs $ packages $ packages_dir $ Common_args.term) end let cmd = diff --git a/src/driver/odoc_unit.ml b/src/driver/odoc_unit.ml index 1ecac835ac..d47d50a7c7 100644 --- a/src/driver/odoc_unit.ml +++ b/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; } diff --git a/src/driver/odoc_unit.mli b/src/driver/odoc_unit.mli index d1a52b8d5a..7f52f10a5e 100644 --- a/src/driver/odoc_unit.mli +++ b/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; } diff --git a/src/driver/odoc_units_of.ml b/src/driver/odoc_units_of.ml index bed60e4f52..0dfcd8e2f9 100644 --- a/src/driver/odoc_units_of.ml +++ b/src/driver/odoc_units_of.ml @@ -35,7 +35,7 @@ let packages ~dirs ~extra_libs_paths (pkgs : Packages.t list) : t list = 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 let base_args pkg lib_deps : Pkg_args.t = @@ -80,8 +80,8 @@ let packages ~dirs ~extra_libs_paths (pkgs : Packages.t list) : t list = { pkg_args; output_file; json = false; search_dir = pkg.pkg_dir } in - let make_unit ~name ~kind ~rel_dir ~input_file ~pkg ~include_dirs ~lib_deps : - _ unit = + let make_unit ~name ~kind ~rel_dir ~input_file ~pkg ~include_dirs ~lib_deps + ~enable_warnings : _ unit = let ( // ) = Fpath.( // ) in let ( / ) = Fpath.( / ) in let pkg_args = args_of pkg lib_deps in @@ -103,6 +103,7 @@ let packages ~dirs ~extra_libs_paths (pkgs : Packages.t list) : t list = odocl_file; include_dirs; kind; + enable_warnings; index = Some (index_of pkg); } in @@ -139,7 +140,7 @@ let packages ~dirs ~extra_libs_paths (pkgs : Packages.t list) : t list = in 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 ~lib_deps + ~include_dirs ~lib_deps ~enable_warnings:pkg.enable_warnings in match Hashtbl.find_opt intf_cache intf.mif_hash with | Some unit -> unit @@ -171,7 +172,7 @@ let packages ~dirs ~extra_libs_paths (pkgs : Packages.t list) : t list = in let unit = make_unit ~name ~kind ~rel_dir ~input_file:impl.mip_path ~pkg - ~include_dirs ~lib_deps + ~include_dirs ~lib_deps ~enable_warnings:pkg.enable_warnings in Some unit in @@ -209,7 +210,7 @@ let packages ~dirs ~extra_libs_paths (pkgs : Packages.t list) : t list = in let unit = make_unit ~name ~kind ~rel_dir ~input_file:mld_path ~pkg ~include_dirs - ~lib_deps + ~lib_deps ~enable_warnings:pkg.enable_warnings in [ unit ] in @@ -224,7 +225,7 @@ let packages ~dirs ~extra_libs_paths (pkgs : Packages.t list) : t list = let unit = let name = asset_path |> Fpath.basename |> ( ^ ) "asset-" in make_unit ~name ~kind ~rel_dir ~input_file:asset_path ~pkg ~include_dirs - ~lib_deps:Util.StringSet.empty + ~lib_deps:Util.StringSet.empty ~enable_warnings:false in [ unit ] in diff --git a/src/driver/opam.ml b/src/driver/opam.ml index 23e43de9a8..1b75246624 100644 --- a/src/driver/opam.ml +++ b/src/driver/opam.ml @@ -30,18 +30,31 @@ let prefix () = prefix := Some p; p -let deps_of_opam_result line = - match Astring.String.fields ~empty:false line with - | [ name; version ] -> [ { name; version } ] - | _ -> [] - -let all_opam_packages () = - Util.lines_of_process - Cmd.( - opam % "list" % "--switch" % get_switch () % "--columns=name,version" - % "--color=never" % "--short") - |> List.map deps_of_opam_result - |> List.flatten +let all_opam_packages = + let result = ref None in + fun () -> + match !result with + | Some pkgs -> pkgs + | None -> ( + let prefix = prefix () in + match + Bos.OS.Dir.contents Fpath.(v prefix / ".opam-switch" / "packages") + with + | Error (`Msg msg) -> + Logs.err (fun m -> m "Error listing opam packages: %s" msg); + [] + | Ok contents -> + let r = + List.filter_map + (fun p -> + let name = Fpath.basename p in + match Astring.String.cut ~sep:"." name with + | Some (name, version) -> Some { name; version } + | None -> None) + contents + in + result := Some r; + r) let pkg_contents { name; _ } = let prefix = Fpath.v (prefix ()) in @@ -83,20 +96,22 @@ let pkg_contents { name; _ } = in List.map Fpath.v added -(* let opam_file { name; version } = *) -(* let prefix = Fpath.v (prefix ()) in *) -(* let opam_file = *) -(* Format.asprintf "%a/.opam-switch/packages/%s.%s/opam" Fpath.pp prefix name *) -(* version *) -(* in *) -(* let ic = open_in opam_file in *) -(* try *) -(* let lines = Util.lines_of_channel ic in *) -(* close_in ic; *) -(* Some lines *) -(* with _ -> *) -(* close_in ic; *) -(* None *) +let deps pkgs = + let cmd = + Cmd.( + opam % "list" % "--recursive" % "-i" % "--columns" % "package" % "--color" + % "never" % "-s" % "--or") + in + let cmd = + List.fold_left (fun cmd pkg -> Cmd.(cmd % "--required-by" % pkg)) cmd pkgs + in + let out = Util.lines_of_process cmd in + List.filter_map + (fun x -> + match Astring.String.cut ~sep:"." x with + | Some (name, version) -> Some { name; version } + | None -> None) + out type installed_files = { libs : Fpath.set; diff --git a/src/driver/opam.mli b/src/driver/opam.mli index 88ca8898cc..a1693b8acd 100644 --- a/src/driver/opam.mli +++ b/src/driver/opam.mli @@ -10,7 +10,9 @@ type package_of_fpath = package Fpath.map (* Here we use an associative list *) type fpaths_of_package = (package * installed_files) list +val all_opam_packages : unit -> package list +val deps : string list -> package list val pkg_to_dir_map : unit -> fpaths_of_package * package_of_fpath val pp : Format.formatter -> package -> unit val prefix : unit -> string diff --git a/src/driver/packages.ml b/src/driver/packages.ml index 85e6261e4e..7437d4eac5 100644 --- a/src/driver/packages.ml +++ b/src/driver/packages.ml @@ -16,6 +16,7 @@ type src_info = { src_path : Fpath.t } let pp_src_info fmt i = Format.fprintf fmt "@[{@,src_path: %a@,}@]" Fpath.pp i.src_path + type impl = { mip_path : Fpath.t; mip_src_info : src_info option; @@ -85,6 +86,7 @@ type t = { libraries : libty list; mlds : mld list; assets : asset list; + enable_warnings : bool; other_docs : Fpath.Set.t; pkg_dir : Fpath.t; config : Global_config.t; @@ -98,11 +100,13 @@ let pp fmt t = libraries: %a;@,\ mlds: %a;@,\ assets: %a;@,\ + enable_warnings: %b;@,\ other_docs: %a;@,\ pkg_dir: %a@,\ }@]" t.name t.version (Fmt.Dump.list pp_libty) t.libraries (Fmt.Dump.list pp_mld) - t.mlds (Fmt.Dump.list pp_asset) t.assets (Fmt.Dump.list Fpath.pp) + t.mlds (Fmt.Dump.list pp_asset) t.assets t.enable_warnings + (Fmt.Dump.list Fpath.pp) (Fpath.Set.elements t.other_docs) Fpath.pp t.pkg_dir @@ -178,7 +182,7 @@ module Module = struct | Some cmt, None -> r (mk_intf cmt, Some (mk_impl cmt)) | None, Some cmti -> r (mk_intf cmti, None) | None, None -> - Logs.warn (fun m -> m "No files for module: %s" m_name); + Logs.info (fun m -> m "No files for module: %s" m_name); None with _ -> Logs.err (fun m -> m "Error processing module %s. Ignoring." m_name); @@ -251,12 +255,9 @@ module Lib = struct dir; } | None -> - Logs.err (fun m -> - m "Error processing library %s: Ignoring." archive_name); - Logs.err (fun m -> - m "Known libraries: [%a]" - Fmt.(list ~sep:sp string) - (Fpath.Map.bindings libname_of_archive |> List.map snd)); + Logs.info (fun m -> + m "Unable to determine library of archive %s: Ignoring." + archive_name); None) results @@ -268,226 +269,231 @@ module Lib = struct t.modules end -let of_libs ~packages_dir libs = - let libs = Util.StringSet.to_seq libs |> List.of_seq in - let results = List.map (fun x -> (x, Ocamlfind.deps [ x ])) libs in - let all_libs_set = - List.fold_left - (fun acc (lib, r) -> - match r with - | Ok x -> Util.StringSet.(union (of_list x) acc) - | Error (`Msg e) -> - Logs.err (fun m -> - m "Error finding dependencies of libraries [%s]: %s" lib e); - Logs.err (fun m -> m "Will attempt to document the library anyway"); - Util.StringSet.add lib acc) - Util.StringSet.empty results +(* Construct the list of mlds and assets from a package name and its list of pages *) +let mk_mlds pkg_name odoc_pages = + let odig_convention asset_path = + let asset_prefix = + Fpath.(v (Opam.prefix ()) / "doc" / pkg_name / "odoc-assets") + in + let rel_path = Fpath.rem_prefix asset_prefix asset_path in + match rel_path with + | None -> [] + | Some rel_path -> + [ { asset_path; asset_rel_path = Fpath.(v "_assets" // rel_path) } ] + in + let prefix = Fpath.(v (Opam.prefix ()) / "doc" / pkg_name / "odoc-pages") in + let mlds, assets = + Fpath.Set.fold + (fun path (mld_acc, asset_acc) -> + let rel_path = Fpath.rem_prefix prefix path in + match rel_path with + | None -> (mld_acc, odig_convention path @ asset_acc) + | Some rel_path -> + if Fpath.has_ext "mld" path then + ( { mld_path = path; mld_rel_path = rel_path } :: mld_acc, + asset_acc ) + else + ( mld_acc, + { asset_path = path; asset_rel_path = rel_path } :: asset_acc )) + odoc_pages ([], []) in - let all_libs = Util.StringSet.elements all_libs_set in - let all_libs = "stdlib" :: all_libs in - - let all_lib_deps = - List.fold_right - (fun lib_name acc -> - match Ocamlfind.deps [ lib_name ] with - | Ok deps -> - Util.StringMap.add lib_name (Util.StringSet.of_list 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 + (mlds, assets) + +let fix_missing_deps pkgs = + let lib_name_by_hash = + Util.StringMap.fold + (fun _pkg_name pkg acc -> + List.fold_left + (fun acc lib -> + List.fold_left + (fun acc m -> + Util.StringMap.update m.m_intf.mif_hash + (function + | None -> Some [ lib.lib_name ] + | Some l -> Some (lib.lib_name :: l)) + acc) + acc lib.modules) + acc pkg.libraries) + pkgs Util.StringMap.empty in + Util.StringMap.map + (fun pkg -> + let libraries = + List.map + (fun lib -> + let lib_deps = lib.lib_deps in + let new_lib_deps = + List.fold_left + (fun acc m -> + let if_deps = + Util.StringSet.of_list (List.map snd m.m_intf.mif_deps) + in + let impl_deps = + match m.m_impl with + | Some i -> Util.StringSet.of_list (List.map snd i.mip_deps) + | None -> Util.StringSet.empty + in + let deps = Util.StringSet.union if_deps impl_deps in + Util.StringSet.fold + (fun hash acc -> + match Util.StringMap.find hash lib_name_by_hash with + | exception Not_found -> acc + | deps -> + if + List.mem lib.lib_name deps + || List.exists + (fun d -> Util.StringSet.mem d lib_deps) + deps + then acc + else Util.StringSet.add (List.hd deps) acc) + deps acc) + Util.StringSet.empty lib.modules + in + if Util.StringSet.cardinal new_lib_deps > 0 then + Logs.debug (fun m -> + m "Adding missing deps to %s: %a" lib.lib_name + Fmt.(list string) + (Util.StringSet.elements new_lib_deps)); + { lib with lib_deps = Util.StringSet.union new_lib_deps lib_deps }) + pkg.libraries + in + { pkg with libraries }) + pkgs - Logs.debug (fun m -> - m "Libraries to document: [%a]" Fmt.(list ~sep:sp string) all_libs); +let of_libs ~packages_dir libs = + let Ocamlfind.Db. + { archives_by_dir; libname_of_archive; cmi_only_libs; all_lib_deps; _ } + = + Ocamlfind.Db.create libs + in - let lib_dirs_and_archives = - List.filter_map - (fun lib -> - match Ocamlfind.get_dir lib with - | Error _ -> - Logs.debug (fun m -> m "No dir for library %s" lib); - None - | Ok p -> - let archives = Ocamlfind.archives lib in - Logs.debug (fun m -> - m "Archives for library %s: [%a]" lib - Fmt.(list ~sep:sp string) - archives); - 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 + (* Opam gives us a map of packages to directories, and vice-versa *) + let opam_map, opam_rmap = Opam.pkg_to_dir_map () in + + (* Now we can construct the packages *) + let packages = + Fpath.Map.fold + (fun dir archives acc -> + match Fpath.Map.find dir opam_rmap with + | None -> + Logs.debug (fun m -> m "No package for dir %a\n%!" Fpath.pp dir); + acc + | Some pkg -> + let libraries = + Lib.v ~libname_of_archive ~pkg_name:pkg.name ~dir ~cmtidir:None + ~all_lib_deps ~cmi_only_libs + in + let libraries = + List.filter + (fun l -> + match l.archive_name with + | None -> true + | Some a -> Util.StringSet.mem a archives) + libraries in - let archives = Util.StringSet.(of_list archives) in - Some (lib, p, archives)) - all_libs + Util.StringMap.update pkg.name + (function + | Some pkg -> + let libraries = libraries @ pkg.libraries in + Some { pkg with libraries } + | None -> + let pkg_dir = pkg_dir packages_dir pkg.name in + let config = Global_config.load pkg.name in + let pkg', { Opam.odoc_pages; other_docs; _ } = + List.find + (fun (pkg', _) -> + (* Logs.debug (fun m -> + m "Checking %s against %s" pkg.Opam.name pkg'.Opam.name); *) + pkg = pkg') + opam_map + in + let mlds, assets = mk_mlds pkg'.name odoc_pages in + Logs.debug (fun m -> + m "%d mlds for package %s (from %d odoc_pages)" + (List.length mlds) pkg.name + (Fpath.Set.cardinal odoc_pages)); + Some + { + name = pkg.name; + version = pkg.version; + libraries; + mlds; + assets; + enable_warnings = false; + other_docs; + pkg_dir; + config; + }) + acc) + archives_by_dir Util.StringMap.empty in + fix_missing_deps packages - let map, rmap = - (* if Sys.file_exists ".pkg_to_dir_map" then ( - let ic = open_in_bin ".pkg_to_dir_map" in - let result = Marshal.from_channel ic in - close_in ic; - result) - else *) - let result = Opam.pkg_to_dir_map () in - (* let oc = open_out_bin ".pkg_to_dir_map" in - Marshal.to_channel oc result []; - close_out oc; *) - result +let of_packages ~packages_dir packages = + let deps = + if packages = [] then Opam.all_opam_packages () else Opam.deps packages in - 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 + let Ocamlfind.Db.{ libname_of_archive; cmi_only_libs; all_lib_deps; _ } = + Ocamlfind.Db.create (Ocamlfind.all () |> Util.StringSet.of_list) in - 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.err (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 + let opam_map, _opam_rmap = Opam.pkg_to_dir_map () in + + let ps = + List.filter_map + (fun pkg -> List.find_opt (fun (pkg', _) -> pkg = pkg') opam_map) + deps in - 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 + + let orig = + List.filter_map + (fun pkg -> + List.find_opt (fun (pkg', _) -> pkg = pkg'.Opam.name) opam_map) + packages in - Logs.debug (fun m -> - m "cmi_only_libs: %a" - Fmt.(list ~sep:sp string) - (List.map snd cmi_only_libs)); + let all = orig @ ps in - ignore libname_of_archive; - let mk_mlds pkg_name odoc_pages = - let odig_convention asset_path = - let asset_prefix = - Fpath.(v (Opam.prefix ()) / "doc" / pkg_name / "odoc-assets") - in - let rel_path = Fpath.rem_prefix asset_prefix asset_path in - match rel_path with - | None -> [] - | Some rel_path -> - [ { asset_path; asset_rel_path = Fpath.(v "_assets" // rel_path) } ] - in - let prefix = Fpath.(v (Opam.prefix ()) / "doc" / pkg_name / "odoc-pages") in - let mlds, assets = - Fpath.Set.fold - (fun path (mld_acc, asset_acc) -> - let rel_path = Fpath.rem_prefix prefix path in - match rel_path with - | None -> (mld_acc, odig_convention path @ asset_acc) - | Some rel_path -> - if Fpath.has_ext "mld" path then - ( { mld_path = path; mld_rel_path = rel_path } :: mld_acc, - asset_acc ) - else - ( mld_acc, - { asset_path = path; asset_rel_path = rel_path } :: asset_acc - )) - odoc_pages ([], []) - in - (mlds, assets) - in - let global_config (pkg_name : string) = - let config_file = - Fpath.(v (Opam.prefix ()) / "doc" / pkg_name / "odoc-config.sexp") - in - match Bos.OS.File.read config_file with - | Error _ -> Global_config.empty - | Ok s -> Global_config.parse s + let packages = + List.fold_left + (fun acc (pkg, files) -> + let libraries = + List.fold_left + (fun acc dir -> + Lib.v ~libname_of_archive ~pkg_name:pkg.Opam.name ~dir + ~cmtidir:None ~all_lib_deps ~cmi_only_libs + @ acc) + [] + (files.Opam.libs |> Fpath.Set.to_list) + in + let pkg_dir = pkg_dir packages_dir pkg.name in + let config = Global_config.load pkg.name in + let odoc_pages = files.Opam.odoc_pages in + let other_docs = files.Opam.other_docs in + let mlds, assets = mk_mlds pkg.name odoc_pages in + Logs.debug (fun m -> + m "%d mlds for package %s (from %d odoc_pages)" (List.length mlds) + pkg.name + (Fpath.Set.cardinal odoc_pages)); + let enable_warnings = List.mem pkg.name packages in + Util.StringMap.add pkg.name + { + name = pkg.name; + version = pkg.version; + libraries; + mlds; + assets; + enable_warnings; + other_docs; + pkg_dir; + config; + } + acc) + Util.StringMap.empty all in - Fpath.Map.fold - (fun dir archives acc -> - match Fpath.Map.find dir rmap with - | None -> - Logs.debug (fun m -> m "No package for dir %a\n%!" Fpath.pp dir); - acc - | Some pkg -> - let libraries = - Lib.v ~libname_of_archive ~pkg_name:pkg.name ~dir ~cmtidir:None - ~all_lib_deps ~cmi_only_libs - in - let libraries = - List.filter - (fun l -> - match l.archive_name with - | None -> true - | Some a -> Util.StringSet.mem a archives) - libraries - in - Util.StringMap.update pkg.name - (function - | Some pkg -> - let libraries = libraries @ pkg.libraries in - Some { pkg with libraries } - | None -> - let pkg_dir = pkg_dir packages_dir pkg.name in - let config = global_config pkg.name in - let pkg', { Opam.odoc_pages; other_docs; _ } = - List.find - (fun (pkg', _) -> - (* Logs.debug (fun m -> - m "Checking %s against %s" pkg.Opam.name pkg'.Opam.name); *) - pkg = pkg') - map - in - let mlds, assets = mk_mlds pkg'.name odoc_pages in - Logs.debug (fun m -> - m "%d mlds for package %s (from %d odoc_pages)" - (List.length mlds) pkg.name - (Fpath.Set.cardinal odoc_pages)); - Some - { - name = pkg.name; - version = pkg.version; - libraries; - mlds; - assets; - other_docs; - pkg_dir; - config; - }) - acc) - archives_by_dir Util.StringMap.empty + fix_missing_deps packages + +(* Now we can construct the packages *) type set = t Util.StringMap.t diff --git a/src/driver/packages.mli b/src/driver/packages.mli index 1eab48640a..c2ecea87a2 100644 --- a/src/driver/packages.mli +++ b/src/driver/packages.mli @@ -73,6 +73,7 @@ type t = { libraries : libty list; mlds : mld list; assets : asset list; + enable_warnings : bool; other_docs : Fpath.Set.t; pkg_dir : Fpath.t; config : Global_config.t; @@ -84,3 +85,5 @@ type set = t Util.StringMap.t val of_libs : packages_dir:Fpath.t option -> Util.StringSet.t -> set (** Turns a set of libraries into a map from package name to package *) + +val of_packages : packages_dir:Fpath.t option -> string list -> set diff --git a/src/driver/run.ml b/src/driver/run.ml index 680b933e85..ea1c13a26d 100644 --- a/src/driver/run.ml +++ b/src/driver/run.ml @@ -9,10 +9,11 @@ let instrument_dir = OS.Dir.create dir |> Result.get_ok |> ignore; dir) -type executed_command = { +type t = { cmd : string list; time : float; (** Running time in seconds. *) output_file : Fpath.t option; + output : string; errors : string; } @@ -42,7 +43,7 @@ let run env cmd output_file = |> Array.of_list in (* Logs.debug (fun m -> m "Running cmd %a" Fmt.(list ~sep:sp string) cmd); *) - let r, errors = + let output, errors = Eio.Switch.run ~name:"Process.parse_out" @@ fun sw -> let r, w = Eio.Process.pipe proc_mgr ~sw in let re, we = Eio.Process.pipe proc_mgr ~sw in @@ -77,10 +78,10 @@ let run env cmd output_file = (* Logs.debug (fun m -> m "Finished running cmd %a" Fmt.(list ~sep:sp string) cmd); *) let t_end = Unix.gettimeofday () in - let r = String.split_on_char '\n' r in let time = t_end -. t_start in - commands := { cmd; time; output_file; errors } :: !commands; - r + let result = { cmd; time; output_file; output; errors } in + commands := result :: !commands; + result (** Print an executed command and its time. *) diff --git a/src/driver/sherlodoc.ml b/src/driver/sherlodoc.ml index 306f8fc07d..d6af28cf32 100644 --- a/src/driver/sherlodoc.ml +++ b/src/driver/sherlodoc.ml @@ -30,12 +30,13 @@ let index ?(ignore_output = false) ~format ~inputs ~dst ?favored_prefixes () = Cmd.( sherlodoc % "index" %% format %% favored_prefixes %% inputs % "-o" % p dst) in - let lines = submit desc cmd (Some dst) in - if not ignore_output then - add_prefixed_output cmd link_output (Fpath.to_string dst) lines + let log = + if ignore_output then None else Some (`Sherlodoc, Fpath.to_string dst) + in + ignore @@ submit log desc cmd (Some dst) let js dst = let cmd = Cmd.(sherlodoc % "js" % p dst) in let desc = Printf.sprintf "Sherlodoc js at %s" (Fpath.to_string dst) in - let _lines = submit desc cmd (Some dst) in + let _lines = submit None desc cmd (Some dst) in () diff --git a/src/driver/voodoo.ml b/src/driver/voodoo.ml index 15b5926b29..2253dc83ed 100644 --- a/src/driver/voodoo.ml +++ b/src/driver/voodoo.ml @@ -208,6 +208,7 @@ let process_package pkg = libraries; mlds; assets; + enable_warnings = false; other_docs = Fpath.Set.empty; pkg_dir = top_dir pkg; config; diff --git a/src/driver/worker_pool.ml b/src/driver/worker_pool.ml index 7bdc1dbfc8..ed5b2bbb56 100644 --- a/src/driver/worker_pool.ml +++ b/src/driver/worker_pool.ml @@ -7,7 +7,7 @@ type request = { output_file : Fpath.t option; } -type response = (string list, exn) result +type response = (Run.t, exn) result type resolver = response Eio.Promise.u type t = (request * resolver) Eio.Stream.t diff --git a/src/driver/worker_pool.mli b/src/driver/worker_pool.mli index 72faba4674..08dec9b3b8 100644 --- a/src/driver/worker_pool.mli +++ b/src/driver/worker_pool.mli @@ -1,4 +1,4 @@ -val submit : string -> Bos.Cmd.t -> Fpath.t option -> (string list, exn) result +val submit : string -> Bos.Cmd.t -> Fpath.t option -> (Run.t, exn) result (** Submit a command to be executed by a worker. [submit desc cmd output_file] returns the list of output lines. [desc] is a