add time_limit_secs option, return partial results when out of time

Summary:
This diff adds a `time_limit_secs` option to `hh --find-my-tests-staging`. When reaching the time limit, we return whatever tests we selected up to that point. The JSON output of the command is changed so that instead of just returning a list, we return an object now with a boolean field `out_of_time`, indicating whether we hit the time limit.

Note that I'm avoiding the term `timeout` since `hh_client` already has its own, orthogonal timeout mechanism where the client cancels if not getting a response from the server before the timeout. But what I'm doing here is different, since my time limits are enforced by the server, not the client.

Implementation notes: On the server side, we check the current time against a deadline value in every iteration of our test BFS graph construction. There is only one exception: `FindRefsService.find_references` can take arbitrarily long, because it may need to type-check thousands of files. Therefore, I added an optional `deadline` parameter to it. There was already a cancelation mechanism within `FindRefsService`, the new `deadline` is re-using that.

Reviewed By: madgen

Differential Revision: D94660244

fbshipit-source-id: 8d46036bc8c434f6e53e901576062d49b1295af2

Author: frank-emrich

hphp/hack/src/client/clientCheck.ml

@@ -42,14 +42,25 @@ let print_refs (results : SearchTypes.Find_refs.absolute list) ~(json : bool) :
   else
     FindRefsWireFormat.CliHumanReadable.print_results results
 
-let print_find_my_tests_result result ~(json : bool) : unit =
+let print_find_my_tests_result_v1 result ~(json : bool) : unit =
   let module FMT = ServerCommandTypes.Find_my_tests in
   if json then
-    let result_json = `List (List.map result ~f:FMT.yojson_of_result_entry) in
+    let result_json =
+      `List (List.map result ~f:FMT.yojson_of_selected_test_file)
+    in
     print_endline (Yojson.Safe.pretty_to_string result_json)
   else
     List.iter result ~f:(fun file -> print_endline file.FMT.file_path)
 
+let print_find_my_tests_result result ~(json : bool) : unit =
+  let module FMT = ServerCommandTypes.Find_my_tests in
+  if json then
+    let result_json = FMT.yojson_of_result_data result in
+    print_endline (Yojson.Safe.pretty_to_string result_json)
+  else
+    List.iter result.FMT.selected_test_files ~f:(fun file ->
+        print_endline file.FMT.file_path)
+
 let parse_name_or_member_id ~name_only_action ~name_and_member_action name =
   let pieces = Str.split (Str.regexp "::") name in
   let default_namespace str =
