servers: fix persistent var and limit unnecessary redraws

bin/player.ml

@@ -48,16 +48,16 @@ struct
           match result with
           | [| Some { Db.Stores.Items.item = { server_id; id; name; _ }; _ } |]
             ->
-              let servers = Lwd_seq.to_list (Lwd.peek Servers.var) in
-              let server : Servers.server = List.assq server_id servers in
-              let url = audio_url server.connexion id in
+              let servers = Lwd_seq.to_list (Lwd.peek Servers.connexions) in
+              let connexion : DS.connexion = List.assq server_id servers in
+              let url = audio_url connexion id in
               let () = Console.log [ "Now playing:"; name; Jv.of_string url ] in
               let () =
                 let open Brr_io.Media.Session in
                 let session = of_navigator G.navigator in
                 let img_src =
                   Printf.sprintf "%s/Items/%s/Images/Primary?width=500"
-                    server.connexion.base_url id
+                    connexion.base_url id
                 in
                 let title = name in
                 let album = "" in

bin/servers.ml

@@ -1,35 +1,49 @@
 open Import
 open Brr
 
-type server = { connexion : DS.connexion; status : Db.Sync.report Lwd.var }
-type t = (string * server) Lwd_seq.t Lwd.var
+type server = {
+  connexion : DS.connexion;
+  status : Db.Sync.report Lwd.var;
+  refresh : unit Lwd.var;
+}
 
-let var : t = Brr_lwd_ui.Persistent.var ~key:"ui_servers" Lwd_seq.empty
+let connexions : (string * DS.connexion) Lwd_seq.t Lwd.var =
+  Brr_lwd_ui.Persistent.var ~key:"ui_servers" Lwd_seq.empty
 
-let connect (server_id, { connexion; status }) =
+let connect (server_id, { connexion; status; refresh }) =
   let _ =
     Worker_client.listen Servers_status_update ~f:(fun (id, report) ->
         (* TODO: subscribe to a specific server's updates *)
-        if String.equal server_id id then Lwd.set status report)
+        let previous_status = Lwd.peek status in
+        if String.equal server_id id then (
+          Lwd.set status report;
+          match (previous_status.sync_progress, report.sync_progress) with
+          | Some { remaining; _ }, Some { remaining = remaining'; _ }
+            when remaining <> remaining' ->
+              Lwd.set refresh ()
+          | Some { remaining; _ }, None -> Lwd.set refresh ()
+          | _ -> ()))
   in
   ignore (Worker_client.query @@ Add_servers [ (server_id, connexion) ])
 
-let () =
-  (* Connect to servers that are already known when loading the page *)
-  let servers = Lwd.peek var |> Lwd_seq.to_list in
-  List.iter servers ~f:connect
+let servers_with_status =
+  Lwd_seq.map
+    (fun (id, connexion) ->
+      let status = Lwd.var Db.Sync.initial_report in
+      let refresh = Lwd.var () in
+      let server = (id, { connexion; status; refresh }) in
+      connect server;
+      server)
+    (Lwd.get connexions)
 
 let new_connexion ~base_url ~username ~password =
   let open Fut.Result_syntax in
   let+ connexion = DS.connect { base_url; username; password } in
-  let status = Lwd.var Db.Sync.initial_report in
-  let server = { connexion; status } in
   let server_id = connexion.auth_response.server_id in
   (* TODO CHECK SERVER ID *)
-  let () = connect (server_id, server) in
   Lwd.update
-    (fun servers -> Lwd_seq.(concat servers (element (server_id, server))))
-    var
+    (fun servers -> Lwd_seq.(concat servers (element (server_id, connexion))))
+    connexions
 
 module Connect_form = struct
   open Brr_lwd_ui.Form
@@ -98,25 +112,23 @@ let fut_to_lwd ~init f =
   Lwd.get v
 
 let servers_libraries =
-  let statuses =
-    Lwd_seq.map
-      (fun (server_id, { status; _ }) ->
-        let views =
-          Lwd.bind (Lwd.get status) ~f:(fun _ ->
-              Worker_client.query (Get_server_libraries server_id)
-              |> Fut.map (Result.get_or ~default:[])
-              |> fut_to_lwd ~init:[])
-        in
-        (server_id, views))
-      (Lwd.get var)
-  in
-  statuses
+  Lwd_seq.map
+    (fun (server_id, { refresh; _ }) ->
+      let views =
+        Lwd.bind (Lwd.get refresh) ~f:(fun () ->
+            Worker_client.query (Get_server_libraries server_id)
+            |> Fut.map (Result.get_or ~default:[])
+            |> fut_to_lwd ~init:[])
+      in
+      (server_id, views))
+    servers_with_status
 
 let ui () =
-  let servers = Lwd.get var in
-  let statuses = Lwd_seq.map (fun (_, server) -> ui_status server) servers in
+  let statuses =
+    Lwd_seq.map (fun (_, server) -> ui_status server) servers_with_status
+  in
   let ui_form =
-    Lwd.map servers ~f:(fun s ->
+    Lwd.map servers_with_status ~f:(fun s ->
         match Lwd_seq.view s with
         | Empty -> Lwd_seq.element @@ Elwd.div [ `R (ui_form ()) ]
         | _ -> Lwd_seq.empty)

bin/ui_playlist.ml

@@ -18,16 +18,18 @@ let columns () =
 
 let make ~reset_playlist ~fetch _ (view : (Db.View.t, 'a) Fut.result Lwd.t) =
   let img_url server_id item_id =
-    Lwd.map (Lwd.get Servers.var) ~f:(fun servers ->
-        let servers = Lwd_seq.to_list servers in
-        let url =
-          try
-            let server : Servers.server = List.assq server_id servers in
-            Printf.sprintf "%s/Items/%s/Images/Primary?width=50"
-              server.connexion.base_url item_id
-          with Not_found -> "error-globe-64.png"
-        in
-        At.src (Jstr.v url))
+    let servers =
+      (* should this be reactive ? *)
+      Lwd.peek Servers.connexions |> Lwd_seq.to_list
+    in
+    let url =
+      try
+        let connexion : DS.connexion = List.assq server_id servers in
+        Printf.sprintf "%s/Items/%s/Images/Primary?width=50" connexion.base_url
+          item_id
+      with Not_found -> "error-globe-64.png"
+    in
+    At.src (Jstr.v url)
   in
   let render view start_index
       {
@@ -47,7 +49,7 @@ let make ~reset_playlist ~fetch _ (view : (Db.View.t, 'a) Fut.result Lwd.t) =
       match (image_blur_hashes, album_id) with
       | { primary = None }, _ | _, None ->
           Lwd.return (At.src (Jstr.v "music-50.png"))
-      | _, Some id -> img_url server_id id
+      | _, Some id -> Lwd.return (img_url server_id id)
     in
     let status =
       Lwd.map (Lwd.get Player.now_playing) ~f:(function