Abstract Lwt_sequence from Lwt_main hooks APIs

Part of #361.

src/unix/lwt_main.ml

@@ -61,3 +61,58 @@ let () =
     run (call_hooks ()))
 
 let at_exit f = ignore (Lwt_sequence.add_l f exit_hooks)
+
+module type Hooks =
+sig
+  type 'return_value kind
+  type hook
+
+  val add_first : (unit -> unit kind) -> hook
+  val add_last : (unit -> unit kind) -> hook
+  val remove : hook -> unit
+  val remove_all : unit -> unit
+end
+
+module type Hook_sequence =
+sig
+  type 'return_value kind
+  val sequence : (unit -> unit kind) Lwt_sequence.t
+end
+
+module Wrap_hooks (Sequence : Hook_sequence) =
+struct
+  type 'a kind = 'a Sequence.kind
+  type hook = (unit -> unit Sequence.kind) Lwt_sequence.node
+
+  let add_first hook_fn =
+    let hook_node = Lwt_sequence.add_l hook_fn Sequence.sequence in
+    hook_node
+
+  let add_last hook_fn =
+    let hook_node = Lwt_sequence.add_r hook_fn Sequence.sequence in
+    hook_node
+
+  let remove hook_node =
+    Lwt_sequence.remove hook_node
+
+  let remove_all () =
+    Lwt_sequence.iter_node_l Lwt_sequence.remove Sequence.sequence
+end
+
+module Enter_iter_hooks =
+  Wrap_hooks (struct
+    type 'return_value kind = 'return_value
+    let sequence = enter_iter_hooks
+  end)
+
+module Leave_iter_hooks =
+  Wrap_hooks (struct
+    type 'return_value kind = 'return_value
+    let sequence = leave_iter_hooks
+  end)
+
+module Exit_hooks =
+  Wrap_hooks (struct
+    type 'return_value kind = 'return_value Lwt.t
+    let sequence = exit_hooks
+  end)

src/unix/lwt_main.mli

@@ -44,22 +44,75 @@ val yield : unit -> unit Lwt.t
   (** [yield ()] is a threads which suspends itself and then resumes
       as soon as possible and terminates. *)
 
+
+
+(** Hook sequences. Each module of this type is a set of hooks, to be run by Lwt
+    at certain points during execution. See modules {!Enter_iter_hooks},
+    {!Leave_iter_hooks}, and {!Exit_hooks}. *)
+module type Hooks =
+sig
+  type 'return_value kind
+  (** Hooks are functions of either type [unit -> unit] or [unit -> unit Lwt.t];
+      this type constructor is used only to express both possibilities in one
+      signature. *)
+
+  type hook
+  (** Values of type [hook] represent hooks that have been added, so that they
+      can be removed later (if needed). *)
+
+  val add_first : (unit -> unit kind) -> hook
+  (** Adds a hook to the hook sequence underlying this module, to be run
+      {e first}, before any other hooks already added. *)
+
+  val add_last : (unit -> unit kind) -> hook
+  (** Adds a hook to the hook sequence underlying this module, to be run
+      {e last}, after any other hooks already added. *)
+
+  val remove : hook -> unit
+  (** Removes a hook added by {!add_first} or {!add_last}. *)
+
+  val remove_all : unit -> unit
+  (** Removes all hooks from the hook sequence underlying this module. *)
+end
+
+(** Hooks, of type [unit -> unit], that are called before each iteration of the
+    Lwt main loop. *)
+module Enter_iter_hooks :
+  Hooks with type 'return_value kind = 'return_value
+
+(** Hooks, of type [unit -> unit], that are called after each iteration of the
+    Lwt main loop. *)
+module Leave_iter_hooks :
+  Hooks with type 'return_value kind = 'return_value
+
+(** Promise-returning hooks, of type [unit -> unit Lwt.t], that are called at
+    process exit. Exceptions raised by these hooks are ignored. *)
+module Exit_hooks :
+  Hooks with type 'return_value kind = 'return_value Lwt.t
+
+
+
 [@@@ocaml.warning "-3"]
 
 val enter_iter_hooks : (unit -> unit) Lwt_sequence.t
-  (** Functions that are called before the main iteration. *)
+  [@@ocaml.deprecated
+    " Use module Lwt_main.Enter_iter_hooks."]
+(** @deprecated Use module {!Enter_iter_hooks}. *)
 
 val leave_iter_hooks : (unit -> unit) Lwt_sequence.t
-  (** Functions that are called after the main iteration. *)
+  [@@ocaml.deprecated
+    " Use module Lwt_main.Leave_iter_hooks."]
+(** @deprecated Use module {!Leave_iter_hooks}. *)
 
 val exit_hooks : (unit -> unit Lwt.t) Lwt_sequence.t
-  (** Sets of functions executed just before the program exit.
-
-      Notes:
-      - each hook is called exactly one time
-      - exceptions raised by hooks are ignored *)
+  [@@ocaml.deprecated
+    " Use module Lwt_main.Exit_hooks."]
+(** @deprecated Use module {!Exit_hooks}. *)
 
 [@@@ocaml.warning "+3"]
 
+
+
 val at_exit : (unit -> unit Lwt.t) -> unit
-  (** [at_exit hook] adds hook at the left of [exit_hooks]*)
+(** [Lwt_main.at_exit hook] is the same as
+    [ignore (Lwt_main.Exit_hooks.add_first hook)]. *)