User-configured watch exclusions

This PR allows the command line option `--exclude-from-watch` to exclude directories from dune build --watch.

CHANGES.md

@@ -7,6 +7,8 @@ Unreleased
 - Speed up rule generation for libraries and executables with many modules
   (#7187, @jchavarri)
 
+- Add `--watch-exclusions` to dune build options (#7216, @jonahbeckford)
+
 - Do not re-render UI on every frame if the UI doesn't change (#7186, fix
   #7184, @rgrinberg)
 

bin/common.ml

@@ -528,6 +528,7 @@ module Builder = struct
     ; separate_error_messages : bool
     ; require_dune_project_file : bool
     ; insignificant_changes : [ `React | `Ignore ]
+    ; watch_exclusions : string list
     ; build_dir : string
     ; store_digest_preimage : bool
     ; root : string option
@@ -536,6 +537,19 @@ module Builder = struct
 
   let set_root t root = { t with root = Some root }
 
+  (** Cmdliner documentation markup language
+      (https://erratique.ch/software/cmdliner/doc/tool_man.html#doclang)
+      requires that dollar signs (ex. $(tname)) and backslashes are escaped. *)
+  let docmarkup_escape s =
+    let b = Buffer.create (2 * String.length s) in
+    for i = 0 to String.length s - 1 do
+      match s.[i] with
+      | '$' -> Buffer.add_string b {|\$|}
+      | '\\' -> Buffer.add_string b {|\\|}
+      | c -> Buffer.add_char b c
+    done;
+    String.of_bytes (Buffer.to_bytes b)
+
   let term =
     let docs = copts_sect in
     let+ config_from_command_line = shared_with_config_file
@@ -763,6 +777,29 @@ module Builder = struct
                ])
             Automatic
         & info [ "file-watcher" ] ~doc)
