From 4af516a6c9e20aef8c15e9069e1d4753913d77d9 Mon Sep 17 00:00:00 2001 From: Bruno Felipe Francisco Date: Sat, 6 Jan 2024 16:17:33 -0300 Subject: [PATCH 1/4] fix(pkg): use standard_watch_exclusions with fsevents Signed-off-by: Bruno Felipe Francisco --- src/dune_file_watcher/dune_file_watcher.ml | 29 ++++++++++++++----- .../dune_file_watcher_tests_patterns.ml | 2 ++ 2 files changed, 24 insertions(+), 7 deletions(-) diff --git a/src/dune_file_watcher/dune_file_watcher.ml b/src/dune_file_watcher/dune_file_watcher.ml index fce6efd9356..50cddd445b9 100644 --- a/src/dune_file_watcher/dune_file_watcher.ml +++ b/src/dune_file_watcher/dune_file_watcher.ml @@ -522,7 +522,8 @@ let create_inotifylib ~scheduler ~should_exclude = { kind = Inotify inotify; sync_table } ;; -let fsevents_callback ?exclusion_paths (scheduler : Scheduler.t) ~f events = +let fsevents_callback ?exclusion_paths ?should_exclude (scheduler : Scheduler.t) ~f events + = let skip_path = (* excluding a [path] will exclude children under [path] but not [path] itself. Hence we need to skip [path] manually *) @@ -535,13 +536,21 @@ let fsevents_callback ?exclusion_paths (scheduler : Scheduler.t) ~f events = let path = Fsevents.Event.path event |> Path.of_string |> Path.Expert.try_localize_external in - if skip_path path then None else f event path)) + let ignore_event = + skip_path path + || Option.map should_exclude ~f:(fun p -> p (Path.to_string path)) + |> Option.value ~default:false + in + if ignore_event then None else f event path)) ;; -let fsevents ?exclusion_paths ~latency ~paths scheduler f = +let fsevents ?exclusion_paths ?should_exclude ~latency ~paths scheduler f = let paths = List.map paths ~f:Path.to_absolute_filename in let fsevents = - Fsevents.create ~latency ~paths ~f:(fsevents_callback ?exclusion_paths scheduler ~f) + Fsevents.create + ~latency + ~paths + ~f:(fsevents_callback ?exclusion_paths ?should_exclude scheduler ~f) in Option.iter exclusion_paths ~f:(fun paths -> let paths = List.rev_map paths ~f:Path.to_absolute_filename in @@ -560,7 +569,7 @@ let fsevents_standard_event event path = Some (Event.Fs_memo_event { Fs_memo_event.kind; path }) ;; -let create_fsevents ?(latency = 0.2) ~(scheduler : Scheduler.t) () = +let create_fsevents ?(latency = 0.2) ~(scheduler : Scheduler.t) ~should_exclude () = prepare_sync (); let sync_table = Table.create (module String) 64 in let sync = @@ -588,7 +597,13 @@ let create_fsevents ?(latency = 0.2) ~(scheduler : Scheduler.t) () = :: ([ "_esy"; "_opam"; ".git"; ".hg" ] |> List.rev_map ~f:(Path.relative (Path.source Path.Source.root))) in - fsevents ~latency scheduler ~exclusion_paths ~paths fsevents_standard_event + fsevents + ~latency + scheduler + ~exclusion_paths + ~should_exclude + ~paths + fsevents_standard_event in let cv = Condition.create () in let dispatch_queue_ref = ref None in @@ -684,7 +699,7 @@ let create_default ?fsevents_debounce ~watch_exclusions ~scheduler () = ~debounce_interval:(Some 0.5 (* seconds *)) ~backend ~watch_exclusions - | `Fsevents -> create_fsevents ?latency:fsevents_debounce ~scheduler () + | `Fsevents -> create_fsevents ?latency:fsevents_debounce ~scheduler ~should_exclude () | `Inotify_lib -> create_inotifylib ~scheduler ~should_exclude | `Fswatch_win -> create_fswatch_win diff --git a/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_patterns.ml b/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_patterns.ml index 726a584762e..4121d180101 100644 --- a/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_patterns.ml +++ b/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_patterns.ml @@ -23,6 +23,7 @@ let%expect_test _ = test "dir/#file#"; test "dir/#subdir#/file"; test ".#file"; + test ".#foobar.ml"; test "dir/.#file"; test "dir/.#subdir/file"; [%expect @@ -40,6 +41,7 @@ let%expect_test _ = should_exclude(dir/#file#) = true should_exclude(dir/#subdir#/file) = false should_exclude(.#file) = true + should_exclude(.#foobar.ml) = true should_exclude(dir/.#file) = true should_exclude(dir/.#subdir/file) = true |}] From 25055ec403929a9572e16edfb9c12545366a5ab4 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 6 Jan 2024 17:03:53 -0700 Subject: [PATCH 2/4] move exclusion path handling to callback function Signed-off-by: Rudi Grinberg --- src/dune_file_watcher/dune_file_watcher.ml | 58 ++++++++-------------- 1 file changed, 22 insertions(+), 36 deletions(-) diff --git a/src/dune_file_watcher/dune_file_watcher.ml b/src/dune_file_watcher/dune_file_watcher.ml index 50cddd445b9..fab71da5d46 100644 --- a/src/dune_file_watcher/dune_file_watcher.ml +++ b/src/dune_file_watcher/dune_file_watcher.ml @@ -143,6 +143,7 @@ type kind = ; source : Fsevents.t ; sync : Fsevents.t ; latency : float + ; on_event : Fsevents.Event.t -> Path.t -> Event.t option } | Inotify of Inotify_lib.t | Fswatch_win of @@ -522,8 +523,7 @@ let create_inotifylib ~scheduler ~should_exclude = { kind = Inotify inotify; sync_table } ;; -let fsevents_callback ?exclusion_paths ?should_exclude (scheduler : Scheduler.t) ~f events - = +let fsevents_callback ?exclusion_paths (scheduler : Scheduler.t) ~f events = let skip_path = (* excluding a [path] will exclude children under [path] but not [path] itself. Hence we need to skip [path] manually *) @@ -536,21 +536,13 @@ let fsevents_callback ?exclusion_paths ?should_exclude (scheduler : Scheduler.t) let path = Fsevents.Event.path event |> Path.of_string |> Path.Expert.try_localize_external in - let ignore_event = - skip_path path - || Option.map should_exclude ~f:(fun p -> p (Path.to_string path)) - |> Option.value ~default:false - in - if ignore_event then None else f event path)) + if skip_path path then None else f event path)) ;; -let fsevents ?exclusion_paths ?should_exclude ~latency ~paths scheduler f = +let fsevents ?exclusion_paths ~latency ~paths scheduler f = let paths = List.map paths ~f:Path.to_absolute_filename in let fsevents = - Fsevents.create - ~latency - ~paths - ~f:(fsevents_callback ?exclusion_paths ?should_exclude scheduler ~f) + Fsevents.create ~latency ~paths ~f:(fsevents_callback ?exclusion_paths scheduler ~f) in Option.iter exclusion_paths ~f:(fun paths -> let paths = List.rev_map paths ~f:Path.to_absolute_filename in @@ -558,15 +550,18 @@ let fsevents ?exclusion_paths ?should_exclude ~latency ~paths scheduler f = fsevents ;; -let fsevents_standard_event event path = - let kind = - match Fsevents.Event.action event with - | Rename | Unknown -> Fs_memo_event.Unknown - | Create -> Created - | Remove -> Deleted - | Modify -> if Fsevents.Event.kind event = File then File_changed else Unknown - in - Some (Event.Fs_memo_event { Fs_memo_event.kind; path }) +let fsevents_standard_event ~should_exclude event path = + if should_exclude (Path.to_string path) + then None + else ( + let kind = + match Fsevents.Event.action event with + | Rename | Unknown -> Fs_memo_event.Unknown + | Create -> Created + | Remove -> Deleted + | Modify -> if Fsevents.Event.kind event = File then File_changed else Unknown + in + Some (Event.Fs_memo_event { Fs_memo_event.kind; path })) ;; let create_fsevents ?(latency = 0.2) ~(scheduler : Scheduler.t) ~should_exclude () = @@ -590,6 +585,7 @@ let create_fsevents ?(latency = 0.2) ~(scheduler : Scheduler.t) ~should_exclude Option.map (Fs_sync.consume_event sync_table path) ~f:(fun id -> Event.Sync id))) in + let on_event = fsevents_standard_event ~should_exclude in let source = let paths = [ Path.root ] in let exclusion_paths = @@ -597,13 +593,7 @@ let create_fsevents ?(latency = 0.2) ~(scheduler : Scheduler.t) ~should_exclude :: ([ "_esy"; "_opam"; ".git"; ".hg" ] |> List.rev_map ~f:(Path.relative (Path.source Path.Source.root))) in - fsevents - ~latency - scheduler - ~exclusion_paths - ~should_exclude - ~paths - fsevents_standard_event + fsevents ~latency scheduler ~exclusion_paths ~paths on_event in let cv = Condition.create () in let dispatch_queue_ref = ref None in @@ -628,7 +618,8 @@ let create_fsevents ?(latency = 0.2) ~(scheduler : Scheduler.t) ~should_exclude Mutex.unlock mutex; Option.value_exn !dispatch_queue_ref in - { kind = Fsevents { latency; scheduler; sync; source; external_; dispatch_queue } + { kind = + Fsevents { latency; scheduler; sync; source; external_; dispatch_queue; on_event } ; sync_table } ;; @@ -744,12 +735,7 @@ let add_watch t path = | None -> Ok () | Some ext -> let watch = - lazy - (fsevents - ~latency:f.latency - f.scheduler - ~paths:[ path ] - fsevents_standard_event) + lazy (fsevents ~latency:f.latency f.scheduler ~paths:[ path ] f.on_event) in (match Watch_trie.add f.external_ ext watch with | Watch_trie.Under_existing_node -> Ok () From 36cc7cf329cfd3407aab9d28aba001d8b4d721a1 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 6 Jan 2024 17:18:13 -0700 Subject: [PATCH 3/4] _ Signed-off-by: Rudi Grinberg --- doc/changes/9643.md | 1 + 1 file changed, 1 insertion(+) create mode 100644 doc/changes/9643.md diff --git a/doc/changes/9643.md b/doc/changes/9643.md new file mode 100644 index 00000000000..667e69ee5f5 --- /dev/null +++ b/doc/changes/9643.md @@ -0,0 +1 @@ +- Use watch exclusions in watch mode on MacOS (#9643, fixes #9517, @rgrinberg) From 7154790136e7e482eeedb7fb98fcc8ff0cbafec0 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 6 Jan 2024 17:55:54 -0700 Subject: [PATCH 4/4] _ Signed-off-by: Rudi Grinberg --- doc/changes/9643.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/doc/changes/9643.md b/doc/changes/9643.md index 667e69ee5f5..730e4dee8f6 100644 --- a/doc/changes/9643.md +++ b/doc/changes/9643.md @@ -1 +1,2 @@ -- Use watch exclusions in watch mode on MacOS (#9643, fixes #9517, @rgrinberg) +- Use watch exclusions in watch mode on MacOS (#9643, fixes #9517, + @PoorlyDefinedBehaviour)