From fe7083a12ff07a0fd095fce7b03f93121a5e69ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 24 Apr 2024 00:02:38 +0200 Subject: [PATCH] servers: fix persistent var and limit unnecessary redraws --- bin/player.ml | 8 +++--- bin/servers.ml | 72 +++++++++++++++++++++++++++------------------- bin/ui_playlist.ml | 24 +++++++++------- 3 files changed, 59 insertions(+), 45 deletions(-) diff --git a/bin/player.ml b/bin/player.ml index 88de9dd..1093b5b 100644 --- a/bin/player.ml +++ b/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 diff --git a/bin/servers.ml b/bin/servers.ml index 0591264..a68427e 100644 --- a/bin/servers.ml +++ b/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) diff --git a/bin/ui_playlist.ml b/bin/ui_playlist.ml index 20d4071..cc5c9af 100644 --- a/bin/ui_playlist.ml +++ b/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