From 45ada9a1b6231c9e03f4cb7ec1b8b72ddf44c2c1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Loi=CC=88c=20Correnson?= <loic.correnson@cea.fr>
Date: Thu, 18 Jan 2024 11:02:30 +0100
Subject: [PATCH] [server] activity listeners
---
src/plugins/server/main.ml | 11 ++++++++++-
src/plugins/server/main.mli | 6 ++++++
2 files changed, 16 insertions(+), 1 deletion(-)
diff --git a/src/plugins/server/main.ml b/src/plugins/server/main.ml
index 06d8471f772..d825f29e92a 100644
--- a/src/plugins/server/main.ml
+++ b/src/plugins/server/main.ml
@@ -381,10 +381,19 @@ let in_range ~min:a ~max:b v = min (max a v) b
let kill () = raise Killed
+let rooters = ref []
let daemons = ref []
+let once callback = rooters := !rooters @ [ callback ]
let on callback = daemons := !daemons @ [ callback ]
let set_active activity =
- List.iter (fun f -> try f activity with _ -> ()) !daemons
+ begin
+ if activity then
+ begin
+ List.iter (fun f -> try f () with _ -> ()) !rooters ;
+ rooters := [] ;
+ end ;
+ List.iter (fun f -> try f activity with _ -> ()) !daemons ;
+ end
let create ~pretty ?(equal=(=)) ~fetch () =
let polling = in_range ~min:1 ~max:200 (Senv.Polling.get ()) in
diff --git a/src/plugins/server/main.mli b/src/plugins/server/main.mli
index 4868d732093..8ca15e5190d 100644
--- a/src/plugins/server/main.mli
+++ b/src/plugins/server/main.mli
@@ -141,6 +141,12 @@ val on_signal : signal -> (bool -> unit) -> unit
Callbacks shall {i never} raise any exception. *)
val on : (bool -> unit) -> unit
+(** Register a callback to listen for server initialization. All callbacks are
+ executed once, in their order of registration, and before activity
+ callbacks.
+ Callbacks shall {i never} raise any exception. *)
+val once : (unit -> unit) -> unit
+
(** Register an asynchronous task on the server.
When the server is not working in background, this is
equivalent to [Task.call] ; otherwize,
--
GitLab