documentation and untap

AMENDED: More realistic code example at a more helpful place.

src/lib_stdlib/logging.ml

@@ -24,11 +24,26 @@ type log_message = {
   tags : Tag.set ;
 }
 
-let taps : (log_message -> unit) list ref = ref []
+type tap_id = int
+let next_tap : int ref = ref 0
 
-let tap f = taps := f :: !taps
+type tap = {
+  id : tap_id ;
+  process : log_message -> unit ;
+}
 
-let call_taps v = List.iter (fun f -> f v) !taps
+let taps : tap list ref = ref []
+
+let tap process = let id = !next_tap in
+  begin
+    next_tap := id + 1 ;
+    taps := { id ; process } :: !taps ;
+    id
+  end
+
+let untap x = taps := List.filter (fun tap -> tap.id <> x) !taps
+
+let call_taps v = List.iter (fun tap -> tap.process v) !taps
 
 module type SEMLOG = sig
 

src/lib_stdlib/logging.mli

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+(** Unique tag for a logging module.
+    Match against, e.g. `Logging.Core.Section`.  *)
 type log_section = private ..
 
 type log_message = {
@@ -15,7 +17,16 @@ type log_message = {
   tags : Tag.set ;
 }
 
-val tap : (log_message -> unit) -> unit
+type tap_id
+
+(** Intercept events as they are logged.  All events will generate a call to
+    your tap function, but `text` will only be included for events that
+    actually print a message according to the active logging configuration.  *)
+val tap : (log_message -> unit) -> tap_id
+
+(** Remove a previously set tap by supplying its tap_id.  Does nothing if
+    the tap was removed already.  *)
+val untap : tap_id -> unit
 
 type ('a,'b) msgf = (('a, Format.formatter, unit, 'b) format4 -> ?tags:Tag.set -> 'a) -> ?tags:Tag.set -> 'b
 type ('a,'b) log = ('a,'b) msgf -> 'b

src/lib_stdlib/tag.mli

@@ -87,10 +87,30 @@ val map : (t -> t) -> set -> set
 val mapi : (t -> t) -> set -> set
 val pp_set : Format.formatter -> set -> unit
 
+(** DSL for logging messages.  Opening this locally makes it easy to supply a number
+    of semantic tags for a log event while using their values in the human-readable
+    text.  For example:
+
+    {[
+      lwt_log_info Tag.DSL.(fun f ->
+          f "request for operations %a:%d from peer %a timed out."
+          -% t event "request_operations_timeout"
+          -% a Block_hash.Logging.tag bh
+          -% s operations_index_tag n
+          -% a P2p_peer.Id.Logging.tag pipeline.peer_id)
+    ]} *)
 module DSL : sig
   type (_,_,_,_) arg
+
+  (** Use a semantic tag with a `%a` format, supplying the pretty printer from the tag. *)
   val a : 'v def -> 'v -> (('b -> 'v -> 'c) -> 'v -> 'd, 'b, 'c, 'd) arg
+
+  (** Use a semantic tag with ordinary formats such as `%s`, `%d`, and `%f`. *)
   val s : 'v def -> 'v -> ('v -> 'd, 'b, 'c, 'd) arg
+
+  (** Supply a semantic tag without formatting it. *)
   val t : 'v def -> 'v -> ('d, 'b, 'c, 'd) arg
+
+  (** Perform the actual application of a tag to a format. *)
   val (-%) : (?tags:set -> 'a) -> ('a,Format.formatter,unit,'d) arg -> (?tags:set -> 'd)
 end