Aggregate buck stats per target

Reviewed By: jberdine

Differential Revision: D3392446

fbshipit-source-id: 4247f0a

infer/src/backend/utils.ml

@@ -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)

infer/src/backend/utils.mli

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

infer/src/scripts/StatsAggregator.re

@@ -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 (
+  let frontend_paths = find_json_files_in_dir (Filename.concat dir Config.frontend_stats_dir_name);
-    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 (
-  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 (
     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,26 +73,25 @@ let load_data_from_infer_deps file => {
       }
     | _ => raise (Failure "malformed input")
     };
-  let lines = Option.get (Utils.read_file file);
+  let lines = Utils.read_file file;
-  try (Ok (IList.map extract_path lines)) {
+  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 collect_all_stats_files () => {
-  let accumulate_paths acc paths => {
+  let infer_out = Config.results_dir;
-    let (f, b, r) = acc;
-    let (f', b', r') = paths;
-    (f @ f', b @ b', r @ r')
-  };
   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) {
@@ -87,63 +100,114 @@ let find_all_stats_files () => {
       );
       switch data {
       | Ok r =>
-          let paths = IList.map (fun (_, path) => path) r;
+        let buck_out_parent = Filename.concat p Filename.parent_dir_name;
-          Ok (Filename.concat p Filename.parent_dir_name, paths)
+        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
       }
     } else {
       Error ("buck-out path '" ^ p ^ "' not found")
     }
-    | None => Ok (infer_out, [infer_out])
+  | None => Ok (Infer_out (find_stats_files_in_dir 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
   }
 };
 
+let aggregate_stats_files paths => {
   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 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
+  | [] => None
-  | _ =>
+  | _ => Some (PerfStats.aggregate all_perf_stats)
-    let aggr_stats = PerfStats.aggregate all_perf_stats;
-    write_to_json_file destfile aggr_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 ();
+  let stats_files = collect_all_stats_files ();
-  switch result {
+  let origin =
-  | Ok (f, b, r) =>
+    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;
-    aggregate_stats_to_file f (Filename.concat aggregated_frontend_stats_dir filename);
+  let write_to_json_file_opt destfile json =>
-    aggregate_stats_to_file b (Filename.concat aggregated_backend_stats_dir filename);
+    switch json {
-    aggregate_stats_to_file r (Filename.concat aggregated_reporting_stats_dir filename)
+    | Some j => Utils.write_json_to_file destfile j
-  | Error msg => failwith msg
+    | 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
 };