+    and+ watch_exclusions =
+      let std_exclusions = Dune_config.standard_watch_exclusions in
+      let doc =
+        let escaped_std_exclusions =
+          List.map ~f:docmarkup_escape std_exclusions
+        in
+        "Adds a POSIX regular expression that will exclude matching \
+         directories from $(b,`dune build --watch`). The option $(opt) can be \
+         repeated to add multiple exclusions. Semicolons can be also used as a \
+         separator. If no exclusions are provided, then a standard set of \
+         exclusions is used; however, if $(i,one or more) $(opt) are used, \
+         $(b,none) of the standard exclusions are used. The standard \
+         exclusions are: "
+        ^ String.concat ~sep:" " escaped_std_exclusions
+        ^ ""
+      in
+      let arg =
+        Arg.(
+          value
+          & opt_all (list ~sep:';' string) [ std_exclusions ]
+          & info [ "watch-exclusions" ] ~docs ~docv:"REGEX" ~doc)
+      in
+      Term.(const List.flatten $ arg)
     and+ wait_for_filesystem_clock =
       Arg.(
         value & flag
@@ -851,6 +888,7 @@ module Builder = struct
     ; require_dune_project_file
     ; insignificant_changes =
         (if react_to_insignificant_changes then `React else `Ignore)
+    ; watch_exclusions
     ; build_dir = Option.value ~default:default_build_dir build_dir
     ; store_digest_preimage
     ; root
@@ -903,6 +941,8 @@ let signal_watcher t =
     (* if we aren't building anything, then we don't mind interrupting dune immediately *)
     `No
 
+let watch_exclusions t = t.builder.watch_exclusions
+
 let stats t = t.stats
 
 let insignificant_changes t = t.builder.insignificant_changes

bin/common.mli

@@ -16,6 +16,8 @@ val forbid_builds : t -> t
 
 val signal_watcher : t -> [ `Yes | `No ]
 
+val watch_exclusions : t -> string list
+
 val stats : t -> Dune_stats.t option
 
 val print_metrics : t -> bool

bin/import.ml

@@ -150,8 +150,9 @@ module Scheduler = struct
     let config =
       let insignificant_changes = Common.insignificant_changes common in
       let signal_watcher = Common.signal_watcher common in
+      let watch_exclusions = Common.watch_exclusions common in
       Dune_config.for_scheduler dune_config stats ~insignificant_changes
-        ~signal_watcher
+        ~signal_watcher ~watch_exclusions
     in
     let f =
       match Common.rpc common with
@@ -173,8 +174,9 @@ module Scheduler = struct
     let config =
       let signal_watcher = Common.signal_watcher common in
       let insignificant_changes = Common.insignificant_changes common in
+      let watch_exclusions = Common.watch_exclusions common in
       Dune_config.for_scheduler dune_config stats ~insignificant_changes
-        ~signal_watcher
+        ~signal_watcher ~watch_exclusions
     in
     let file_watcher = Common.file_watcher common in
     let run () =

src/dune_config/dune_config.ml

@@ -257,6 +257,23 @@ include
       let field f = f
     end)
 
+let standard_watch_exclusions =
+  [ {|^_opam|}
+  ; {|/_opam|}
+  ; {|^_esy|}
+  ; {|/_esy|}
+  ; {|^\.#.*|} (* Such files can be created by Emacs and also Dune itself. *)
+  ; {|/\.#.*|}
+  ; {|~$|}
+  ; {|^#[^#]*#$|}
+  ; {|/#[^#]*#$|}
+  ; {|^4913$|} (* https://github.com/neovim/neovim/issues/3460 *)
+  ; {|/4913$|}
+  ; {|/.git|}
+  ; {|/.hg|}
+  ; {|:/windows|}
+  ]
+
 let hash = Poly.hash
 
 let equal a b = Poly.equal a b
@@ -441,7 +458,8 @@ let auto_concurrency =
       in
       loop commands)
 
-let for_scheduler (t : t) stats ~insignificant_changes ~signal_watcher =
+let for_scheduler (t : t) ?watch_exclusions stats ~insignificant_changes
+    ~signal_watcher =
   let concurrency =
     match t.concurrency with
     | Fixed i -> i
@@ -454,4 +472,10 @@ let for_scheduler (t : t) stats ~insignificant_changes ~signal_watcher =
      match t.display with
      | Tui -> Dune_engine.Display.Quiet
      | Simple { verbosity; _ } -> verbosity);
-  { Scheduler.Config.concurrency; stats; insignificant_changes; signal_watcher }
+  { Scheduler.Config.concurrency
+  ; stats
+  ; insignificant_changes
+  ; signal_watcher
+  ; watch_exclusions =
+      Option.value watch_exclusions ~default:standard_watch_exclusions
+  }

src/dune_config/dune_config.mli

@@ -86,6 +86,9 @@ module Partial : sig
   val to_dyn : t -> Dyn.t
 end
 
+(** A standard list of watch exclusions *)
+val standard_watch_exclusions : string list
+
 val decode : Partial.t Dune_lang.Decoder.t
 
 (** Decode the same fields as the one accepted in the configuration file, but
@@ -121,6 +124,7 @@ val equal : t -> t -> bool
 
 val for_scheduler :
      t
+  -> ?watch_exclusions:string list
   -> Dune_stats.t option
   -> insignificant_changes:[ `React | `Ignore ]
   -> signal_watcher:[ `Yes | `No ]

src/dune_engine/scheduler.ml

@@ -9,6 +9,7 @@ module Config = struct
     ; stats : Dune_stats.t option
     ; insignificant_changes : [ `Ignore | `React ]
     ; signal_watcher : [ `Yes | `No ]
+    ; watch_exclusions : string list
     }
 end
 
@@ -1250,7 +1251,7 @@ module Run = struct
                ; thread_safe_send_emit_events_job =
                    (fun job -> Event_queue.send_file_watcher_task events job)
                }
-             ())
+             ~watch_exclusions:config.watch_exclusions ())
     in
     let t = prepare ~file_watcher in
     let initial_invalidation = Fs_memo.init ~dune_file_watcher:file_watcher in

src/dune_engine/scheduler.mli

@@ -8,6 +8,7 @@ module Config : sig
     ; stats : Dune_stats.t option
     ; insignificant_changes : [ `Ignore | `React ]
     ; signal_watcher : [ `Yes | `No ]
+    ; watch_exclusions : string list
     }
 end
 

src/dune_file_watcher/dune_file_watcher.ml

@@ -148,38 +148,22 @@ type t =
         (* Pending fs sync operations indexed by the special sync filename. *)
   }
 
-let exclude_patterns =
-  [ {|^_opam|}
-  ; {|/_opam|}
-  ; {|^_esy|}
-  ; {|/_esy|}
-  ; {|^\.#.*|} (* Such files can be created by Emacs and also Dune itself. *)
-  ; {|/\.#.*|}
-  ; {|~$|}
-  ; {|^#[^#]*#$|}
-  ; {|/#[^#]*#$|}
-  ; {|^4913$|} (* https://github.com/neovim/neovim/issues/3460 *)
-  ; {|/4913$|}
-  ; {|/.git|}
-  ; {|/.hg|}
-  ; {|:/windows|}
-  ]
-
 module Re = Dune_re
 
-let exclude_regex =
-  Re.compile (Re.alt (List.map exclude_patterns ~f:Re.Posix.re))
+let exclude_regex watch_exclusions =
+  Re.compile (Re.alt (List.map watch_exclusions ~f:Re.Posix.re))
 
-let should_exclude path = Re.execp exclude_regex path
+let should_exclude path watch_exclusions =
+  Re.execp (exclude_regex watch_exclusions) path
 
 module For_tests = struct
   let should_exclude = should_exclude
 end
 
 let process_inotify_event (event : Async_inotify_for_dune.Async_inotify.Event.t)
-    : Event.t list =
+    watch_exclusions : Event.t list =
   let create_event_unless_excluded ~kind ~path =
-    match should_exclude path with
+    match should_exclude path watch_exclusions with
     | true -> []
     | false ->
       let path = Path.of_string path in
@@ -303,7 +287,7 @@ end = struct
       | Some dir -> Path.Build.equal dir (Lazy.force special_dir_path))
 end
 
-let command ~root ~backend =
+let command ~root ~backend ~watch_exclusions =
   let exclude_paths =
     (* These paths should already exist on the filesystem when the watches are
        initially set up, otherwise the @<path> has no effect for inotifywait. If
@@ -323,7 +307,7 @@ let command ~root ~backend =
        all events. *)
     let excludes =
       List.concat_map
-        (exclude_patterns @ List.map exclude_paths ~f:(fun p -> "/" ^ p))
+        (watch_exclusions @ List.map exclude_paths ~f:(fun p -> "/" ^ p))
         ~f:(fun x -> [ "--exclude"; x ])
     in
     ( fswatch
@@ -372,9 +356,9 @@ let prepare_sync () =
     match Fpath.mkdir_p dir with
     | Already_exists | Created -> ())
 
-let spawn_external_watcher ~root ~backend =
+let spawn_external_watcher ~root ~backend ~watch_exclusions =
   prepare_sync ();
-  let prog, args, parse_line = command ~root ~backend in
+  let prog, args, parse_line = command ~root ~backend ~watch_exclusions in
   let prog = Path.to_absolute_filename prog in
   let argv = prog :: args in
   let r_stdout, w_stdout = Unix.pipe () in
@@ -384,7 +368,8 @@ let spawn_external_watcher ~root ~backend =
   Option.iter stderr ~f:Unix.close;
   ((r_stdout, parse_line, wait), pid)
 
-let create_inotifylib_watcher ~sync_table ~(scheduler : Scheduler.t) =
+let create_inotifylib_watcher ~sync_table ~(scheduler : Scheduler.t)
+    watch_exclusions =
   Inotify_lib.create ~spawn_thread:scheduler.spawn_thread
     ~modify_event_selector:`Closed_writable_fd
     ~send_emit_events_job_to_scheduler:(fun f ->
@@ -401,16 +386,19 @@ let create_inotifylib_watcher ~sync_table ~(scheduler : Scheduler.t) =
                 | Moved _ | Queue_overflow -> None
               in
               match is_fs_sync_event_generated_by_dune with
-              | None -> process_inotify_event event
+              | None -> process_inotify_event event watch_exclusions
               | Some path -> (
                 match Fs_sync.consume_event sync_table path with
                 | None -> []
                 | Some id -> [ Event.Sync id ]))))
     ~log_error:(fun error -> Console.print [ Pp.text error ])
 
