|
|
|
@ -12,7 +12,17 @@
|
|
|
|
|
|
|
|
|
|
open! Utils;
|
|
|
|
|
|
|
|
|
|
let filename = "aggregated_stats.json";
|
|
|
|
|
let aggregated_stats_filename = "aggregated_stats.json";
|
|
|
|
|
|
|
|
|
|
let aggregated_stats_by_target_filename = "aggregated_stats_by_target.json";
|
|
|
|
|
|
|
|
|
|
let json_files_to_ignore_regex = Str.regexp (
|
|
|
|
|
".*\\(" ^
|
|
|
|
|
Str.quote aggregated_stats_filename ^
|
|
|
|
|
"\\|" ^
|
|
|
|
|
Str.quote aggregated_stats_by_target_filename ^
|
|
|
|
|
"\\)$"
|
|
|
|
|
);
|
|
|
|
|
|
|
|
|
|
let dir_exists dir =>
|
|
|
|
|
try (Sys.is_directory dir) {
|
|
|
|
@ -23,7 +33,7 @@ let find_json_files_in_dir dir => {
|
|
|
|
|
let is_valid_json_file path => {
|
|
|
|
|
let s = Unix.lstat path;
|
|
|
|
|
let json_regex = Str.regexp_case_fold ".*\\.json$";
|
|
|
|
|
not (Str.string_match (Str.regexp (".*" ^ Str.quote filename ^ "$")) path 0) &&
|
|
|
|
|
not (Str.string_match json_files_to_ignore_regex path 0) &&
|
|
|
|
|
Str.string_match json_regex path 0 && s.st_kind == Unix.S_REG
|
|
|
|
|
};
|
|
|
|
|
dir_exists dir ?
|
|
|
|
@ -35,21 +45,25 @@ let find_json_files_in_dir dir => {
|
|
|
|
|
[]
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
type stats_paths = {
|
|
|
|
|
frontend_paths: list string,
|
|
|
|
|
backend_paths: list string,
|
|
|
|
|
reporting_paths: list string
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
type origin = | Buck_out of (list (string, stats_paths)) | Infer_out of stats_paths;
|
|
|
|
|
|
|
|
|
|
let find_stats_files_in_dir dir => {
|
|
|
|
|
let frontend_stats_files = find_json_files_in_dir (
|
|
|
|
|
Filename.concat dir Config.frontend_stats_dir_name
|
|
|
|
|
);
|
|
|
|
|
let backend_stats_files = find_json_files_in_dir (
|
|
|
|
|
Filename.concat dir Config.backend_stats_dir_name
|
|
|
|
|
);
|
|
|
|
|
let reporting_stats_files = find_json_files_in_dir (
|
|
|
|
|
let frontend_paths = find_json_files_in_dir (Filename.concat dir Config.frontend_stats_dir_name);
|
|
|
|
|
let backend_paths = find_json_files_in_dir (Filename.concat dir Config.backend_stats_dir_name);
|
|
|
|
|
let reporting_paths = find_json_files_in_dir (
|
|
|
|
|
Filename.concat dir Config.reporting_stats_dir_name
|
|
|
|
|
);
|
|
|
|
|
(frontend_stats_files, backend_stats_files, reporting_stats_files)
|
|
|
|
|
{frontend_paths, backend_paths, reporting_paths}
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
let load_data_from_infer_deps file => {
|
|
|
|
|
let extract_path line =>
|
|
|
|
|
let extract_target_and_path line =>
|
|
|
|
|
switch (Str.split_delim (Str.regexp (Str.quote "\t")) line) {
|
|
|
|
|
| [target, _, path, ..._] =>
|
|
|
|
|
if (dir_exists path) {
|
|
|
|
@ -59,91 +73,141 @@ let load_data_from_infer_deps file => {
|
|
|
|
|
}
|
|
|
|
|
| _ => raise (Failure "malformed input")
|
|
|
|
|
};
|
|
|
|
|
let lines = Option.get (Utils.read_file file);
|
|
|
|
|
try (Ok (IList.map extract_path lines)) {
|
|
|
|
|
let lines = Utils.read_file file;
|
|
|
|
|
try (
|
|
|
|
|
switch lines {
|
|
|
|
|
| Some l => Ok (IList.map extract_target_and_path l)
|
|
|
|
|
| None => raise (Failure ("Error reading '" ^ file ^ "'"))
|
|
|
|
|
}
|
|
|
|
|
) {
|
|
|
|
|
| Failure msg => Error msg
|
|
|
|
|
}
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
let find_all_stats_files () => {
|
|
|
|
|
let accumulate_paths acc paths => {
|
|
|
|
|
let (f, b, r) = acc;
|
|
|
|
|
let (f', b', r') = paths;
|
|
|
|
|
(f @ f', b @ b', r @ r')
|
|
|
|
|
};
|
|
|
|
|
let collect_all_stats_files () => {
|
|
|
|
|
let infer_out = Config.results_dir;
|
|
|
|
|
let concatenate_paths p1 p2 =>
|
|
|
|
|
if (Filename.is_relative p2) {
|
|
|
|
|
Filename.concat p1 p2
|
|
|
|
|
} else {
|
|
|
|
|
p2
|
|
|
|
|
};
|
|
|
|
|
let infer_out = Config.results_dir;
|
|
|
|
|
let result =
|
|
|
|
|
switch Config.buck_out {
|
|
|
|
|
| Some p =>
|
|
|
|
|
if (dir_exists p) {
|
|
|
|
|
let data = load_data_from_infer_deps (
|
|
|
|
|
Filename.concat infer_out Config.buck_infer_deps_file_name
|
|
|
|
|
);
|
|
|
|
|
switch data {
|
|
|
|
|
| Ok r =>
|
|
|
|
|
let paths = IList.map (fun (_, path) => path) r;
|
|
|
|
|
Ok (Filename.concat p Filename.parent_dir_name, paths)
|
|
|
|
|
| Error _ as e => e
|
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
Error ("buck-out path '" ^ p ^ "' not found")
|
|
|
|
|
switch Config.buck_out {
|
|
|
|
|
| Some p =>
|
|
|
|
|
if (dir_exists p) {
|
|
|
|
|
let data = load_data_from_infer_deps (
|
|
|
|
|
Filename.concat infer_out Config.buck_infer_deps_file_name
|
|
|
|
|
);
|
|
|
|
|
switch data {
|
|
|
|
|
| Ok r =>
|
|
|
|
|
let buck_out_parent = Filename.concat p Filename.parent_dir_name;
|
|
|
|
|
let targets_files =
|
|
|
|
|
IList.map
|
|
|
|
|
(fun (t, p) => (t, find_stats_files_in_dir (concatenate_paths buck_out_parent p))) r;
|
|
|
|
|
Ok (Buck_out targets_files)
|
|
|
|
|
| Error _ as e => e
|
|
|
|
|
}
|
|
|
|
|
| None => Ok (infer_out, [infer_out])
|
|
|
|
|
};
|
|
|
|
|
switch result {
|
|
|
|
|
| Ok (base_path, paths_to_explore) =>
|
|
|
|
|
Ok (
|
|
|
|
|
IList.fold_left
|
|
|
|
|
(
|
|
|
|
|
fun acc path =>
|
|
|
|
|
accumulate_paths acc (find_stats_files_in_dir (concatenate_paths base_path path))
|
|
|
|
|
)
|
|
|
|
|
([], [], [])
|
|
|
|
|
paths_to_explore
|
|
|
|
|
)
|
|
|
|
|
| Error _ as e => e
|
|
|
|
|
} else {
|
|
|
|
|
Error ("buck-out path '" ^ p ^ "' not found")
|
|
|
|
|
}
|
|
|
|
|
| None => Ok (Infer_out (find_stats_files_in_dir infer_out))
|
|
|
|
|
}
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
let open_json_file file => Yojson.Basic.from_file file;
|
|
|
|
|
|
|
|
|
|
let write_to_json_file destfile json => {
|
|
|
|
|
let stats_oc = open_out destfile;
|
|
|
|
|
Yojson.Basic.pretty_to_channel stats_oc json;
|
|
|
|
|
close_out stats_oc
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
let aggregate_stats_to_file paths destfile => {
|
|
|
|
|
let aggregate_stats_files paths => {
|
|
|
|
|
let open_json_file file => Yojson.Basic.from_file file;
|
|
|
|
|
let load_stats paths => IList.map (fun path => PerfStats.from_json (open_json_file path)) paths;
|
|
|
|
|
let all_perf_stats = load_stats paths;
|
|
|
|
|
switch all_perf_stats {
|
|
|
|
|
| [] => Printf.eprintf "No stats to aggregate into %s\n" destfile
|
|
|
|
|
| _ =>
|
|
|
|
|
let aggr_stats = PerfStats.aggregate all_perf_stats;
|
|
|
|
|
write_to_json_file destfile aggr_stats
|
|
|
|
|
| [] => None
|
|
|
|
|
| _ => Some (PerfStats.aggregate all_perf_stats)
|
|
|
|
|
}
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
type json_aggregated_stats = {
|
|
|
|
|
frontend_json_data: option Yojson.Basic.json,
|
|
|
|
|
backend_json_data: option Yojson.Basic.json,
|
|
|
|
|
reporting_json_data: option Yojson.Basic.json
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
let aggregate_all_stats origin => {
|
|
|
|
|
let accumulate_paths acc paths => {
|
|
|
|
|
frontend_paths: paths.frontend_paths @ acc.frontend_paths,
|
|
|
|
|
backend_paths: paths.backend_paths @ acc.backend_paths,
|
|
|
|
|
reporting_paths: paths.reporting_paths @ acc.reporting_paths
|
|
|
|
|
};
|
|
|
|
|
let empty_stats_paths = {frontend_paths: [], backend_paths: [], reporting_paths: []};
|
|
|
|
|
let stats_paths =
|
|
|
|
|
switch origin {
|
|
|
|
|
| Buck_out tf =>
|
|
|
|
|
IList.fold_left (fun acc (_, paths) => accumulate_paths acc paths) empty_stats_paths tf
|
|
|
|
|
| Infer_out paths => paths
|
|
|
|
|
};
|
|
|
|
|
{
|
|
|
|
|
frontend_json_data: aggregate_stats_files stats_paths.frontend_paths,
|
|
|
|
|
backend_json_data: aggregate_stats_files stats_paths.backend_paths,
|
|
|
|
|
reporting_json_data: aggregate_stats_files stats_paths.reporting_paths
|
|
|
|
|
}
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
let aggregate_stats_by_target tp => {
|
|
|
|
|
let to_json f aggr_stats => {
|
|
|
|
|
let collect_valid_stats acc t p =>
|
|
|
|
|
switch p {
|
|
|
|
|
| Some v => [(t, v), ...acc]
|
|
|
|
|
| None => acc
|
|
|
|
|
};
|
|
|
|
|
let l = IList.fold_left (fun acc (t, p) => collect_valid_stats acc t (f p)) [] aggr_stats;
|
|
|
|
|
switch l {
|
|
|
|
|
| [] => None
|
|
|
|
|
| _ as v => Some (`Assoc v)
|
|
|
|
|
}
|
|
|
|
|
};
|
|
|
|
|
let frontend_json_data = to_json (fun p => aggregate_stats_files p.frontend_paths) tp;
|
|
|
|
|
let backend_json_data = to_json (fun p => aggregate_stats_files p.backend_paths) tp;
|
|
|
|
|
let reporting_json_data = to_json (fun p => aggregate_stats_files p.reporting_paths) tp;
|
|
|
|
|
{frontend_json_data, backend_json_data, reporting_json_data}
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
let () = {
|
|
|
|
|
let infer_out = Config.results_dir;
|
|
|
|
|
let result = find_all_stats_files ();
|
|
|
|
|
switch result {
|
|
|
|
|
| Ok (f, b, r) =>
|
|
|
|
|
let aggregated_frontend_stats_dir = Filename.concat infer_out Config.frontend_stats_dir_name;
|
|
|
|
|
let aggregated_backend_stats_dir = Filename.concat infer_out Config.backend_stats_dir_name;
|
|
|
|
|
let aggregated_reporting_stats_dir = Filename.concat infer_out Config.reporting_stats_dir_name;
|
|
|
|
|
DB.create_dir aggregated_frontend_stats_dir;
|
|
|
|
|
DB.create_dir aggregated_backend_stats_dir;
|
|
|
|
|
DB.create_dir aggregated_reporting_stats_dir;
|
|
|
|
|
aggregate_stats_to_file f (Filename.concat aggregated_frontend_stats_dir filename);
|
|
|
|
|
aggregate_stats_to_file b (Filename.concat aggregated_backend_stats_dir filename);
|
|
|
|
|
aggregate_stats_to_file r (Filename.concat aggregated_reporting_stats_dir filename)
|
|
|
|
|
| Error msg => failwith msg
|
|
|
|
|
}
|
|
|
|
|
let stats_files = collect_all_stats_files ();
|
|
|
|
|
let origin =
|
|
|
|
|
switch stats_files {
|
|
|
|
|
| Ok origin => origin
|
|
|
|
|
| Error e => failwith e
|
|
|
|
|
};
|
|
|
|
|
let aggregated_frontend_stats_dir = Filename.concat infer_out Config.frontend_stats_dir_name;
|
|
|
|
|
let aggregated_backend_stats_dir = Filename.concat infer_out Config.backend_stats_dir_name;
|
|
|
|
|
let aggregated_reporting_stats_dir = Filename.concat infer_out Config.reporting_stats_dir_name;
|
|
|
|
|
DB.create_dir aggregated_frontend_stats_dir;
|
|
|
|
|
DB.create_dir aggregated_backend_stats_dir;
|
|
|
|
|
DB.create_dir aggregated_reporting_stats_dir;
|
|
|
|
|
let write_to_json_file_opt destfile json =>
|
|
|
|
|
switch json {
|
|
|
|
|
| Some j => Utils.write_json_to_file destfile j
|
|
|
|
|
| None => ()
|
|
|
|
|
};
|
|
|
|
|
switch origin {
|
|
|
|
|
| Buck_out tp =>
|
|
|
|
|
let j = aggregate_stats_by_target tp;
|
|
|
|
|
write_to_json_file_opt
|
|
|
|
|
(Filename.concat aggregated_frontend_stats_dir aggregated_stats_by_target_filename)
|
|
|
|
|
j.frontend_json_data;
|
|
|
|
|
write_to_json_file_opt
|
|
|
|
|
(Filename.concat aggregated_backend_stats_dir aggregated_stats_by_target_filename)
|
|
|
|
|
j.backend_json_data;
|
|
|
|
|
write_to_json_file_opt
|
|
|
|
|
(Filename.concat aggregated_reporting_stats_dir aggregated_stats_by_target_filename)
|
|
|
|
|
j.reporting_json_data
|
|
|
|
|
| Infer_out _ => ()
|
|
|
|
|
};
|
|
|
|
|
let j = aggregate_all_stats origin;
|
|
|
|
|
write_to_json_file_opt
|
|
|
|
|
(Filename.concat aggregated_frontend_stats_dir aggregated_stats_filename) j.frontend_json_data;
|
|
|
|
|
write_to_json_file_opt
|
|
|
|
|
(Filename.concat aggregated_backend_stats_dir aggregated_stats_filename) j.backend_json_data;
|
|
|
|
|
write_to_json_file_opt
|
|
|
|
|
(Filename.concat aggregated_reporting_stats_dir aggregated_stats_filename)
|
|
|
|
|
j.reporting_json_data
|
|
|
|
|
};
|
|
|
|
|