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_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..f2c3d6ddf2 100644 --- a/src/driver/odoc_driver.ml +++ b/src/driver/odoc_driver.ml @@ -1,445 +1,5 @@ (* Odoc driver *) -(* Output hierarchy: - - //doc/ - //lib//Module/index.html - //src/... -*) - -(* open Bos - let ( >>= ) = Result.bind - let ( >>|= ) m f = m >>= fun x -> Ok (f x) - let get_ok = function Ok x -> x | Error (`Msg m) -> failwith m - let relativize p = Fpath.(v ".." // p) *) -(* -(* this driver is run from the [doc] dir *) - -let dep_libraries_core = - [ - "odoc-parser"; - "astring"; - "cmdliner"; - "fpath"; - "result"; - "tyxml"; - "fmt"; - "stdlib"; - "yojson"; - ] - -let extra_deps = - [ - "base"; - "base_bigstring"; - "base_quickcheck"; - "bin_prot"; - "camlp-streams"; - "core"; - "fieldslib"; - "int_repr"; - "ocaml-compiler-libs"; - "parsexp"; - "ppx_bench.runtime-lib"; - "ppx_compare"; - "ppx_enumerate"; - "ppx_expect"; - "ppx_expect.collector"; - "ppx_expect.common"; - "ppx_expect.config"; - "ppx_expect.config_types"; - "ppx_expect.evaluator"; - "ppx_expect.make_corrected_file"; - "ppx_expect.matcher"; - "ppx_expect.payload"; - "ppx_hash"; - "ppx_inline_test.config"; - "ppx_inline_test.runtime-lib"; - "ppx_module_timer"; - "ppx_sexp_conv"; - "ppx_stable_witness"; - "ppx_stable_witness.runtime"; - "ppx_stable_witness.stable_witness"; - "ppxlib"; - "ppxlib.ast"; - "ppxlib.astlib"; - "ppxlib.traverse_builtins"; - "sexplib"; - "sexplib0"; - "splittable_random"; - "stdio"; - "typerep"; - "variantslib"; - ] - -let dep_libraries = - match Sys.getenv_opt "ODOC_BENCHMARK" with - | Some "true" -> dep_libraries_core @ extra_deps - | _ -> dep_libraries_core - -let odoc_libraries = - [ - "odoc_xref_test"; - "odoc_xref2"; - "odoc_odoc"; - "odoc_html_support_files"; - "odoc_model_desc"; - "odoc_model"; - "odoc_manpage"; - "odoc_loader"; - "odoc_latex"; - "odoc_html"; - "odoc_document"; - "odoc_examples"; - "odoc_parser"; - "ocamlary"; - "odoc_search"; - "odoc_html_frontend"; - "odoc_json_index"; - "syntax_highlighter"; - "type_desc_to_yojson"; - ] *) - -(* let all_libraries = dep_libraries @ odoc_libraries *) - -(* let extra_docs = - [ - "interface"; - "driver"; - "parent_child_spec"; - "features"; - "odoc_for_authors"; - "dune"; - "ocamldoc_differences"; - "api_reference"; - ] *) - -(* let parents = - let add_parent p l = List.map (fun lib -> (lib, p)) l in - add_parent "deps" dep_libraries @ add_parent "odoc" odoc_libraries - - let ocamlfind = Cmd.v "ocamlfind" - - let reach t ~from = - let rec loop t from = - match (t, from) with - | a :: t, b :: from when a = b -> loop t from - | _ -> List.fold_right (fun _ acc -> ".." :: acc) from t - in - let v s = String.split_on_char '/' s in - loop (v t) (v from) |> String.concat "/" - - let relativize_path = - let pwd = Sys.getcwd () in - fun p -> reach p ~from:pwd - - let lib_path env lib = - let cmd = Cmd.(ocamlfind % "query" % lib) in - Run.run env cmd |> List.hd |> relativize_path - - let _lib_paths env = - List.fold_right (fun lib acc -> (lib, lib_path env lib) :: acc) dep_libraries [] - - let _find_units p = - OS.Dir.fold_contents ~dotfiles:true - (fun p acc -> - if List.exists (fun ext -> Fpath.has_ext ext p) [ "cmt"; "cmti"; "cmi" ] - then p :: acc - else acc) - [] (Fpath.v p) - >>|= fun paths -> - let l = List.map Fpath.rem_ext paths in - let l = - List.filter - (fun f -> - not @@ Astring.String.is_infix ~affix:"ocamldoc" (Fpath.to_string f)) - l - in - List.fold_right Fpath.Set.add l Fpath.Set.empty - - let _best_file base = - List.map (fun ext -> Fpath.add_ext ext base) [ "cmti"; "cmt"; "cmi" ] - |> List.find (fun f -> Bos.OS.File.exists f |> get_ok) - - let _is_hidden path = Astring.String.is_infix ~affix:"__" (Fpath.to_string path) - - type unit = { - file : Fpath.t; - ignore_output : bool; - source : Fpath.t option; - assets : string list; - } - - (* let odoc_source_tree = Fpath.v "srctree-source.odoc" *) - - let _source_dir_of_odoc_lib lib = - match String.split_on_char '_' lib with - | "odoc" :: s -> - let libname = Fpath.(v (String.concat "_" s)) in - Some Fpath.(v "src" // libname) - | _ -> None *) - -(* let source_files_of_odoc_module lib module_ = - let filename = - let module_ = - match Astring.String.cut ~rev:true ~sep:"__" module_ with - | None -> module_ - | Some (_, "") -> module_ - | Some (_, module_) -> module_ - in - (* ML.ml should not be renamed *) - if String.for_all (fun c -> Char.equal (Char.uppercase_ascii c) c) module_ - then module_ - else String.uncapitalize_ascii module_ - in - match source_dir_of_odoc_lib lib with - | None -> None - | Some relpath -> - let add_filename path ext = - Fpath.( / ) path filename |> Fpath.add_ext ext - in - let find_by_extension path exts = - exts - |> List.map (fun ext -> add_filename path ext) - |> List.find_opt (fun f -> Bos.OS.File.exists (relativize f) |> get_ok) - in - find_by_extension relpath [ "pp.ml"; "ml"; "ml-gen" ] *) - -(* let compile_source_tree env units = - let sources = - List.filter_map - (fun (_, _, _, file) -> Option.map Fpath.to_string file) - units - in - let source_map = Fpath.v "source.map" in - let () = Bos.OS.File.write_lines source_map sources |> get_ok in - let () = - Odoc.source_tree env ~parent:"odoc" ~output:odoc_source_tree source_map - in - { file = odoc_source_tree; ignore_output = false; source = None; assets = [] } *) - -(* let odoc_units () = - let odoc_all_unit_paths = find_units ".." |> get_ok in - List.map - (fun lib -> - Fpath.Set.fold - (fun p acc -> - if Astring.String.is_infix ~affix:lib (Fpath.to_string p) then - let impl = - let module_ = Fpath.basename p in - source_files_of_odoc_module lib module_ - in - ("odoc", lib, p, impl) :: acc - else acc) - odoc_all_unit_paths []) - odoc_libraries *) - -(* let all_units () = - let lib_units = - List.map - (fun (lib, p) -> - Fpath.Set.fold - (fun p acc -> ("deps", lib, p, None) :: acc) - (find_units p |> get_ok) - []) - lib_paths - in - odoc_units () @ lib_units |> List.flatten *) - -(* let update_api_reference_page () = - let libs = - List.sort String.compare odoc_libraries |> List.map String.capitalize_ascii - in - OS.File.with_oc - (Fpath.v "api_reference.mld") - (fun oc () -> - let pf = Printf.fprintf in - pf oc "{0 API Reference}\n\n"; - List.iter (pf oc "- {!%s}\n") libs; - Ok ()) - () - |> get_ok |> get_ok - - let search_file = "index.js" *) -(* - let compile_mlds env all_units = - update_api_reference_page (); - let mkpage x = "page-\"" ^ x ^ "\"" in - let mkmod x = "module-" ^ String.capitalize_ascii x in - let mkmld x = - let f = Fpath.(add_ext "mld" (v x)) in - if not (Bos.OS.File.exists f |> get_ok) then - Bos.OS.File.write_lines f [ Printf.sprintf "{0 %s}" x ] |> get_ok; - f - in - ignore - (Odoc.compile env (mkmld "odoc") - ("srctree-source" :: "page-deps" - :: List.map mkpage (odoc_libraries @ extra_docs))); - ignore - (Odoc.compile env (mkmld "deps") ~parent:"odoc" (List.map mkpage dep_libraries)); - let extra_odocs = - List.map - (fun p -> - ignore (Odoc.compile env (mkmld p) ~parent:"odoc" []); - "page-" ^ p ^ ".odoc") - extra_docs - in - let odocs = - List.map - (fun library -> - let parent = List.assoc library parents in - let children = - List.filter_map - (fun (_, lib, child, _) -> - if lib = library then Some (Fpath.basename child |> mkmod) - else None) - all_units - in - ignore - (Odoc.compile env (mkmld ("library_mlds/" ^ library)) ~parent children); - "page-" ^ library ^ ".odoc") - all_libraries - in - { - file = Fpath.v "page-odoc.odoc"; - ignore_output = false; - source = None; - assets = []; - } - :: List.map - (fun f -> - { file = Fpath.v f; ignore_output = false; source = None; assets = [] }) - (("page-deps.odoc" :: odocs) @ extra_odocs) - - let _compile_all env all_units = - let mld_odocs = compile_mlds env all_units in - let source_tree = compile_source_tree env all_units in - let compile_src file ~ignore_output source_args () = - match source_args with - | None -> () - | Some source_name -> - Odoc.compile_src env (Fpath.set_ext "cmt" file) ~source_name ~ignore_output - ~source_parent_file:odoc_source_tree () - in - let rec rec_compile ?impl parent lib file = - let output = Fpath.(base (set_ext "odoc" file)) in - if OS.File.exists output |> get_ok then [] - else - let deps = Odoc.compile_deps env file |> get_ok in - ignore deps.digest; - let files = - List.fold_left - (fun acc (dep_name, _digest) -> - match - List.find_opt - (fun (_, _, f, _) -> - Fpath.basename f |> String.capitalize_ascii = dep_name) - all_units - with - | None -> acc - | Some (parent, lib, dep_path, impl) -> - let file = best_file dep_path in - rec_compile ?impl parent lib file @ acc) - [] deps.deps - in - let ignore_output = parent = "deps" in - compile_src file impl ~ignore_output (); - Odoc.compile env file ~parent:lib ~ignore_output []; - { file = output; ignore_output; source = impl; assets = [] } :: files - in - source_tree - :: List.fold_left - (fun acc (parent, lib, dep, impl) -> - acc @ rec_compile ?impl parent lib (best_file dep)) - [] all_units - @ mld_odocs *) - -(* let src_file file = - let fdir, fname = Fpath.split_base file in - let fname = Fpath.v ("src-" ^ Fpath.to_string fname) in - Fpath.( // ) fdir fname - let _link_all env odoc_files = - List.map - (fun ({ file = odoc_file; ignore_output; source; _ } as unit) -> - if Option.is_some source then - ignore (Odoc.link env ~ignore_output (src_file odoc_file)); - ignore (Odoc.link env ~ignore_output odoc_file); - { unit with file = Fpath.set_ext "odocl" odoc_file }) - odoc_files - - let _generate_all env odocl_files = - let search_uris = [ Fpath.v "minisearch.js"; Fpath.v "index.js" ] in - List.iter - (fun { file; ignore_output = _; source; assets } -> - ignore (Odoc.html_generate env ~assets ~search_uris file None); - match source with - | None -> () - | Some source -> - ignore (Odoc.html_generate env (src_file file) (Some (relativize source)))) - odocl_files; - Odoc.support_files env *) - -(* let index_generate ?(ignore_output = false) () = - let open Cmd in - let files = - OS.Dir.contents (Fpath.v ".") - |> get_ok - |> List.filter (Fpath.has_ext "odocl") - |> List.filter (fun p -> - String.starts_with ~prefix:"src-" (Fpath.filename p)) - |> List.filter (fun p -> not (is_hidden p)) - |> List.map Fpath.to_string - in - let index_map = Fpath.v "index.map" in - let () = Bos.OS.File.write_lines index_map files |> get_ok in - let cmd = - Odoc.odoc % "compile-index" % "-o" % "html/index.json" % "--file-list" - % p index_map - in - let lines = Run.run cmd in - if not ignore_output then - Odoc.add_prefixed_output cmd Odoc.generate_output "index compilation" lines *) - -(* let _js_index () = - let index = Bos.OS.File.read Fpath.(v "html" / "index.json") |> get_ok in - Bos.OS.File.writef (Fpath.v search_file) - {| - let documents = - %s - ; - - let miniSearch = new MiniSearch({ - fields: ['id', 'doc', 'entry_id'], // fields to index for full-text search - storeFields: ['display'], // fields to return with search results - idField: 'entry_id', - extractField: (document, fieldName) => { - if (fieldName === 'id') { - return document.id.map(e => e.kind + "-" + e.name).join('.') - } - return document[fieldName] - } - }) - - - // Use a unique id since some entries' id are not unique (type extension or - // standalone doc comments for instance) - documents.forEach((entry,i) => entry.entry_id = i) - miniSearch.addAll(documents); - - onmessage = (m) => { - let query = m.data; - let result = miniSearch.search(query); - postMessage(result.slice(0,200).map(a => a.display)); - } - |} - index - |> get_ok; - Bos.OS.Cmd.run Bos.Cmd.(v "cp" % search_file % "html/") |> get_ok; - Bos.OS.Cmd.run Bos.Cmd.(v "cp" % "minisearch.js" % "html/") |> get_ok *) - -open Cmdliner - let render_stats env nprocs = let if_app f = match Logs.level () with Some (App | Warning) | None -> f () | _ -> () @@ -554,7 +114,8 @@ 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 } + | OpamLibs of { libs : string list } + | OpamPackages of { packages : string list } let run mode { @@ -587,13 +148,11 @@ 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) + | OpamLibs { libs } -> + ( Packages.of_libs ~packages_dir:None (Util.StringSet.of_list libs), + Util.StringMap.empty ) + | OpamPackages { packages } -> + (Packages.of_packages ~packages_dir:None packages, Util.StringMap.empty) in let virtual_check = @@ -657,21 +216,42 @@ 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 +open Cmdliner + module Voodoo_mode = struct let run package_name blessed = run (Voodoo { package_name; blessed }) @@ -704,50 +284,51 @@ module Dune_mode = struct Cmd.v info Term.(const run $ dune_style $ Common_args.term) end -module Opam_mode = struct - let run packages packages_dir = run (Opam { packages; packages_dir }) +module OpamLibs = struct + let run libs = run (OpamLibs { libs }) + + let libs = + (* TODO: Is it package or library? *) + let doc = "The libraries to document" in + Arg.(value & opt_all string [] & info [ "l" ] ~doc) + + let cmd_term = Term.(const run $ libs $ Common_args.term) + + let cmd = + let doc = + "Documents libraries present in your opam switch. This mode will select \n\ + \ all libraries that are dependent on the selected \ + libraries. This is a\n\ + \ narrower set of dependencies than those chosen by \ + invoking 'opam' mode." + in + let info = Cmd.info "opam-lib" ~doc in + Cmd.v info cmd_term +end + +module OpamPackages = struct + let run packages = run (OpamPackages { packages }) let packages = (* TODO: Is it package or library? *) let doc = "The packages to document" in Arg.(value & opt_all string [] & info [ "p" ] ~doc) - let packages_dir = - let doc = "Packages directory under which packages should be output." in - Arg.( - value - & opt (some Common_args.fpath_arg) None - & info [ "packages-dir" ] ~doc) + let cmd_term = Term.(const run $ packages $ Common_args.term) let cmd = - let doc = "Opam mode" in + let doc = + "Documents packages present in your opam switch. This mode will select \ + all opam packages that are dependencies of the selected packages." + in let info = Cmd.info "opam" ~doc in - Cmd.v info Term.(const run $ packages $ packages_dir $ Common_args.term) + Cmd.v info cmd_term end let cmd = let doc = "Generate odoc documentation" in let info = Cmd.info "odoc_driver" ~doc in - Cmd.group info [ Voodoo_mode.cmd; Dune_mode.cmd; Opam_mode.cmd ] - -(* let map = Ocamlfind.package_to_dir_map () in - let _dirs = List.map (fun lib -> List.assoc lib map) deps in - - - let (_, lib_to_pkg_map) = Opam.pkg_to_dir_map () in - Opam.StringMap.iter (fun k v -> - if k <> v.Opam.name then - Format.printf "%s -> %a\n" k Opam.pp v) lib_to_pkg_map; - List.iter (fun dep -> Format.printf "%s\n%!" dep) deps; - ignore (exit 0); *) -(* let all_units = all_units () in - let compiled = compile_all all_units in - let linked = link_all compiled in - let () = index_generate () in - (* let _ = js_index () in *) - ignore js_index; - let _ = Odoc.count_occurrences (Fpath.v "occurrences-from-odoc.odoc") in - ignore (generate_all linked); - let _ = Stats.bench_results () in *) + Cmd.group info + [ Voodoo_mode.cmd; Dune_mode.cmd; OpamPackages.cmd; OpamLibs.cmd ] let _ = exit (Cmd.eval 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..accaae63ba 100644 --- a/src/driver/opam.ml +++ b/src/driver/opam.ml @@ -1,47 +1,46 @@ open Bos let opam = Cmd.v "opam" -let switch = ref None -let prefix = ref None type package = { name : string; version : string } let pp fmt p = Format.fprintf fmt "%s.%s" p.name p.version -let rec get_switch () = - match !switch with - | None -> - let cur_switch = - Util.lines_of_process Cmd.(opam % "switch" % "show") |> List.hd - in - switch := Some cur_switch; - get_switch () - | Some s -> s - -let prefix () = - match !prefix with - | Some p -> p - | None -> - let p = - Util.lines_of_process - Cmd.(opam % "var" % "--switch" % get_switch () % "prefix") - |> List.hd - in - 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 () = +let memoize f = + let r = ref None in + fun () -> + match !r with + | Some x -> x + | None -> + let x = f () in + r := Some x; + x + +let get_switch = + memoize @@ fun () -> + Util.lines_of_process Cmd.(opam % "switch" % "show") |> List.hd + +let prefix = + memoize @@ fun () -> Util.lines_of_process - Cmd.( - opam % "list" % "--switch" % get_switch () % "--columns=name,version" - % "--color=never" % "--short") - |> List.map deps_of_opam_result - |> List.flatten + Cmd.(opam % "var" % "--switch" % get_switch () % "prefix") + |> List.hd + +let all_opam_packages = + memoize @@ fun () -> + 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 -> + 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 let pkg_contents { name; _ } = let prefix = Fpath.v (prefix ()) in @@ -83,77 +82,186 @@ 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 *) - -type installed_files = { - libs : Fpath.set; - odoc_pages : Fpath.set; - other_docs : Fpath.set; +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 doc_file = { + kind : [ `Mld | `Asset | `Other ]; + file : Fpath.t; + rel_path : Fpath.t; } +let pp_doc_file fmt { kind; file; rel_path } = + Format.fprintf fmt "kind: %a@,file: %a@,rel_path: %a@," + (Fmt.of_to_string (function + | `Mld -> "`Mld" + | `Asset -> "`Asset" + | `Other -> "`Other")) + kind Fpath.pp file Fpath.pp rel_path + +type installed_files = { libs : Fpath.set; docs : doc_file list } + type package_of_fpath = package Fpath.map (* Here we use an associative list *) type fpaths_of_package = (package * installed_files) list +let pp_fpath_set fmt set = + Fpath.Set.iter (Format.fprintf fmt "%a@." Fpath.pp) set + +let pp_fpaths_of_package fmt l = + List.iter + (fun (p, { libs; docs }) -> + Format.fprintf fmt "%a:@,libs: %a@,docs: %a@," pp p pp_fpath_set libs + Fmt.Dump.(list pp_doc_file) + docs) + l + +let classify_contents prefix only_package contents = + let pkg_match pkg = + match only_package with None -> true | Some p -> p = pkg + in + + let libs = + List.fold_left + (fun set fpath -> + match Fpath.segs fpath with + | "lib" :: "stublibs" :: _ -> set + | "lib" :: pkg :: _ :: _ + when Fpath.has_ext ".cmi" fpath && pkg_match pkg -> + Fpath.Set.add Fpath.(prefix // fpath |> split_base |> fst) set + | _ -> set) + Fpath.Set.empty contents + in + + let is_dir f = + try Sys.is_directory (Fpath.to_string f) with Sys_error _ -> false + in + + let docs = + List.fold_left + (fun acc fpath -> + match Fpath.segs fpath with + | "doc" :: pkg :: "odoc-pages" :: _ :: _ + when pkg_match pkg && not (is_dir Fpath.(prefix // fpath)) -> + Logs.debug (fun m -> m "Found odoc page: %a" Fpath.pp fpath); + let kind = + match Fpath.get_ext fpath with ".mld" -> `Mld | _ -> `Asset + in + let rel_path = + Fpath.rem_prefix Fpath.(v "doc" / pkg / "odoc-pages") fpath + |> Option.get + in + { kind; file = Fpath.(prefix // fpath); rel_path } :: acc + | "doc" :: pkg :: "odoc-assets" :: _ :: _ + when pkg_match pkg && not (is_dir Fpath.(prefix // fpath)) -> + Logs.debug (fun m -> m "Found odoc page: %a" Fpath.pp fpath); + let rel_path = + Fpath.rem_prefix Fpath.(v "doc" / pkg / "odoc-assets") fpath + |> Option.get + in + let rel_path = Fpath.(v "_assets" // rel_path) in + { kind = `Asset; file = Fpath.(prefix // fpath); rel_path } :: acc + | [ "doc"; pkg; _ ] + when pkg_match pkg && not (is_dir Fpath.(prefix // fpath)) -> + Logs.debug (fun m -> m "Found other doc: %a" Fpath.pp fpath); + let rel_path = Fpath.base fpath in + { kind = `Other; file = Fpath.(prefix // fpath); rel_path } :: acc + | _ -> acc) + [] contents + in + (libs, docs) + +let dune_overrides () = + let ocamlpath = Sys.getenv_opt "OCAMLPATH" in + match ocamlpath with + | None -> [] + | Some path -> ( + (* OCAMLPATH is set in dune to be e.g. /Users/jon/odoc/_build/install/default/lib *) + (* Let's strip the 'lib' off and we can find the installed files *) + let path = Fpath.v path in + match Fpath.segs path |> List.rev with + | "lib" :: _ :: "install" :: "_build" :: _ -> ( + (* Check it's of the right form *) + let base = Fpath.split_base path |> fst in + let contents = + Bos.OS.Dir.fold_contents + (fun x acc -> + match Fpath.relativize ~root:base x with + | None -> acc + | Some r -> r :: acc) + [] base + in + match contents with + | Ok contents -> + Logs.debug (fun m -> + m "dune install contents: %a" + Fmt.(Dump.list Fpath.pp) + contents); + let packages = + List.fold_left + (fun acc fpath -> + match Fpath.segs fpath with + | "lib" :: pkg :: _ :: _ -> Util.StringSet.add pkg acc + | "doc" :: pkg :: _ :: _ -> Util.StringSet.add pkg acc + | _ -> acc) + Util.StringSet.empty contents + in + + Logs.debug (fun m -> + m "Found packages: %a" + Fmt.(Dump.list string) + (Util.StringSet.elements packages)); + Util.StringSet.fold + (fun pkg acc -> + let libs, docs = classify_contents base (Some pkg) contents in + Logs.debug (fun m -> + m "pkg %s Found %d docs" pkg (List.length docs)); + ({ name = pkg; version = "dev" }, { libs; docs }) :: acc) + packages [] + | Error (`Msg msg) -> + Logs.err (fun m -> + m "Error listing dune install directory: %s" msg); + []) + | _ -> []) + let pkg_to_dir_map () = + let dune_overrides = dune_overrides () in let pkgs = all_opam_packages () in let prefix = prefix () in let pkg_content = List.map (fun p -> let contents = pkg_contents p in - let libs = - List.fold_left - (fun set fpath -> - match Fpath.segs fpath with - | "lib" :: "stublibs" :: _ -> set - | "lib" :: _ :: _ :: _ when Fpath.has_ext ".cmi" fpath -> - Fpath.Set.add - Fpath.(v prefix // fpath |> split_base |> fst) - set - | _ -> set) - Fpath.Set.empty contents - in - let odoc_pages, other_docs = - List.fold_left - (fun (odoc_pages, others) fpath -> - match Fpath.segs fpath with - | "doc" :: _pkg :: "odoc-pages" :: _ -> - Logs.debug (fun m -> m "Found odoc page: %a" Fpath.pp fpath); - - (Fpath.Set.add Fpath.(v prefix // fpath) odoc_pages, others) - | "doc" :: _pkg :: "odoc-assets" :: _ -> - Logs.debug (fun m -> m "Found odoc page: %a" Fpath.pp fpath); - - (Fpath.Set.add Fpath.(v prefix // fpath) odoc_pages, others) - | "doc" :: _ -> - Logs.debug (fun m -> m "Found other doc: %a" Fpath.pp fpath); - (odoc_pages, Fpath.Set.add Fpath.(v prefix // fpath) others) - | _ -> (odoc_pages, others)) - Fpath.Set.(empty, empty) - contents - in - Logs.debug (fun m -> - m "Found %d odoc pages, %d other docs" - (Fpath.Set.cardinal odoc_pages) - (Fpath.Set.cardinal other_docs)); - (p, { libs; odoc_pages; other_docs })) + let libs, docs = classify_contents (Fpath.v prefix) None contents in + (p, { libs; docs })) pkgs in + + (* Remove anything from opam that is present in the dune overrides *) + let pkg_content = + List.filter + (fun (p, _) -> + not @@ List.exists (fun (p', _) -> p.name = p'.name) dune_overrides) + pkg_content + in + + let pkg_content = pkg_content @ dune_overrides in + let map = List.fold_left (fun map (p, { libs; _ }) -> @@ -171,4 +279,5 @@ let pkg_to_dir_map () = libs map) Fpath.Map.empty pkg_content in + Logs.debug (fun m -> m "pkg_to_dir_map: %a" pp_fpaths_of_package pkg_content); (pkg_content, map) diff --git a/src/driver/opam.mli b/src/driver/opam.mli index 88ca8898cc..86cf177e9f 100644 --- a/src/driver/opam.mli +++ b/src/driver/opam.mli @@ -1,16 +1,20 @@ type package = { name : string; version : string } -type installed_files = { - libs : Fpath.set; - odoc_pages : Fpath.set; - other_docs : Fpath.set; +type doc_file = { + kind : [ `Mld | `Asset | `Other ]; + file : Fpath.t; + rel_path : Fpath.t; } +type installed_files = { libs : Fpath.set; docs : doc_file list } + 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..cb7a84209a 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,229 @@ 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 = +(* Construct the list of mlds and assets from a package name and its list of pages *) +let mk_mlds docs = + let mlds, assets = 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 + (fun (mlds, assets) doc -> + match doc.Opam.kind with + | `Mld -> + ( { mld_path = doc.Opam.file; mld_rel_path = doc.Opam.rel_path } + :: mlds, + assets ) + | `Asset -> + ( mlds, + { asset_path = doc.Opam.file; asset_rel_path = doc.Opam.rel_path } + :: assets ) + | `Other -> (mlds, assets)) + ([], []) docs 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 archives = Util.StringSet.(of_list archives) in - Some (lib, p, archives)) - all_libs + 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.load pkg.name in + let _, { Opam.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 docs in + let other_docs = + List.filter_map + (function + | { Opam.kind = `Other; file; _ } -> Some file + | _ -> None) + docs + |> Fpath.Set.of_list + in + 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 - 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 - in + let opam_map, _opam_rmap = Opam.pkg_to_dir_map () in - Logs.debug (fun m -> - m "cmi_only_libs: %a" - Fmt.(list ~sep:sp string) - (List.map snd cmi_only_libs)); - - 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) + let ps = + List.filter_map + (fun pkg -> List.find_opt (fun (pkg', _) -> pkg = pkg') opam_map) + deps 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 orig = + List.filter_map + (fun pkg -> + List.find_opt (fun (pkg', _) -> pkg = pkg'.Opam.name) opam_map) + packages 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 + + let all = orig @ ps in + + 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 mlds, assets = mk_mlds files.docs in + let other_docs = + List.filter_map (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 + | { Opam.kind = `Other; file; _ } -> Some file | _ -> None) + files.docs + |> Fpath.Set.of_list + in + + 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 + let result = fix_missing_deps packages in + Logs.debug (fun m -> + m "ZZZZ Result: %a" + Fmt.(Dump.list (pair string pp)) + (Util.StringMap.bindings result)); + result 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