From 2dbefb8c2250b5ac4e456341d304698c46a797de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 19 Aug 2024 21:38:05 +0200 Subject: [PATCH] Rework virtual table api --- bin/main.ml | 48 ++++++++++++++++----------- bin/ui_playlist.ml | 45 ++++++++++++++----------- bin/worker_client.ml | 18 ++++++++++ lib/brr_lwd_ui/table/virtual_table.ml | 38 +++++++++++---------- 4 files changed, 91 insertions(+), 58 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 58744e5..286589f 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -107,25 +107,33 @@ let app = (filters, f_libraries.value) in let main_view = - Ui_utils.map3 f_value f_search.value f_sort_order ~f:(fun l t (s, o) -> - let filters = Option.map (fun s -> [ Db.View.Search s ]) t in - Console.log - [ - "Updating main view:"; - Jv.of_option ~none:(Jv.of_string "\"\"") Jv.of_string t; - Jv.of_list Jv.of_string l; - Jv.of_string s; - ]; - let open Fut.Result_syntax in - let sort = Db.View.Sort.of_string s in - let open Fut.Result_syntax in - let+ view = - Worker_client.query - (Create_view - Db.View.(req Audio ~src_views:(Only l) ~sort ?filters ())) - in - let order = View.Order.of_string ~size:view.item_count o in - { View.view; first = 0; last = view.item_count; order }) + let view = + Ui_utils.map3 f_value f_search.value f_sort_order ~f:(fun l t (s, o) -> + let filters = Option.map (fun s -> [ Db.View.Search s ]) t in + Console.log + [ + "Updating main view:"; + Jv.of_option ~none:(Jv.of_string "\"\"") Jv.of_string t; + Jv.of_list Jv.of_string l; + Jv.of_string s; + ]; + let open Fut.Result_syntax in + let sort = Db.View.Sort.of_string s in + let open Fut.Result_syntax in + Worker_client.create_view + Db.View.(req Audio ~src_views:(Only l) ~sort ?filters ())) + in + (* FIXME *) + let view = Lwd.join view in + Lwd.map2 view f_sort_order ~f:(fun view (_, order) -> + Option.map + (fun view -> + let open Result in + let+ (view : View.t) = view in + let size = view.item_count in + let order = View.Order.of_string ~size order in + { View.view; first = 0; last = 0; order }) + view) in let main_list = @@ -137,7 +145,7 @@ let app = | None -> Elwd.span [ `P (El.txt' "Nothing playing") ] | Some playlist -> Ui_playlist.make_now_playing ~reset_playlist:P.reset_playlist ~fetch - (Lwd.pure (Fut.ok playlist))) + (Lwd.pure (Some (Result.return playlist)))) in (*todo: do we need that join ?*) Lwd.join playlist diff --git a/bin/ui_playlist.ml b/bin/ui_playlist.ml index 20a1af6..36ccb07 100644 --- a/bin/ui_playlist.ml +++ b/bin/ui_playlist.ml @@ -17,7 +17,7 @@ let columns () = |] let make ~reset_playlist ~fetch ?scroll_target - (view : (Db.View.ranged, 'a) Fut.result Lwd.t) = + (ranged_view : (View.ranged, Db.Worker_api.error) result option Lwd.t) = let img_url server_id item_id = let servers = (* should this be reactive ? *) @@ -38,9 +38,11 @@ let make ~reset_playlist ~fetch ?scroll_target { Api.Item.id; name; album_id; server_id; image_blur_hashes; _ }; _; } = - let play_from _ = + let play_from view _ = ignore - (let open Fut.Result_syntax in + (let open Option.Infix in + let+ view = view in + let open Result in let+ (view : Db.View.ranged) = view in reset_playlist { @@ -52,7 +54,9 @@ let make ~reset_playlist ~fetch ?scroll_target }; }) in - let play_on_click = Elwd.handler Ev.click play_from in + let play_on_click = + Lwd.map view ~f:(fun view -> Elwd.handler Ev.click (play_from view)) + in let img_url = match (image_blur_hashes, album_id) with | { primary = None }, _ | _, None -> @@ -69,7 +73,7 @@ let make ~reset_playlist ~fetch ?scroll_target `R status; `R (Elwd.div - ~ev:[ `P play_on_click ] + ~ev:[ `R play_on_click ] [ `R (Elwd.img ~at:[ `R img_url; `P (At.width 50) ] ()) ]); `P (El.div [ El.span [ El.txt' name ] ]); ] @@ -79,23 +83,24 @@ let make ~reset_playlist ~fetch ?scroll_target { Table.table = { columns = columns () }; row_height = Em 4. } in let data_source = - Lwd.map view ~f:(fun view -> - let total_items = - Fut.map - (Result.map (fun view -> Db.View.item_count view.View.view)) - view - in - let fetch i = - let open Fut.Result_syntax in - let* view = view in - fetch view i - in - let render = render view in - { Table.Virtual.total_items; fetch; render }) + let total_items = + Lwd.map ranged_view ~f:(function + | Some (Ok ranged) -> Db.View.item_count ranged.view + | _ -> 0) + in + + let fetch = + Lwd.map ranged_view ~f:(fun view i -> + match view with + | Some (Ok view) -> fetch view i + | _ -> Fut.error (`Msg "No view !")) + in + let render = Lwd.pure (render ranged_view) in + { Table.Virtual.total_items; fetch; render } in Table.Virtual.make ~ui_table ~placeholder ?scroll_target data_source let make_now_playing ~reset_playlist ~fetch - (view : (Db.View.ranged, 'a) Fut.result Lwd.t) = + (ranged_view : (View.ranged, Db.Worker_api.error) result option Lwd.t) = let scroll_target = Lwd.get Player.playstate.current_index in - make ~scroll_target ~reset_playlist ~fetch view + make ~scroll_target ~reset_playlist ~fetch ranged_view diff --git a/bin/worker_client.ml b/bin/worker_client.ml index ae37b4b..92b195a 100644 --- a/bin/worker_client.ml +++ b/bin/worker_client.ml @@ -1,3 +1,21 @@ +open Import +open Brr + include Db.Worker_api.Start_client (struct let url = "./db_worker.bc.js" end) + +let servers_status = + let var = Lwd.var ("", Db.Sync.initial_report) in + let _ = + listen Servers_status_update ~f:(fun (id, report) -> + Console.log + [ Format.asprintf "Server %s: %a" id Db.Sync.pp_report report ]; + Lwd.set var (id, report)) + in + var + +let create_view v = + let var = Lwd.var None in + Fut.await (query (Create_view v)) (fun v -> Lwd.set var (Some v)); + Lwd.get var diff --git a/lib/brr_lwd_ui/table/virtual_table.ml b/lib/brr_lwd_ui/table/virtual_table.ml index c818e26..993ccce 100644 --- a/lib/brr_lwd_ui/table/virtual_table.ml +++ b/lib/brr_lwd_ui/table/virtual_table.ml @@ -13,13 +13,13 @@ open Brr_lwd type 'a row_data = { index : int; content : 'a option; - render : int -> 'a -> Elwd.t Elwd.col; + render : (int -> 'a -> Elwd.t Elwd.col) Lwd.t; } type ('data, 'error) data_source = { - total_items : (int, 'error) Fut.result; - fetch : int array -> ('data option array, 'error) Fut.result; - render : int -> 'data -> Elwd.t Elwd.col; + total_items : int Lwd.t; + fetch : (int array -> ('data option array, 'error) Fut.result) Lwd.t; + render : (int -> 'data -> Elwd.t Elwd.col) Lwd.t; } (* The virtual table is a complex reactive component. Primarily, it reacts to @@ -32,7 +32,7 @@ module Cache = FFCache.Make (Int) let make (type data) ~(ui_table : Schema.fixed_row_height) ?(placeholder : int -> Elwd.t Elwd.col = fun _ -> []) ?(scroll_target : int Lwd.t option) - (data_source : (data, _) data_source Lwd.t) = + ({ total_items; fetch; render } : (data, _) data_source) = ignore placeholder; let row_size = ui_table.row_height |> Utils.Unit.to_string in let height_n n = Printf.sprintf "height: calc(%s * %i);" row_size n in @@ -134,21 +134,16 @@ let make (type data) ~(ui_table : Schema.fixed_row_height) done in let populate_on_scroll = - Lwd.map data_source ~f:(fun { total_items; fetch; render } -> - let last_scroll_y = ref 0. in + let last_scroll_y = ref 0. in + Lwd.map2 total_items fetch ~f:(fun total_items fetch -> let update div = let visible_rows = compute_visible_rows ~last_scroll_y div in (* todo: We do way too much work and rebuild the queue each time... it's very ineficient *) add ~fetch ~max_items:(4 * List.length visible_rows) visible_rows in - let open Fut.Syntax in - let+ total_items = total_items in - match total_items with - | Ok total_items -> - prepare ~total_items ~render; - update - | _ -> ignore) + prepare ~total_items ~render; + update) in let scroll_handler = Lwd.map populate_on_scroll ~f:(fun update -> @@ -156,7 +151,6 @@ let make (type data) ~(ui_table : Schema.fixed_row_height) let open Fut.Syntax in ignore @@ - let+ update = update in let scroll_handler = let last_update = ref 0. in let timeout = ref (-1) in @@ -185,7 +179,7 @@ let make (type data) ~(ui_table : Schema.fixed_row_height) let root = Lwd.observe repopulate_deps in Lwd.set_on_invalidate root (fun _ -> match Lwd.quick_sample root with - | update, Some (_h, div) -> Fut.await update (fun update -> update div) + | update, Some (_h, div) -> update div | _ -> ()); Lwd.quick_sample root |> ignore in @@ -194,12 +188,20 @@ let make (type data) ~(ui_table : Schema.fixed_row_height) let style = At.style (Jstr.v @@ height_n n) in El.div ~at:(style :: at) [] in - let render _ { content; index; render } = + let render _row { content; index; render } = let at = Attrs.add At.Name.class' (`P "row") [] in let style = `P (At.style (Jstr.v height)) in match content with | Some data -> - (0, Lwd_seq.element @@ Elwd.div ~at:(style :: at) (render index data), 0) + let rendered_row = + Lwd.map render ~f:(fun render -> + Lwd_seq.of_list + (List.map (render index data) ~f:(fun elt -> Elwd.div [ elt ]))) + in + ( 0, + Lwd_seq.element + @@ Elwd.div ~at:(style :: at) [ `S (Lwd_seq.lift rendered_row) ], + 0 ) | None -> (1, Lwd_seq.empty, 0) in let table_body =