From 3554eaa9bcd6a32799a16f1b6abab419f9f0869d Mon Sep 17 00:00:00 2001 From: Darren Li Date: Wed, 4 Sep 2024 01:19:00 +1000 Subject: [PATCH] Reworked async search/filter UI code to avoid noticeable lag due to waiting for cancellations that take too long --- bin/docfd.ml | 13 +- bin/document_store_manager.ml | 264 ++++++++++++++++++++++------------ bin/lock_protected_cell.ml | 27 ++++ bin/lock_protected_cell.mli | 9 ++ bin/misc_utils.ml | 8 ++ bin/multi_file_view.ml | 44 ++++-- bin/ping.ml | 15 ++ bin/ping.mli | 7 + bin/single_file_view.ml | 24 ++-- bin/ui_base.ml | 5 - 10 files changed, 295 insertions(+), 121 deletions(-) create mode 100644 bin/lock_protected_cell.ml create mode 100644 bin/lock_protected_cell.mli create mode 100644 bin/ping.ml create mode 100644 bin/ping.mli diff --git a/bin/docfd.ml b/bin/docfd.ml index 04ed28d..0c9ab26 100644 --- a/bin/docfd.ml +++ b/bin/docfd.ml @@ -547,9 +547,10 @@ let run ) ) ); - Lwd.set Ui_base.Vars.document_store init_document_store; + Document_store_manager.submit_update_req `Multi_file_view init_document_store; (match init_ui_mode with - | Ui_base.Ui_single_file -> Lwd.set Ui_base.Vars.Single_file.document_store init_document_store + | Ui_base.Ui_single_file -> + Document_store_manager.submit_update_req `Single_file_view init_document_store; | _ -> () ); Ui_base.Vars.eio_env := Some env; @@ -630,7 +631,9 @@ let run match action with | Ui_base.Recompute_document_src -> ( let document_src = compute_document_src () in - let old_document_store = Lwd.peek Ui_base.Vars.document_store in + let old_document_store = + Lwd.peek Document_store_manager.multi_file_view_document_store + in let file_path_filter_glob_string = Document_store.file_path_filter_glob_string old_document_store in let file_path_filter_glob = Document_store.file_path_filter_glob old_document_store in let search_exp_string = Document_store.search_exp_string old_document_store in @@ -648,7 +651,7 @@ let run search_exp_string search_exp in - Document_store_manager.submit_update_req document_store Ui_base.Vars.document_store; + Document_store_manager.submit_update_req `Multi_file_view document_store; loop () ) | Open_file_and_search_result (doc, search_result) -> ( @@ -691,7 +694,7 @@ let run Eio.Fiber.any [ (fun () -> Eio.Domain_manager.run (Eio.Stdenv.domain_mgr env) - (fun () -> Document_store_manager.search_fiber pool)); + (fun () -> Document_store_manager.worker_fiber pool)); Document_store_manager.manager_fiber; Ui_base.Key_binding_info.grid_light_fiber; Printers.Worker.fiber; diff --git a/bin/document_store_manager.ml b/bin/document_store_manager.ml index a5ed1bb..73ae90a 100644 --- a/bin/document_store_manager.ml +++ b/bin/document_store_manager.ml @@ -1,5 +1,10 @@ open Docfd_lib +type store_typ = [ + | `Multi_file_view + | `Single_file_view +] + type search_status = [ | `Idle | `Searching @@ -8,39 +13,62 @@ type search_status = [ type filter_status = [ `Ok | `Parse_error ] -type request = - | Filter of string * Document_store.t * Document_store.t Lwd.var - | Search of string * Document_store.t * Document_store.t Lwd.var - | Update of Document_store.t * Document_store.t Lwd.var - let search_ui_status : search_status Lwd.var = Lwd.var `Idle let filter_ui_status : filter_status Lwd.var = Lwd.var `Ok -let ingress : request Eio.Stream.t = - Eio.Stream.create 0 +let single_file_view_search_request : string Lock_protected_cell.t = + Lock_protected_cell.make () + +let multi_file_view_search_request : string Lock_protected_cell.t = + Lock_protected_cell.make () + +let single_file_view_filter_request : string Lock_protected_cell.t = + Lock_protected_cell.make () + +let multi_file_view_filter_request : string Lock_protected_cell.t = + Lock_protected_cell.make () + +let single_file_view_update_request : Document_store.t Lock_protected_cell.t = + Lock_protected_cell.make () + +let multi_file_view_update_request : Document_store.t Lock_protected_cell.t = + Lock_protected_cell.make () + +let worker_ping : Ping.t = Ping.make () type egress_payload = | Search_exp_parse_error | Searching - | Search_done of Document_store.t * Document_store.t Lwd.var + | Search_done of store_typ * Document_store.t | Filter_glob_parse_error - | Filtering_done of Document_store.t * Document_store.t Lwd.var - | Update of Document_store.t * Document_store.t Lwd.var + | Filtering_done of store_typ * Document_store.t + | Update of store_typ * Document_store.t let egress_mailbox : egress_payload Eio.Stream.t = Eio.Stream.create 1 -let stop_signal = Atomic.make (Stop_signal.make ()) +let search_stop_signal = Atomic.make (Stop_signal.make ()) -let stop_signal_swap_completed : unit Eio.Stream.t = Eio.Stream.create 0 +let signal_search_stop () = + let x = Atomic.exchange search_stop_signal (Stop_signal.make ()) in + Stop_signal.broadcast x -let store_update_lock = Eio.Mutex.create () +let single_file_view_document_store = Lwd.var Document_store.empty + +let multi_file_view_document_store = Lwd.var Document_store.empty let manager_fiber () = - let update_store document_store_var document_store = - Eio.Mutex.use_rw store_update_lock ~protect:false (fun () -> - Lwd.set document_store_var document_store; + (* This fiber handles updates of Lwd.var which are not thread-safe, + and thus cannot be done by worker_fiber directly + *) + let update_store (store_typ : store_typ) document_store = + match store_typ with + | `Multi_file_view -> ( + Lwd.set multi_file_view_document_store document_store; + ) + | `Single_file_view -> ( + Lwd.set single_file_view_document_store document_store; ) in while true do @@ -52,23 +80,23 @@ let manager_fiber () = | Searching -> ( Lwd.set search_ui_status `Searching ) - | Search_done (document_store, document_store_var) -> ( - update_store document_store_var document_store; + | Search_done (store_typ, document_store) -> ( + update_store store_typ document_store; Lwd.set search_ui_status `Idle ) | Filter_glob_parse_error -> ( Lwd.set filter_ui_status `Parse_error ) - | Filtering_done (document_store, document_store_var) -> ( - update_store document_store_var document_store; + | Filtering_done (store_typ, document_store) -> ( + update_store store_typ document_store; Lwd.set filter_ui_status `Ok ) - | Update (document_store, document_store_var) -> ( - update_store document_store_var document_store; + | Update (store_typ, document_store) -> ( + update_store store_typ document_store; ) done -let search_fiber pool = +let worker_fiber pool = (* This fiber runs in a background domain to allow the UI code in the main domain to immediately continue running after key presses that trigger searches or search cancellations. @@ -76,75 +104,133 @@ let search_fiber pool = This removes the need to make the code of document store always yield frequently. *) - while true do - let req = Eio.Stream.take ingress in - let stop_signal' = Stop_signal.make () in - Atomic.set stop_signal stop_signal'; - Eio.Stream.add stop_signal_swap_completed (); - match req with - | Filter (original_string, document_store, document_store_var) -> ( - let s = - if String.length original_string = 0 then ( - original_string - ) else ( - Misc_utils.normalize_glob_to_absolute original_string - ) + let single_file_view_store = ref Document_store.empty in + let multi_file_view_store = ref Document_store.empty in + let process_search_req search_stop_signal (store_typ : store_typ) (s : string) = + match Search_exp.make s with + | None -> ( + Eio.Stream.add egress_mailbox Search_exp_parse_error + ) + | Some search_exp -> ( + Eio.Stream.add egress_mailbox Searching; + let store = + (match store_typ with + | `Single_file_view -> !single_file_view_store + | `Multi_file_view -> !multi_file_view_store) + |> Document_store.update_search_exp + pool + search_stop_signal + s + search_exp in - match Glob.make s with - | Some glob -> ( - let document_store = - document_store - |> Document_store.update_file_path_filter_glob - pool - stop_signal' - original_string - glob - in - Eio.Stream.add egress_mailbox (Filtering_done (document_store, document_store_var)) - ) - | None -> ( - Eio.Stream.add egress_mailbox Filter_glob_parse_error - ) + (match store_typ with + | `Single_file_view -> single_file_view_store := store + | `Multi_file_view -> multi_file_view_store := store); + Eio.Stream.add egress_mailbox + (Search_done (store_typ, store)) ) - | Search (s, document_store, document_store_var) -> ( - match Search_exp.make s with - | None -> ( - Eio.Stream.add egress_mailbox Search_exp_parse_error - ) - | Some search_exp -> ( - Eio.Stream.add egress_mailbox Searching; - let document_store = - document_store - |> Document_store.update_search_exp pool stop_signal' s search_exp - in - Eio.Stream.add egress_mailbox - (Search_done (document_store, document_store_var)) - ) + in + let process_filter_req search_stop_signal (store_typ : store_typ) (original_string : string) = + let s = + if String.length original_string = 0 then ( + original_string + ) else ( + Misc_utils.normalize_glob_to_absolute original_string ) - | Update (document_store, document_store_var) -> ( - Eio.Stream.add egress_mailbox (Update (document_store, document_store_var)) + in + match Glob.make s with + | Some glob -> ( + let store = + (match store_typ with + | `Single_file_view -> !single_file_view_store + | `Multi_file_view -> !multi_file_view_store) + |> Document_store.update_file_path_filter_glob + pool + search_stop_signal + original_string + glob + in + (match store_typ with + | `Single_file_view -> single_file_view_store := store + | `Multi_file_view -> multi_file_view_store := store); + Eio.Stream.add egress_mailbox (Filtering_done (store_typ, store)) + ) + | None -> ( + Eio.Stream.add egress_mailbox Filter_glob_parse_error ) + in + let process_update_req (store_typ : store_typ) store = + (match store_typ with + | `Single_file_view -> single_file_view_store := store + | `Multi_file_view -> multi_file_view_store := store + ); + Eio.Stream.add egress_mailbox (Update (store_typ, store)) + in + while true do + Ping.wait worker_ping; + let search_stop_signal' = Atomic.get search_stop_signal in + (match Lock_protected_cell.get single_file_view_filter_request with + | None -> () + | Some s -> process_filter_req search_stop_signal' `Single_file_view s + ); + (match Lock_protected_cell.get multi_file_view_filter_request with + | None -> () + | Some s -> process_filter_req search_stop_signal' `Multi_file_view s + ); + (match Lock_protected_cell.get single_file_view_search_request with + | None -> () + | Some s -> process_search_req search_stop_signal' `Single_file_view s + ); + (match Lock_protected_cell.get multi_file_view_search_request with + | None -> () + | Some s -> process_search_req search_stop_signal' `Multi_file_view s + ); + (match Lock_protected_cell.get single_file_view_update_request with + | None -> () + | Some store -> process_update_req `Single_file_view store + ); + (match Lock_protected_cell.get multi_file_view_update_request with + | None -> () + | Some store -> process_update_req `Multi_file_view store + ); done -let submit_filter_req (s : string) (store_var : Document_store.t Lwd.var) = - Eio.Mutex.use_rw store_update_lock ~protect:false (fun () -> - let store = Lwd.peek store_var in - Stop_signal.broadcast (Atomic.get stop_signal); - Eio.Stream.add ingress (Filter (s, store, store_var)); - Eio.Stream.take stop_signal_swap_completed; - ) - -let submit_search_req (s : string) (store_var : Document_store.t Lwd.var) = - Eio.Mutex.use_rw store_update_lock ~protect:false (fun () -> - let store = Lwd.peek store_var in - Stop_signal.broadcast (Atomic.get stop_signal); - Eio.Stream.add ingress (Search (s, store, store_var)); - Eio.Stream.take stop_signal_swap_completed; - ) - -let submit_update_req (store : Document_store.t) (store_var : Document_store.t Lwd.var) = - Eio.Mutex.use_rw store_update_lock ~protect:false (fun () -> - Stop_signal.broadcast (Atomic.get stop_signal); - Eio.Stream.add ingress (Update (store, store_var)); - Eio.Stream.take stop_signal_swap_completed; - ) +let submit_filter_req (store_typ : store_typ) (s : string) = + signal_search_stop (); + (match store_typ with + | `Multi_file_view -> ( + Lock_protected_cell.set multi_file_view_filter_request s; + ) + | `Single_file_view -> ( + Lock_protected_cell.set single_file_view_filter_request s; + ) + ); + Ping.ping worker_ping + +let submit_search_req (store_typ : store_typ) (s : string) = + signal_search_stop (); + (match store_typ with + | `Multi_file_view -> ( + Lock_protected_cell.set multi_file_view_search_request s; + ) + | `Single_file_view -> ( + Lock_protected_cell.set single_file_view_search_request s; + ) + ); + Ping.ping worker_ping + +let submit_update_req (store_typ : store_typ) (store : Document_store.t) = + signal_search_stop (); + (match store_typ with + | `Multi_file_view -> ( + Lock_protected_cell.unset multi_file_view_search_request; + Lock_protected_cell.unset multi_file_view_filter_request; + Lock_protected_cell.set multi_file_view_update_request store; + ) + | `Single_file_view -> ( + Lock_protected_cell.unset single_file_view_search_request; + Lock_protected_cell.unset single_file_view_filter_request; + Lock_protected_cell.set single_file_view_update_request store; + ) + ); + Ping.ping worker_ping diff --git a/bin/lock_protected_cell.ml b/bin/lock_protected_cell.ml new file mode 100644 index 0000000..00bffa8 --- /dev/null +++ b/bin/lock_protected_cell.ml @@ -0,0 +1,27 @@ +type 'a t = { + lock : Eio.Mutex.t; + mutable data : 'a option; +} + +let make () = + { + lock = Eio.Mutex.create (); + data = None; + } + +let set (t : 'a t) (x : 'a) = + Eio.Mutex.use_rw t.lock ~protect:false (fun () -> + t.data <- Some x + ) + +let unset (t : 'a t) = + Eio.Mutex.use_rw t.lock ~protect:false (fun () -> + t.data <- None + ) + +let get (t : 'a t) : 'a option = + Eio.Mutex.use_rw t.lock ~protect:false (fun () -> + let x = t.data in + t.data <- None; + x + ) diff --git a/bin/lock_protected_cell.mli b/bin/lock_protected_cell.mli new file mode 100644 index 0000000..08c681b --- /dev/null +++ b/bin/lock_protected_cell.mli @@ -0,0 +1,9 @@ +type 'a t + +val make : unit -> 'a t + +val set : 'a t -> 'a -> unit + +val unset : 'a t -> unit + +val get : 'a t -> 'a option diff --git a/bin/misc_utils.ml b/bin/misc_utils.ml index 2a23376..1bd2420 100644 --- a/bin/misc_utils.ml +++ b/bin/misc_utils.ml @@ -60,3 +60,11 @@ let rotate_list (x : int) (l : 'a list) : 'a list = (array_sub_seq ~start:x ~end_exc:len arr) (array_sub_seq ~start:0 ~end_exc:x arr) |> List.of_seq + +let drain_eio_stream (x : 'a Eio.Stream.t) = + let rec aux () = + match Eio.Stream.take_nonblocking x with + | None -> () + | Some _ -> aux () + in + aux () diff --git a/bin/multi_file_view.ml b/bin/multi_file_view.ml index 2a629be..43506a4 100644 --- a/bin/multi_file_view.ml +++ b/bin/multi_file_view.ml @@ -46,10 +46,12 @@ let reload_document (doc : Document.t) = | Ok doc -> ( reset_document_selected (); let document_store = - Lwd.peek Ui_base.Vars.document_store + Lwd.peek Document_store_manager.multi_file_view_document_store |> Document_store.add_document pool doc in - Document_store_manager.submit_update_req document_store Ui_base.Vars.document_store; + Document_store_manager.submit_update_req + `Multi_file_view + document_store; ) | Error _ -> () @@ -93,23 +95,25 @@ let drop ~document_count (choice : [`Single of string | `Listed | `Unlisted]) = `Unusable ) in - let document_store = Lwd.peek Ui_base.Vars.document_store in + let document_store = + Lwd.peek Document_store_manager.multi_file_view_document_store + in add_to_undo document_store; Document_store_manager.submit_update_req + `Multi_file_view (Document_store.drop choice document_store) - Ui_base.Vars.document_store let update_file_path_filter () = reset_document_selected (); let s = fst @@ Lwd.peek Vars.file_path_filter_field in Stack.clear Vars.document_store_redo; - Document_store_manager.submit_filter_req s Ui_base.Vars.document_store + Document_store_manager.submit_filter_req `Multi_file_view s let update_search_phrase () = reset_document_selected (); let s = fst @@ Lwd.peek Vars.search_field in Stack.clear Vars.document_store_redo; - Document_store_manager.submit_search_req s Ui_base.Vars.document_store + Document_store_manager.submit_search_req `Multi_file_view s module Top_pane = struct module Document_list = struct @@ -320,7 +324,9 @@ module Bottom_pane = struct let file_shown_count = Notty.I.strf ~attr:Ui_base.Status_bar.attr "%5d/%d documents listed" - document_count (Document_store.size (Lwd.peek Ui_base.Vars.document_store)) + document_count + (Document_store.size + (Lwd.peek Document_store_manager.multi_file_view_document_store)) in let index_of_selected = Notty.I.strf ~attr:Ui_base.Status_bar.attr @@ -571,9 +577,11 @@ let keyboard_handler (match Stack.pop_opt Vars.document_store_undo with | None -> () | Some prev -> ( - let cur = Lwd.peek Ui_base.Vars.document_store in + let cur = + Lwd.peek Document_store_manager.multi_file_view_document_store + in Stack.push cur Vars.document_store_redo; - Document_store_manager.submit_update_req prev Ui_base.Vars.document_store; + Document_store_manager.submit_update_req `Multi_file_view prev; sync_input_fields_from_document_store prev; reset_document_selected (); )); @@ -584,9 +592,11 @@ let keyboard_handler (match Stack.pop_opt Vars.document_store_redo with | None -> () | Some next -> ( - let cur = Lwd.peek Ui_base.Vars.document_store in + let cur = + Lwd.peek Document_store_manager.multi_file_view_document_store + in Stack.push cur Vars.document_store_undo; - Document_store_manager.submit_update_req next Ui_base.Vars.document_store; + Document_store_manager.submit_update_req `Multi_file_view next; sync_input_fields_from_document_store next; reset_document_selected (); )); @@ -594,11 +604,15 @@ let keyboard_handler ) | (`Tab, []) -> ( Option.iter (fun (doc, _search_results) -> - let document_store = Lwd.peek Ui_base.Vars.document_store in + let document_store = + Lwd.peek Document_store_manager.multi_file_view_document_store + in let single_file_document_store = Option.get (Document_store.single_out ~path:(Document.path doc) document_store) in - Document_store_manager.submit_update_req single_file_document_store Ui_base.Vars.Single_file.document_store; + Document_store_manager.submit_update_req + `Single_file_view + single_file_document_store; Lwd.set Ui_base.Vars.Single_file.index_of_search_result_selected (Lwd.peek Vars.index_of_search_result_selected); Lwd.set Ui_base.Vars.Single_file.search_field @@ -852,7 +866,9 @@ let keyboard_handler | _ -> `Unhandled let main : Nottui.ui Lwd.t = - let$* document_store = Lwd.get Ui_base.Vars.document_store in + let$* document_store = + Lwd.get Document_store_manager.multi_file_view_document_store + in let document_info_s = Document_store.usable_documents document_store in diff --git a/bin/ping.ml b/bin/ping.ml new file mode 100644 index 0000000..8d60f8c --- /dev/null +++ b/bin/ping.ml @@ -0,0 +1,15 @@ +type t = { + queue : unit Eio.Stream.t; +} + +let make () = + { + queue = Eio.Stream.create Int.max_int; + } + +let ping (t : t) = + Eio.Stream.add t.queue () + +let wait (t : t) = + Eio.Stream.take t.queue; + Misc_utils.drain_eio_stream t.queue diff --git a/bin/ping.mli b/bin/ping.mli new file mode 100644 index 0000000..3fe9dc9 --- /dev/null +++ b/bin/ping.mli @@ -0,0 +1,7 @@ +type t + +val make : unit -> t + +val ping : t -> unit + +val wait : t -> unit diff --git a/bin/single_file_view.ml b/bin/single_file_view.ml index f7a9244..55ce4d3 100644 --- a/bin/single_file_view.ml +++ b/bin/single_file_view.ml @@ -14,7 +14,9 @@ let reset_search_result_selected () = let update_search_phrase () = reset_search_result_selected (); let s = fst @@ Lwd.peek Ui_base.Vars.Single_file.search_field in - Document_store_manager.submit_search_req s Ui_base.Vars.Single_file.document_store + Document_store_manager.submit_search_req + `Single_file_view + s let reload_document (doc : Document.t) : unit = let pool = Ui_base.task_pool () in @@ -23,16 +25,20 @@ let reload_document (doc : Document.t) : unit = with | Ok doc -> ( reset_search_result_selected (); - let global_document_store = - Lwd.peek Ui_base.Vars.document_store + let multi_file_view_document_store = + Lwd.peek Document_store_manager.multi_file_view_document_store |> Document_store.add_document pool doc in - Document_store_manager.submit_update_req global_document_store Ui_base.Vars.document_store; - let document_store = - Lwd.peek Ui_base.Vars.Single_file.document_store + Document_store_manager.submit_update_req + `Multi_file_view + multi_file_view_document_store; + let single_file_view_document_store = + Lwd.peek Document_store_manager.single_file_view_document_store |> Document_store.add_document pool doc in - Document_store_manager.submit_update_req document_store Ui_base.Vars.Single_file.document_store; + Document_store_manager.submit_update_req + `Single_file_view + single_file_view_document_store; ) | Error _ -> () @@ -322,7 +328,9 @@ let keyboard_handler | _ -> `Unhandled let main : Nottui.ui Lwd.t = - let$* document_store = Lwd.get Ui_base.Vars.Single_file.document_store in + let$* document_store = + Lwd.get Document_store_manager.single_file_view_document_store + in let _, document_info = Option.get (Document_store.min_binding document_store) in diff --git a/bin/ui_base.ml b/bin/ui_base.ml index c177f10..3637a1f 100644 --- a/bin/ui_base.ml +++ b/bin/ui_base.ml @@ -48,15 +48,10 @@ module Vars = struct let term_width_height : (int * int) Lwd.var = Lwd.var (0, 0) - let document_store : Document_store.t Lwd.var = - Lwd.var Document_store.empty - module Single_file = struct let search_field = Lwd.var empty_text_field let index_of_search_result_selected = Lwd.var 0 - - let document_store : Document_store.t Lwd.var = Lwd.var Document_store.empty end end