Skip to content

Commit

Permalink
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Share code
Browse files Browse the repository at this point in the history
Signed-off-by: nojebar <[email protected]>
nojb committed Feb 11, 2023
1 parent 78ed4b2 commit d9a779e
Showing 1 changed file with 21 additions and 31 deletions.
52 changes: 21 additions & 31 deletions src/dune_file_watcher/dune_file_watcher.ml
Original file line number Diff line number Diff line change
@@ -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 ()))

0 comments on commit d9a779e

Please sign in to comment.