From 1a6c23c90d3c806244108fb37c3437c2c8e1a2aa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Loi=CC=88c=20Correnson?= <loic.correnson@cea.fr>
Date: Mon, 17 Feb 2020 16:39:09 +0100
Subject: [PATCH] [server] install state hooks (only) on demand
---
src/plugins/server/states.ml | 38 ++++++++++++++++++++++++++++++++---
src/plugins/server/states.mli | 30 +++++++++++++++++++++++----
2 files changed, 61 insertions(+), 7 deletions(-)
diff --git a/src/plugins/server/states.ml b/src/plugins/server/states.ml
index 990c4e0b14e..6b811e8a6d5 100644
--- a/src/plugins/server/states.ml
+++ b/src/plugins/server/states.ml
@@ -22,12 +22,31 @@
open Data
+type 'a callback = ('a -> unit) -> unit
+
+let install signal hook = function
+ | None -> ()
+ | Some add_hook ->
+ let once = ref false in
+ let install ok =
+ if ok && !once then
+ begin
+ once := false ;
+ add_hook hook ;
+ end
+ in Request.on_signal signal install
+
+let install_emit signal add_hook =
+ install signal (fun () -> Request.emit signal) add_hook
+
(* -------------------------------------------------------------------------- *)
(* --- Values --- *)
(* -------------------------------------------------------------------------- *)
let register_value (type a) ~page ~name ~descr ?(details=[])
- ~(output : a Request.output) ~get =
+ ~(output : a Request.output) ~get
+ ?(add_hook : unit callback option) ()
+ =
let open Markdown in
let title = Printf.sprintf "`VALUE` %s" name in
let index = [ Printf.sprintf "%s (`VALUE`)" name ] in
@@ -38,6 +57,7 @@ let register_value (type a) ~page ~name ~descr ?(details=[])
Request.register ~page ~kind:`GET ~name:(name ^ ".get")
~descr:(plain "Getter for value " @ href h)
~input:(module Junit) ~output get ;
+ install_emit signal add_hook ;
signal
(* -------------------------------------------------------------------------- *)
@@ -45,7 +65,8 @@ let register_value (type a) ~page ~name ~descr ?(details=[])
(* -------------------------------------------------------------------------- *)
let register_state (type a) ~page ~name ~descr ?(details=[])
- ~(data : a data) ~get ~set =
+ ~(data : a data) ~get ~set
+ ?(add_hook : unit callback option) () =
let open Markdown in
let title = Printf.sprintf "`STATE` %s" name in
let index = [ Printf.sprintf "%s (`STATE`)" name ] in
@@ -59,6 +80,7 @@ let register_state (type a) ~page ~name ~descr ?(details=[])
Request.register ~page ~kind:`SET ~name:(name ^ ".set")
~descr:(plain "Setter for state " @ href h)
~input:(module (val data)) ~output:(module Junit) set ;
+ install_emit signal add_hook ;
signal
(* -------------------------------------------------------------------------- *)
@@ -153,6 +175,8 @@ let remove array k =
Request.emit array.signal ;
end
+let signal array = array.signal
+
(* -------------------------------------------------------------------------- *)
(* --- Fetch Model Updates --- *)
(* -------------------------------------------------------------------------- *)
@@ -220,7 +244,12 @@ let fetch array n =
(* --- Signature Registry --- *)
(* -------------------------------------------------------------------------- *)
-let register_array ~page ~name ~descr ?(details=[]) ~key ~iter model =
+let register_array ~page ~name ~descr ?(details=[]) ~key
+ ~(iter : 'a callback)
+ ?(add_update_hook : 'a callback option)
+ ?(add_remove_hook : 'a callback option)
+ ?(add_reload_hook : unit callback option)
+ model =
let open Markdown in
let title = Printf.sprintf "`ARRAY` %s" name in
let index = [ Printf.sprintf "%s (`ARRAY`)" name ] in
@@ -286,6 +315,9 @@ let register_array ~page ~name ~descr ?(details=[]) ~key ~iter model =
~input:(module Junit) ~output:(module Junit)
(fun () -> reload array) ;
synchronize array ;
+ install signal (update array) add_update_hook ;
+ install signal (remove array) add_remove_hook ;
+ install signal (fun () -> reload array) add_reload_hook ;
array
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/states.mli b/src/plugins/server/states.mli
index 9b7c148dc0b..60f6798add7 100644
--- a/src/plugins/server/states.mli
+++ b/src/plugins/server/states.mli
@@ -20,11 +20,17 @@
(* *)
(**************************************************************************)
+type 'a callback = ('a -> unit) -> unit
+
(** Register a (projectified) value and generates the associated signal and
request:
- Signal [<name>.sig] is emitted on value updates;
- GET Request [<name>.get] returns the current value.
+ If provided, the [~add_hook] option is used to register a hook
+ to notify the server of value updates. The hook will be installed
+ only once the client starts to listen for value updates.
+
Inside {b Ivette} you can use the [States.useSyncValue(id)] hook to
synchronize with this value.
*)
@@ -35,8 +41,8 @@ val register_value :
?details:Markdown.block ->
output:'a Request.output ->
get:(unit -> 'a) ->
- Request.signal
-
+ ?add_hook:(unit callback) ->
+ unit -> Request.signal
(** Register a (projectified) state and generates the associated signal and
requests:
@@ -44,6 +50,10 @@ val register_value :
- GET Request [<name>.get] returns the current value;
- SET Request [<name>.set] modifies the server value.
+ If provided, the [~add_hook] option is used to register a hook
+ to notify the server of value updates. The hook will be installed
+ only once the client starts to listen for value updates.
+
Inside {b Ivette} you can use the [States.useSyncState(id)] hook to
synchronize with this state.
*)
@@ -55,7 +65,8 @@ val register_state :
data:'a Data.data ->
get:(unit -> 'a) ->
set:('a -> unit) ->
- Request.signal
+ ?add_hook:(unit callback) ->
+ unit -> Request.signal
type 'a model (** Columns array model *)
@@ -80,6 +91,9 @@ val update : 'a array -> 'a -> unit
(** Mark an array entry as removed. *)
val remove : 'a array -> 'a -> unit
+(** Get the signal associated with the array *)
+val signal : 'a array -> Request.signal
+
(** Register signals a requests for synchronizing
an array with the client.
- Signal [<name>.sig] is emitted on array updates;
@@ -92,6 +106,11 @@ val remove : 'a array -> 'a -> unit
Columns added to the model after registration are {i not} taken
into account.
+ If provided, the [~add_xxx_hook] options are used to register hooks
+ to notify the server of corresponding array updates.
+ Each hook will be installed only once the client starts to
+ listen for array updates.
+
Inside {b Ivette} you can obtain the entries in sync by
using the [States.useSyncArray()] hook.
*)
@@ -101,7 +120,10 @@ val register_array :
descr:Markdown.text ->
?details:Markdown.block ->
key:('a -> string) ->
- iter:(('a -> unit) -> unit) ->
+ iter:('a callback) ->
+ ?add_update_hook:('a callback) ->
+ ?add_remove_hook:('a callback) ->
+ ?add_reload_hook:(unit callback) ->
'a model -> 'a array
(* -------------------------------------------------------------------------- *)
--
GitLab