event: add a return type

src/util/Event.ml

@@ -1,15 +1,28 @@
-type 'a handler = 'a -> unit
+type ('a, 'b) handler = 'a -> 'b
-type 'a t = { h: 'a handler Vec.t } [@@unboxed]
+type ('a, 'b) t = { h: ('a, 'b) handler Vec.t } [@@unboxed]
 
-let nop_handler_ = ignore
+let nop_handler_ _ = assert false
 
 module Emitter = struct
-  type nonrec 'a t = 'a t
+  type nonrec ('a, 'b) t = ('a, 'b) t
+
+  let emit (self : (_, unit) t) x = Vec.iter self.h ~f:(fun h -> h x)
+
+  let emit_collect (self : _ t) x : _ list =
+    let l = ref [] in
+    Vec.iter self.h ~f:(fun h -> l := h x :: !l);
+    !l
+
+  let emit_iter self x ~f =
+    Vec.iter self.h ~f:(fun h ->
+        let y = h x in
+        f y)
 
-  let emit (self : _ t) x : unit = Vec.iter self.h ~f:(fun h -> h x)
   let create () : _ t = { h = Vec.make 3 nop_handler_ }
 end
 
 let on self ~f = Vec.push self.h f
 let of_emitter x = x
 let emit = Emitter.emit
+let emit_collect = Emitter.emit_collect
+let emit_iter = Emitter.emit_iter

src/util/Event.mli

@@ -1,13 +1,18 @@
-type 'a t
+type ('a, 'b) t
-(** An event emitting values of type ['a] *)
+(** An event emitting values of type ['a], where subscribers
+    return values of type ['b]. *)
 
 module Emitter : sig
-  type 'a t
+  type ('a, 'b) t
 
-  val create : unit -> 'a t
+  val create : unit -> ('a, 'b) t
-  val emit : 'a t -> 'a -> unit
+  val emit : ('a, unit) t -> 'a -> unit
+  val emit_collect : ('a, 'b) t -> 'a -> 'b list
+  val emit_iter : ('a, 'b) t -> 'a -> f:('b -> unit) -> unit
 end
 
-val on : 'a t -> f:('a -> unit) -> unit
+val on : ('a, 'b) t -> f:('a -> 'b) -> unit
-val of_emitter : 'a Emitter.t -> 'a t
+val of_emitter : ('a, 'b) Emitter.t -> ('a, 'b) t
-val emit : 'a Emitter.t -> 'a -> unit
+val emit : ('a, unit) Emitter.t -> 'a -> unit
+val emit_collect : ('a, 'b) Emitter.t -> 'a -> 'b list
+val emit_iter : ('a, 'b) Emitter.t -> 'a -> f:('b -> unit) -> unit