-let create_no_buffering ~(scheduler : Scheduler.t) ~root ~backend =
+let create_no_buffering ~(scheduler : Scheduler.t) ~root ~backend
+    ~watch_exclusions =
   let sync_table = Table.create (module String) 64 in
-  let (pipe, parse_line, wait), pid = spawn_external_watcher ~root ~backend in
+  let (pipe, parse_line, wait), pid =
+    spawn_external_watcher ~root ~backend ~watch_exclusions
+  in
   let worker_thread pipe =
     let buffer = Buffer.create ~capacity:buffer_capacity in
     while true do
@@ -487,12 +475,12 @@ let with_buffering ~create ~(scheduler : Scheduler.t) ~debounce_interval =
   scheduler.spawn_thread buffer_thread;
   res
 
-let create_inotifylib ~scheduler =
+let create_inotifylib ~scheduler ~watch_exclusions =
   prepare_sync ();
   let sync_table = Table.create (module String) 64 in
   let inotify = create_inotifylib_watcher ~sync_table ~scheduler in
-  Inotify_lib.add inotify (Lazy.force Fs_sync.special_dir);
-  { kind = Inotify inotify; sync_table }
+  Inotify_lib.add (inotify watch_exclusions) (Lazy.force Fs_sync.special_dir);
+  { kind = Inotify (inotify watch_exclusions); sync_table }
 
 let fsevents_callback ?exclusion_paths (scheduler : Scheduler.t) ~f events =
   let skip_path =