@@ -1046,7 +1057,7 @@ let main_internal
     in
     (match result with
     | Ok fmt_result ->
-      print_find_my_tests_result fmt_result ~json:args.output_json;
+      print_find_my_tests_result_v1 fmt_result ~json:args.output_json;
       Lwt.return (Exit_status.No_error, telemtry)
     | Error error ->
       Printf.eprintf "%s\n" error;

hphp/hack/src/client_and_server/findRefsService.ml

@@ -255,10 +255,18 @@ let fold_one_tast ctx target acc symbol =
   | (IGConst cst_name, SO.GConst) -> process_gconst_id cst_name (pos, name)
   | _ -> Pos.Map.empty
 
-let should_cancel ~stream_file =
-  match stream_file with
-  | None -> false
-  | Some stream_file -> not (Path.file_exists stream_file)
+let should_cancel ~stream_file ~deadline =
+  let streaming_file_gone =
+    match stream_file with
+    | None -> false
+    | Some stream_file -> not (Path.file_exists stream_file)
+  in
+  let past_deadline =
+    match deadline with
+    | None -> false
+    | Some d -> Float.(Unix.gettimeofday () >= d)
+  in
+  streaming_file_gone || past_deadline
 
 module Iter = struct
   exception Cancelled
@@ -285,10 +293,10 @@ module Iter = struct
     }
 
   (** We'll check a few times a second whether we should cancel. *)
-  let raise_if_should_cancel acc ~t_now ~stream_file =
+  let raise_if_should_cancel acc ~t_now ~stream_file ~deadline =
     let last_cancellation_check =
       if Float.(t_now > acc.last_cancellation_check +. 0.2) then begin
-        if should_cancel ~stream_file then raise Cancelled;
+        if should_cancel ~stream_file ~deadline then raise Cancelled;
         t_now
       end else
         acc.last_cancellation_check
@@ -347,6 +355,7 @@ let find_refs
     (files : Relative_path.t list)
     ~(omit_declaration : bool)
     ~(stream_file : Path.t option)
+    ~(deadline : float option)
     ~(t_start : float) : (SearchTypes.Find_refs.t list, unit) Result.t =
   (* The helper function 'results_from_tast' takes a tast, looks at all
      use-sites in the tast e.g. "foo(1)" is a use-site of symbol foo,
@@ -406,7 +415,9 @@ let find_refs
         let acc =
           List.fold files ~init:(Iter.init ()) ~f:(fun acc path ->
               let t_now = Unix.gettimeofday () in
-              let acc = Iter.raise_if_should_cancel ~stream_file ~t_now acc in
+              let acc =
+                Iter.raise_if_should_cancel ~stream_file ~deadline ~t_now acc
+              in
               let per_file = results_from_tast (tast_of_file path) in
               let acc = Iter.{ acc with results = per_file :: acc.results } in
               Iter.stream_file ~per_file ~stream_fd ~t_now ~t_start acc)
@@ -444,10 +455,12 @@ let parallel_find_refs
     ctx
     ~(omit_declaration : bool)
     ~(stream_file : Path.t option)
+    ~(deadline : float option)
     ~(t_start : float) =
   MultiWorker.call
     workers
-    ~job:(find_refs ctx target ~omit_declaration ~stream_file ~t_start)
+    ~job:
+      (find_refs ctx target ~omit_declaration ~stream_file ~deadline ~t_start)
     ~neutral:(Ok [])
     ~merge:(fun output acc ->
       match (output, acc) with
@@ -458,7 +471,7 @@ let parallel_find_refs
        (* We create the "next" function just once, now; it will dole
           out chunks of [files] each time it's asked, below. *)
        fun () ->
-         if should_cancel ~stream_file then
+         if should_cancel ~stream_file ~deadline then
            Bucket.Done
          else
            next ())
@@ -534,7 +547,8 @@ let get_definitions ctx action =
        later time *)
     []
 
-let find_references ctx workers target include_defs files ~stream_file =
+let find_references ctx workers target include_defs files ~deadline ~stream_file
+    =
   let len = List.length files in
   Hh_logger.debug "find_references: %d files" len;
   let t_start = Unix.gettimeofday () in
@@ -549,6 +563,7 @@ let find_references ctx workers target include_defs files ~stream_file =
         files
         ~omit_declaration:true
         ~stream_file
+        ~deadline
         ~t_start
     else
       parallel_find_refs
@@ -558,6 +573,7 @@ let find_references ctx workers target include_defs files ~stream_file =
         ctx
         ~omit_declaration:true
         ~stream_file
+        ~deadline
         ~t_start
   in
   match results with
@@ -588,6 +604,7 @@ let find_references_single_file ctx target file =
       [file]
       ~omit_declaration:false
       ~stream_file:None
+      ~deadline:None
       ~t_start:(Unix.gettimeofday ())
   in
   match results with

hphp/hack/src/client_and_server/findRefsService.mli

@@ -35,6 +35,7 @@ val find_references :
   action_internal ->
   bool ->
   Relative_path.t list ->
+  deadline:float option ->
   stream_file:Path.t option ->
   SearchTypes.Find_refs.t list
 

hphp/hack/src/client_and_server/serverCommandTypes.ml

@@ -170,26 +170,42 @@ module Find_my_tests = struct
 
   type provenance = { root_indices: int list } [@@deriving yojson]
 
-  type result_entry = {
+  type selected_test_file = {
     file_path: string;
     distance: int;
     provenance: provenance option;
   }
   [@@deriving yojson]
 
-  type result = (result_entry list, string) Result.t
+  (* Types only use by v1 *)
 
-  (* Types Used by staging only *)
+  type result_v1 = (selected_test_file list, string) Result.t
+
+  (* Types used by staging only *)
+
+  type result_data = {
+    selected_test_files: selected_test_file list;
+    out_of_time: bool;
+  }
+  [@@deriving yojson]
+
+  type result = (result_data, string) Result.t
 
   type config = {
     max_distance: int; [@default 1]
     max_test_files: int option; [@default None]
     root_provenance: bool; [@default false]
+    time_limit_secs: int option; [@default None]
   }
   [@@deriving yojson]
 
   let default_config =
-    { max_distance = 1; max_test_files = None; root_provenance = false }
+    {
+      max_distance = 1;
+      max_test_files = None;
+      root_provenance = false;
+      time_limit_secs = None;
+    }
 
   type json_input = {
     roots: string list;
@@ -467,7 +483,7 @@ type _ t =
       -> Find_refs.result_or_retry list t
   | FIND_MY_TESTS_V1 :
       (int * int option * Find_my_tests.action list)
-      -> Find_my_tests.result t
+      -> Find_my_tests.result_v1 t
   | FIND_MY_TESTS_STAGING :
       (Find_my_tests.config * Find_my_tests.action list)
       -> Find_my_tests.result t

hphp/hack/src/client_and_server/serverFindRefs.ml

@@ -45,6 +45,7 @@ let search ctx target include_defs ~hints ~files ~stream_file genv =
       target
       include_defs
       files
+      ~deadline:None
       ~stream_file
   in
   strip_ns res