Use fsevents in dune's file watcher

Signed-off-by: Rudi Grinberg <[email protected]>

boot/duneboot.ml

@@ -1068,7 +1068,7 @@ let common_build_args name ~external_includes ~external_libraries =
     ; external_libraries
     ]
 
-let build ~ocaml_config ~dependencies ~c_files
+let build ~ocaml_config ~dependencies ~c_files ~link_flags
     { target = name, main; external_libraries; _ } =
   let ext_obj =
     try StringMap.find "ext_obj" ocaml_config with
@@ -1126,10 +1126,10 @@ let build ~ocaml_config ~dependencies ~c_files
     (List.concat
        [ common_build_args name ~external_includes ~external_libraries
        ; obj_files
-       ; [ "-args"; "compiled_ml_files" ]
+       ; [ "-args"; "compiled_ml_files" ] @ link_flags
        ])
 
-let build_with_single_command ~ocaml_config:_ ~dependencies ~c_files
+let build_with_single_command ~ocaml_config:_ ~dependencies ~c_files ~link_flags
     { target = name, main; external_libraries; _ } =
   let external_libraries, external_includes =
     resolve_externals external_libraries
@@ -1140,7 +1140,7 @@ let build_with_single_command ~ocaml_config:_ ~dependencies ~c_files
        [ common_build_args name ~external_includes ~external_libraries
        ; [ "-no-alias-deps"; "-w"; "-49" ]
        ; c_files
-       ; [ "-args"; "mods_list" ]
+       ; [ "-args"; "mods_list" ] @ link_flags
        ])
 
 let rec rm_rf fn =
@@ -1161,12 +1161,20 @@ let main () =
     List.map ~f:(fun (_, _, c_files) -> c_files) libraries |> List.concat
   in
   get_dependencies libraries >>= fun dependencies ->
+  let link_flags =
+    match StringMap.find_opt "system" ocaml_config with
+    | None -> assert false
+    | Some platform -> (
+      match List.assoc_opt platform Libs.link_flags with
+      | None -> []
+      | Some flags -> flags)
+  in
   let build =
     if concurrency = 1 || Sys.win32 then
       build_with_single_command
     else
       build
   in
-  build ~ocaml_config ~dependencies ~c_files task
+  build ~ocaml_config ~dependencies ~c_files ~link_flags task
 
 let () = Fiber.run (main ())

boot/libs.ml

@@ -34,6 +34,7 @@ let local_libraries =
   ; ("src/dune_rpc_server", Some "Dune_rpc_server", false, None)
   ; ("src/thread_worker", Some "Thread_worker", false, None)
   ; ("src/ocamlc_loc", Some "Ocamlc_loc", false, None)
+  ; ("src/fsevents", Some "Fsevents", false, None)
   ; ("vendor/ocaml-inotify/src", Some "Ocaml_inotify", false, None)
   ; ("src/async_inotify_for_dune", Some "Async_inotify_for_dune", false,
     None)
@@ -48,3 +49,12 @@ let local_libraries =
   ; ("src/csexp_rpc", Some "Csexp_rpc", false, None)
   ; ("src/dune_rpc_impl", Some "Dune_rpc_impl", false, None)
   ]
+
+let link_flags =
+  [ ("macosx",
+    [ "-cclib"
+    ; "-framework Foundation"
+    ; "-cclib"
+    ; "-framework CoreServices"
+    ])
+  ]

src/dune_file_watcher/dune

