make Watchman.transform_asynchronous_get_changes_response return a re…

…sult

Summary:
this stack converts all of the functions in watchman.ml to return results instead of throwing exceptions, so that we can ensure we handle all the error cases.

during the transition, we will call `raise_error` to maintain exception behavior, but eventually thread the `result` further and further up and eliminate `try/with`'s.

Reviewed By: nmote

Differential Revision: D28173780

fbshipit-source-id: cc679f26f9ca24834e0f3555bb133e8a7dad6378

src/hack_forked/test/watchman/watchman_unit_test.ml

@@ -18,12 +18,12 @@ let parse_state_enter_response () =
   }"
   in
   let json = Hh_json.json_of_string ~strict:true json in
-  let%lwt (_, response) =
+  let%lwt response =
     let%lwt env = Watchman.Testing.get_test_env () in
     Lwt.return (Watchman.Testing.transform_asynchronous_get_changes_response env json)
   in
   match response with
-  | Watchman.State_enter ("mystate", _) -> Lwt.return true
+  | Ok (_, Watchman.State_enter ("mystate", _)) -> Lwt.return true
   | _ -> Lwt.return false
 
 let parse_state_leave_response () =
@@ -39,12 +39,12 @@ let parse_state_leave_response () =
   }"
   in
   let json = Hh_json.json_of_string ~strict:true json in
-  let%lwt (_, response) =
+  let%lwt response =
     let%lwt env = Watchman.Testing.get_test_env () in
     Lwt.return (Watchman.Testing.transform_asynchronous_get_changes_response env json)
   in
   match response with
-  | Watchman.State_leave ("mystate", _) -> Lwt.return true
+  | Ok (_, Watchman.State_leave ("mystate", _)) -> Lwt.return true
   | _ -> Lwt.return false
 
 let tests =

src/hack_forked/watchman/watchman.ml

@@ -32,6 +32,8 @@ type error_severity =
       response: string;
       msg: string;
     }
+  | Fresh_instance
+  | Subscription_canceled
 
 let log_error ?request ?response msg =
   let response = Option.map ~f:(String_utils.truncate 100000) response in
@@ -50,6 +52,12 @@ let raise_error = function
   | Response_error { request; response; msg } ->
     let () = log_error ?request ~response msg in
     raise (Watchman_error msg)
+  | Fresh_instance ->
+    Hh_logger.log "Watchman server is fresh instance. Exiting.";
+    raise Exit.(Exit_with Watchman_fresh_instance)
+  | Subscription_canceled ->
+    EventLogger.watchman_error "Subscription canceled by watchman";
+    raise Subscription_canceled_by_watchman
 
 type subscribe_mode =
   | All_changes
@@ -802,12 +810,12 @@ let extract_mergebase data =
 
 let make_mergebase_changed_response env data =
   match extract_mergebase data with
-  | None -> Error "Failed to extract mergebase"
+  | None -> None
   | Some (clock, mergebase) ->
     let files = extract_file_names env data in
     env.clockspec <- clock;
     let response = Changed_merge_base (mergebase, files, clock) in
-    Ok (env, response)
+    Some (env, response)
 
 let subscription_is_cancelled data =
   match Jget.bool_opt (Some data) "canceled" with
@@ -818,22 +826,20 @@ let subscription_is_cancelled data =
 
 let transform_asynchronous_get_changes_response env data =
   match make_mergebase_changed_response env data with
-  | Ok (env, response) -> (env, response)
-  | Error _ ->
-    if is_fresh_instance data then (
-      Hh_logger.log "Watchman server is fresh instance. Exiting.";
-      raise Exit.(Exit_with Watchman_fresh_instance)
-    ) else if subscription_is_cancelled data then (
-      EventLogger.watchman_error "Subscription canceled by watchman";
-      raise Subscription_canceled_by_watchman
-    ) else (
+  | Some (env, response) -> Ok (env, response)
+  | None ->
+    if is_fresh_instance data then
+      Error Fresh_instance
+    else if subscription_is_cancelled data then
+      Error Subscription_canceled
+    else (
       env.clockspec <- Jget.string_exn (Some data) "clock";
       match Jget.string_opt (Some data) "state-enter" with
-      | Some state -> (env, make_state_change_response `Enter state data)
+      | Some state -> Ok (env, make_state_change_response `Enter state data)
       | None ->
         (match Jget.string_opt (Some data) "state-leave" with
-        | Some state -> (env, make_state_change_response `Leave state data)
-        | None -> (env, Files_changed (extract_file_names env data)))
+        | Some state -> Ok (env, make_state_change_response `Leave state data)
+        | None -> Ok (env, Files_changed (extract_file_names env data)))
     )
 
 let get_changes instance =
@@ -845,8 +851,9 @@ let get_changes instance =
       let debug_logging = env.settings.debug_logging in
       match%lwt blocking_read ~debug_logging ~conn:env.conn with
       | Ok response ->
-        let (env, result) = transform_asynchronous_get_changes_response env response in
-        Lwt.return (env, Watchman_pushed result)
+        (match transform_asynchronous_get_changes_response env response with
+        | Ok (env, result) -> Lwt.return (env, Watchman_pushed result)
+        | Error err -> raise_error err)
       | Error err -> raise_error err)
 
 let get_mergebase_and_changes instance =
@@ -872,6 +879,8 @@ let get_mergebase_and_changes instance =
 module Testing = struct
   type nonrec env = env
 
+  type nonrec error_severity = error_severity
+
   let test_settings =
     {
       debug_logging = false;

src/hack_forked/watchman/watchman.mli

@@ -77,9 +77,12 @@ val close : watchman_instance -> unit Lwt.t
 module Testing : sig
   type env
 
+  type error_severity
+
   val get_test_env : unit -> env Lwt.t
 
   val test_settings : init_settings
 
-  val transform_asynchronous_get_changes_response : env -> Hh_json.json -> env * pushed_changes
+  val transform_asynchronous_get_changes_response :
+    env -> Hh_json.json -> (env * pushed_changes, error_severity) Result.t
 end