Remove ServerDfind

Summary: The functionality can be split between DfindLib and
ServerEnvBuild. This also has the advantage of making the Dfind state
explicit. It would also help code sharing between Flow and Hack (since
server code will no longer be shared)

Reviewed By: @jwatzman

Differential Revision: D2096628

hphp/hack/src/dfind/dfindLib.ml

@@ -7,15 +7,26 @@
  * of patent rights can be found in the PATENTS file in the same directory.
  *
  *)
-(*****************************************************************************)
-(* Library code *)
-(*****************************************************************************)
 
-let start roots =
-  let {Daemon.channels; pid} =
-    Daemon.fork (DfindServer.run_daemon roots) in
-  channels, pid
+open Utils
 
-let get_changes (result_in, msg_out) =
-  Daemon.to_channel msg_out ();
-  Daemon.from_channel result_in
+type t = (SSet.t, unit) Daemon.handle
+
+let init roots = Daemon.fork (DfindServer.run_daemon roots)
+
+let pid handle = handle.Daemon.pid
+
+let request_changes {Daemon.channels = (ic, oc); pid = _} =
+  Daemon.to_channel oc ();
+  Daemon.from_channel ic
+
+let get_changes daemon =
+  let rec loop acc =
+    let diff = request_changes daemon in
+    if SSet.is_empty diff
+    then acc
+    else begin
+      let acc = SSet.union diff acc in
+      loop acc
+    end
+  in loop SSet.empty

hphp/hack/src/server/serverDfind.mli → hphp/hack/src/dfind/dfindLib.mli

@@ -1,5 +1,5 @@
 (**
- * Copyright (c) 2014, Facebook, Inc.
+ * Copyright (c) 2015, Facebook, Inc.
  * All rights reserved.
  *
  * This source code is licensed under the BSD-style license found in the
@@ -10,11 +10,9 @@
 
 open Utils
 
-val dfind_pid: int option ref
-
-val dfind_init:
-  Path.t list -> unit
-
-(* new set of php and js files *)
-val get_updates: unit -> SSet.t
+type t
 
+val init : Path.t list -> t
+val pid : t -> int
+val request_changes : t -> SSet.t
+val get_changes : t -> SSet.t

hphp/hack/src/dfind/dfindServer.ml

@@ -20,8 +20,6 @@ open Utils
 (* Processing an fsnotify event *)
 (*****************************************************************************)
 
-(* Die if something unexpected happened *)
-
 let (process_fsnotify_event:
        DfindEnv.t -> SSet.t -> Fsnotify.event
          -> SSet.t) = fun env dirty event ->

hphp/hack/src/server/serverEnv.ml

@@ -18,6 +18,7 @@ type genv = {
     options          : ServerArgs.options;
     config           : ServerConfig.t;
     workers          : Worker.t list option;
+    dfind            : DfindLib.t option;
   }
 
 (*****************************************************************************)

hphp/hack/src/server/serverEnvBuild.ml

@@ -14,7 +14,7 @@
 (*****************************************************************************)
 open ServerEnv
 
-let make_genv ~multicore options config =
+let make_genv ~multicore options config watch_paths =
   let check_mode   = ServerArgs.check_mode options in
   let gc_control   = ServerConfig.gc_control config in
   Typing_deps.trace :=
@@ -24,9 +24,11 @@ let make_genv ~multicore options config =
   let workers =
     if multicore then Some (Worker.make nbr_procs gc_control) else None
   in
+  let dfind = if check_mode then None else Some (DfindLib.init watch_paths) in
   { options;
     config;
     workers;
+    dfind;
   }
 
 let make_env options config =

hphp/hack/src/server/serverEnvBuild.mli

@@ -9,7 +9,8 @@
  *)
 
 val make_genv: 