@@ -2,6 +2,7 @@
  (name dune_file_watcher)
  (libraries
   spawn
+  fsevents
   unix
   stdune
   threads.posix

src/dune_file_watcher/dune_file_watcher.ml

@@ -22,6 +22,7 @@ let inotify_event_paths event = List.map ~f:fst (decompose_inotify_event event)
 
 type kind =
   | Coarse of { wait_for_watches_established : unit -> unit }
+  | Fsevents of Fsevents.t
   | Fine of { inotify : Inotify_lib.t }
 
 type t =
@@ -268,7 +269,9 @@ let select_watcher_backend () =
   if Sys.linux then (
     assert (Ocaml_inotify.Inotify.supported_by_the_os ());
     `Inotify_lib
-  ) else
+  ) else if Fsevents.available () then
+    `Fsevents
+  else
     fswatch_backend ()
 
 let emit_sync () =
@@ -401,14 +404,6 @@ let with_buffering ~create ~(scheduler : Scheduler.t) ~debounce_interval =
   scheduler.spawn_thread buffer_thread;
   res
 
-let create_external ~root ~debounce_interval ~scheduler ~backend =
-  match debounce_interval with
-  | None -> create_no_buffering ~root ~scheduler ~backend
-  | Some debounce_interval ->
-    with_buffering ~scheduler ~debounce_interval
-      ~create:(create_no_buffering ~root)
-      ~backend
-
 let create_inotifylib ~scheduler =
   prepare_sync ();
   let ignored_files = Table.create (module String) 64 in
@@ -417,28 +412,59 @@ let create_inotifylib ~scheduler =
     (Path.to_string (Path.build (special_file_for_inotify_sync ())));
   { kind = Fine { inotify }; shutdown = `No_op; ignored_files }
 
+let create_fsevents ~(scheduler : Scheduler.t) =
+  let ignored_files = Table.create (module String) 64 in
+  let fsevents =
+    let paths = [ Path.to_string Path.root ] in
+    Fsevents.create ~paths ~latency:0.2 ~f:(fun _ events ->
+        scheduler.thread_safe_send_emit_events_job (fun () ->
+            List.map events ~f:(fun event ->
+                let path = Path.of_string (Fsevents.Event.path event) in
+                let kind =
+                  match Fsevents.Event.action event with
+                  | Unknown -> Fs_memo_event.Unknown
+                  | Create -> Created
+                  | Modify ->
+                    if Fsevents.Event.kind event = File then
+                      File_changed
+                    else
+                      Unknown
+                  | Remove -> Deleted
+                in
+                Event.Fs_memo_event { Fs_memo_event.kind; path })))
+  in
+  (* XXX hardcoded *)
+  Fsevents.set_exclusion_paths fsevents ~paths:[ "_build" ];
+  { kind = Fsevents fsevents; shutdown = `No_op; ignored_files }
+
+let create_external ~root ~debounce_interval ~scheduler ~backend =
+  match debounce_interval with
+  | None -> create_no_buffering ~root ~scheduler ~backend
+  | Some debounce_interval ->
+    with_buffering ~scheduler ~debounce_interval
+      ~create:(create_no_buffering ~root)
+      ~backend
+
 let create_default ~scheduler =
   match select_watcher_backend () with
   | `Fswatch _ as backend ->
     create_external ~scheduler ~root:Path.root
       ~debounce_interval:(Some 0.5 (* seconds *)) ~backend
+  | `Fsevents -> create_fsevents ~scheduler
   | `Inotify_lib -> create_inotifylib ~scheduler
 
-let create_external ~root ~debounce_interval ~scheduler =
-  match fswatch_backend () with
-  | `Fswatch _ as backend ->
-    create_external ~root ~debounce_interval ~scheduler ~backend
-
 let wait_for_initial_watches_established_blocking t =
   match t.kind with
   | Coarse { wait_for_watches_established } -> wait_for_watches_established ()
+  | Fsevents _
   | Fine { inotify = _ } ->
     (* no initial watches needed: all watches should be set up at the time just
        before file access *)
     ()
 
 let add_watch t path =
   match t.kind with
+  | Fsevents _
   | Coarse _ ->
     (* Here we assume that the path is already being watched because the coarse
        file watchers are expected to watch all the source files from the

src/dune_file_watcher/dune_file_watcher.mli

@@ -59,12 +59,6 @@ module Scheduler : sig
     }
 end
 
-(** Create a new file watcher. [debounce_interval] is measured in seconds and it
-    controls the minimum time between calls to
-    [scheduler.thread_safe_send_files_changed]. *)
-val create_external :
-  root:Path.t -> debounce_interval:float option -> scheduler:Scheduler.t -> t
-
 (** Create a new file watcher with default settings. *)
 val create_default : scheduler:Scheduler.t -> t
 

src/dune_rules/bootstrap_info.ml

@@ -18,6 +18,16 @@ let rule sctx compile (exes : Dune_file.Executables.t) () =
         | Some x -> Left x
         | None -> Right lib)
   in
+  let link_flags =
+    (* additional link flags keyed by the platform *)
+    [ ( "macosx"
+      , [ "-cclib"
+        ; "-framework Foundation"
+        ; "-cclib"
+        ; "-framework CoreServices"
+        ] )
+    ]
+  in
   let+ locals =
     Memo.Build.parallel_map locals ~f:(fun x ->
         let info = Lib.Local.info x in
@@ -57,6 +67,10 @@ let rule sctx compile (exes : Dune_file.Executables.t) () =
                  (List.map externals ~f:(fun x -> Lib.name x |> Lib_name.to_dyn)))
           ; Pp.nop
           ; def "local_libraries" (List locals)
+          ; Pp.nop
+          ; def "link_flags"
+              (let open Dyn.Encoder in
+              list (pair string (list string)) link_flags)
           ]))
 
 let gen_rules sctx (exes : Dune_file.Executables.t) ~dir compile =