Aggregate buck stats per target

Reviewed By: jberdine

Differential Revision: D3392446

fbshipit-source-id: 4247f0a
master
Martino Luca 9 years ago committed by Facebook Github Bot 2
parent e7b2ec2886
commit b27bf407db

@ -586,3 +586,16 @@ let read_optional_json_file path =
with Sys_error msg | Yojson.Json_error msg ->
Error msg
else Ok (`Assoc [])
let with_file file ~f =
let oc = open_out file in
try
let res = f oc in
close_out oc;
res
with exc ->
close_out oc;
raise exc
let write_json_to_file destfile json =
with_file destfile ~f:(fun oc -> Yojson.Basic.pretty_to_channel oc json)

@ -267,3 +267,5 @@ val string_of_analyzer: analyzer -> string
val analyzer_of_string: string -> analyzer
val read_optional_json_file : string -> (Yojson.Basic.json, string) result
val write_json_to_file : string -> Yojson.Basic.json -> unit

@ -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
};

Loading…
Cancel
Save