diff --git a/src/dune_file_watcher/dune_file_watcher.ml b/src/dune_file_watcher/dune_file_watcher.ml index eaca7414a74f..e91f18c275f0 100644 --- a/src/dune_file_watcher/dune_file_watcher.ml +++ b/src/dune_file_watcher/dune_file_watcher.ml @@ -210,7 +210,7 @@ let shutdown t = Fsevents.stop fsevents.sync; Watch_trie.to_list fsevents.external_ |> List.iter ~f:(fun (_, fs) -> Fsevents.stop fs)) - | Fswatch_win _t -> `Thunk (fun () -> ()) + | Fswatch_win _t -> `Thunk (fun () -> ()) (* TODO: clean up resources. *) let buffer_capacity = 65536 @@ -655,6 +655,21 @@ let wait_for_initial_watches_established_blocking t = before file access *) () +(* Return the parent directory of [ext] if [ext] denotes a file. *) +let parent_directory ext = + let rec loop p = + if Path.is_directory (Path.external_ p) then Some ext + else + match Path.External.parent p with + | None -> + User_warning.emit + [ Pp.textf "Refusing to watch %s" (Path.External.to_string ext) + ]; + None + | Some ext -> loop ext + in + loop ext + let add_watch t path = match t.kind with | Fsevents f -> ( @@ -663,21 +678,7 @@ let add_watch t path = | In_build_dir _ -> Code_error.raise "attempted to watch a directory in build" [] | External ext -> ( - let ext = - let rec loop p = - if Path.is_directory (Path.external_ p) then Some ext - else - match Path.External.parent p with - | None -> - User_warning.emit - [ Pp.textf "Refusing to watch %s" (Path.External.to_string ext) - ]; - None - | Some ext -> loop ext - in - loop ext - in - match ext with + match parent_directory ext with | None -> Ok () | Some ext -> ( let watch = @@ -707,23 +708,12 @@ let add_watch t path = Code_error.raise "attempted to watch a directory in build" [] | Path.In_source_tree _ -> Ok () | External ext -> ( - let ext = - let rec loop p = - if Path.is_directory (Path.external_ p) then Some ext - else - match Path.External.parent p with - | None -> - User_warning.emit - [ Pp.textf "Refusing to watch %s" (Path.External.to_string ext) - ]; - None - | Some ext -> loop ext - in - loop ext - in - match ext with + match parent_directory ext with | None -> Ok () | Some _ -> + (* TODO: here we can end up adding the same path multiple times. We + should improve things to avoid doing this or to remove a child + directory when a parent directory is added. *) Fswatch_win.add fswatch.t (Path.to_absolute_filename path); Ok ()))