@@ -588,7 +576,8 @@ let create_fsevents ?(latency = 0.2) ~(scheduler : Scheduler.t) () =
   ; sync_table
   }
 
-let fswatch_win_callback ~(scheduler : Scheduler.t) ~sync_table event =
+let fswatch_win_callback ~(scheduler : Scheduler.t) ~sync_table
+    ~watch_exclusions event =
   let dir = Fswatch_win.Event.directory event in
   let filename = Filename.concat dir (Fswatch_win.Event.path event) in
   let localized_path =
@@ -609,7 +598,7 @@ let fswatch_win_callback ~(scheduler : Scheduler.t) ~sync_table event =
       String.concat ~sep:"/"
         (String.split_on_char ~sep:'\\' (String.lowercase_ascii filename))
     in
-    if not (should_exclude normalized_filename) then
+    if not (should_exclude normalized_filename watch_exclusions) then
       scheduler.thread_safe_send_emit_events_job (fun () ->
           let kind =
             match Fswatch_win.Event.action event with
@@ -619,14 +608,17 @@ let fswatch_win_callback ~(scheduler : Scheduler.t) ~sync_table event =
           in
           [ Fs_memo_event { kind; path } ])
 
-let create_fswatch_win ~(scheduler : Scheduler.t) ~debounce_interval:sleep =
+let create_fswatch_win ~(scheduler : Scheduler.t) ~debounce_interval:sleep
+    ~watch_exclusions =
   let sync_table = Table.create (module String) 64 in
   let t = Fswatch_win.create () in
   Fswatch_win.add t (Path.to_absolute_filename Path.root);
   scheduler.spawn_thread (fun () ->
       while true do
         let events = Fswatch_win.wait t ~sleep in
-        List.iter ~f:(fswatch_win_callback ~scheduler ~sync_table) events
+        List.iter
+          ~f:(fswatch_win_callback ~scheduler ~sync_table ~watch_exclusions)
+          events
       done);
   { kind = Fswatch_win { t; scheduler }; sync_table }
 
@@ -638,15 +630,16 @@ let create_external ~root ~debounce_interval ~scheduler ~backend =
       ~create:(create_no_buffering ~root)
       ~backend
 
-let create_default ?fsevents_debounce ~scheduler () =
+let create_default ?fsevents_debounce ~watch_exclusions ~scheduler () =
   match select_watcher_backend () with
   | `Fswatch _ as backend ->
     create_external ~scheduler ~root:Path.root
-      ~debounce_interval:(Some 0.5 (* seconds *)) ~backend
+      ~debounce_interval:(Some 0.5 (* seconds *)) ~backend ~watch_exclusions
   | `Fsevents -> create_fsevents ?latency:fsevents_debounce ~scheduler ()
-  | `Inotify_lib -> create_inotifylib ~scheduler
+  | `Inotify_lib -> create_inotifylib ~scheduler ~watch_exclusions
   | `Fswatch_win ->
-    create_fswatch_win ~scheduler ~debounce_interval:500 (* milliseconds *)
+    create_fswatch_win ~scheduler ~watch_exclusions
+      ~debounce_interval:500 (* milliseconds *)
 
 let wait_for_initial_watches_established_blocking t =
   match t.kind with