-  multicore:bool -> ServerArgs.options -> ServerConfig.t -> ServerEnv.genv
+  multicore:bool -> ServerArgs.options -> ServerConfig.t -> Path.t list
+  -> ServerEnv.genv
 
 val make_env:
   ServerArgs.options -> ServerConfig.t -> ServerEnv.env

hphp/hack/src/server/serverFunctors.ml

@@ -58,7 +58,6 @@ end
 module MainInit : sig
   val go:
     ServerArgs.options ->
-    Path.t list ->      (* other watched paths *)
     (unit -> env) ->    (* init function to run while we have init lock *)
     env
 end = struct
@@ -78,7 +77,7 @@ end = struct
     ignore(Lock.release root "init")
 
   (* This code is only executed when the options --check is NOT present *)
-  let go options watch_paths init_fun =
+  let go options init_fun =
     let root = ServerArgs.root options in
     let send_signal () = match ServerArgs.waiting_client options with
       | None -> ()
@@ -90,8 +89,6 @@ end = struct
     send_signal ();
     (* note: we only run periodical tasks on the root, not extras *)
     ServerPeriodical.init root;
-    (* watch root and extra paths *)
-    ServerDfind.dfind_init (root :: watch_paths);
     let env = init_fun () in
     release_init_lock root;
     Hh_logger.log "Server is READY";
@@ -173,7 +170,7 @@ end = struct
    * rebase, and we don't log the recheck_end event until the update list
    * is no longer getting populated. *)
   let rec recheck_loop i rechecked_count genv env =
-    let raw_updates = ServerDfind.get_updates () in
+    let raw_updates = DfindLib.get_changes (unsafe_opt genv.dfind) in
     if SSet.is_empty raw_updates then i, rechecked_count, env else begin
       let updates = Program.process_updates genv env raw_updates in
       let env, rechecked = recheck genv env updates in
@@ -315,7 +312,9 @@ end = struct
     Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
     PidLog.init root;
     PidLog.log ~reason:"main" (Unix.getpid());
-    let genv = ServerEnvBuild.make_genv ~multicore:true options config in
+    let watch_paths = root :: Program.get_watch_paths options in
+    let genv =
+      ServerEnvBuild.make_genv ~multicore:true options config watch_paths in
     let env = ServerEnvBuild.make_env options config in
     let program_init = create_program_init genv env in
     let is_check_mode = ServerArgs.check_mode genv.options in
@@ -324,8 +323,7 @@ end = struct
       Option.iter (ServerArgs.save_filename genv.options) (save genv env);
       Program.run_once_and_exit genv env
     else
-      let watch_paths = Program.get_watch_paths options in
-      let env = MainInit.go options watch_paths program_init in
+      let env = MainInit.go options program_init in
       let socket = Socket.init_unix_socket root in
       serve genv env socket
 

hphp/hack/src/server/serverRpc.ml

@@ -65,4 +65,4 @@ let handle : type a. genv -> env -> a t -> a =
     | COVERAGE_COUNTS path -> ServerCoverageMetric.go path genv env
     | LINT fnl -> ServerLint.go genv fnl
     | LINT_ALL code -> ServerLint.lint_all genv code
-    | KILL -> ServerEnv.async ServerUtils.die_nicely
+    | KILL -> ServerEnv.async (fun () -> ServerUtils.die_nicely genv)

hphp/hack/src/server/serverUtils.ml

@@ -26,12 +26,12 @@ type file_input =
   | FileName of string
   | FileContent of string
 
-let die_nicely () =
+let die_nicely genv =
   HackEventLogger.killed ();
   Printf.printf "Status: Error\n";
   Printf.printf "Sent KILL command by client. Dying.\n";
-  (match !ServerDfind.dfind_pid with
-  | Some pid -> Unix.kill pid Sys.sigterm;
-  | None -> failwith "Dfind died before we could kill it"
+  (match genv.ServerEnv.dfind with
+  | Some handle -> Unix.kill (DfindLib.pid handle) Sys.sigterm;
+  | None -> ()
   );
   exit 0