Rework virtual table api

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

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

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

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,29 +134,23 @@ 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 ->
         Elwd.handler Ev.scroll (fun ev ->
             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 =