watchman: extract logic for watchman watch-project from Saved_state…

…_loader into Watchman module

Summary:
I'm going to reuse that logic in the next diff.
The logic needs to be functorised, as there are multiple ways to call a process throughout the codebase.

Reviewed By: patriciamckenzie

Differential Revision: D67199868

fbshipit-source-id: a0cf9894f37ac1f03abec9570ba137b9948f3063

hphp/hack/src/watchman/dune

@@ -11,7 +11,10 @@
   sys_utils
   utils_core)
  (preprocess
-  (pps lwt_ppx ppx_deriving.std)))
+  (pps
+   lwt_ppx
+   ppx_deriving.std
+   ppx_yojson_conv)))
 
 (library
  (name watchman_utils)

hphp/hack/src/watchman/watchman.ml

@@ -1318,6 +1318,33 @@ module Watchman_mock = struct
     | Watchman_alive env -> on_alive env
 end
 
+module Process (Exec : Watchman_sig.Exec) = struct
+  type error =
+    | Process_failure of Exec.error
+    | Unexpected_json of { json_string: string }
+
+  (** [watch_project ~root ~socket] queries watchman to watch a [root]. *)
+  let watch_project ~root ~sockname =
+    let open Exec.Monad_infix in
+    let args =
+      ["watch-project"; Path.to_string root]
+      @
+      match sockname with
+      | None -> []
+      | Some sockname -> ["--sockname"; Path.to_string sockname]
+    in
+    Exec.exec Exec_command.Watchman args
+    >>| Result.map_error ~f:(fun e -> Process_failure e)
+    >|= fun stdout ->
+    try
+      Ok
+        (Watchman_sig.Types.watch_project_response_of_yojson
+        @@ Yojson.Safe.from_string stdout)
+    with
+    | Ppx_yojson_conv_lib.Yojson_conv.Of_yojson_error _ ->
+      Error (Unexpected_json { json_string = stdout })
+end
+
 include
   (val if Injector_config.use_test_stubbing then
          (module Watchman_mock : Watchman_sig.S)

hphp/hack/src/watchman/watchman.mli

@@ -12,3 +12,8 @@
   *)
 
 include Watchman_sig.S
+
+module Process : functor (Exec : Watchman_sig.Exec) ->
+  Watchman_sig.Process_S
+    with type 'a future := 'a Exec.future
+     and type exec_error := Exec.error

hphp/hack/src/watchman/watchman_sig.ml

@@ -7,6 +7,8 @@
  *
  *)
 
+open Ppx_yojson_conv_lib.Yojson_conv.Primitives
+
 module Types = struct
   exception Timeout
 
@@ -68,6 +70,14 @@ module Types = struct
     | Watchman_unavailable
     | Watchman_pushed of pushed_changes
     | Watchman_synchronous of pushed_changes list
+
+  (** The response from watchman for the `watch` command should contain these fields *)
+  type watch_project_response = {
+    watch: string;  (** Corresponds to the VCS repo root. *)
+    relative_path: string option; [@yojson.option]
+        (** The path being watched relative to the `watch` path *)
+  }
+  [@@deriving of_yojson] [@@yojson.allow_extra_fields]
 end
 
 (** The abstract types, and the types that are defined in terms of
@@ -145,3 +155,36 @@ module type S = sig
     val get_changes_returns : changes -> unit
   end
 end
+
+module type Exec = sig
+  type 'a future
+
+  type error
+
+  module Monad_infix : sig
+    val ( >>| ) : 'a future -> ('a -> 'b) -> 'b future
+
+    val ( >|= ) :
+      ('a, 'e) result future ->
+      ('a -> ('b, 'e) result) ->
+      ('b, 'e) result future
+  end
+
+  val exec : Exec_command.t -> string list -> (string, error) result future
+end
+
+module type Process_S = sig
+  type 'a future
+
+  type exec_error
+
+  type error =
+    | Process_failure of exec_error
+    | Unexpected_json of { json_string: string }
+
+  (** [watch_project ~root ~socket] queries watchman to watch a [root]. *)
+  val watch_project :
+    root:Path.t ->
+    sockname:Path.t option ->
+    (Types.watch_project_response, error) result future
+end