package trace

You can search for identifiers within the package.

in-package search v0.2.0

A stub for tracing/observability, agnostic in how data is collected

Install

Dune Dependency

github.com Readme Changelog Edit opam file Versions (11)

Authors

S

Simon Cruanes

Maintainers

S

Simon Cruanes

Sources

trace-0.9.tbz

sha256=1a8c75efea8a691f1e0fa3dcf59ee0bf53fad7190b9fa0babde4f9a21bc10dd6

sha512=a082b3cbf34631069855bef7b8cf5017daf08141f8794dc0ef963e7afe0812749c388553fa3d21ecb35ce75909571dfd8fc38bcc4438b7eaaa9010296f28e2fc

doc/src/trace.subscriber/subscriber.ml.html

Source file `subscriber.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
(** Trace subscribers *)

(** A trace subscriber. It pairs a set of callbacks
    with the state they need (which can contain a file handle,
    a socket to write events to, config, etc.).

    The design goal for this is that it should be possible to avoid allocations
    whenever the trace collector invokes the callbacks. *)
type t =
  | Sub : {
      st: 'st;
      callbacks: 'st Callbacks.t;
    }
      -> t

(** Dummy subscriber that ignores every call. *)
let dummy : t = Sub { st = (); callbacks = Callbacks.dummy () }

open struct
  module Tee_cb : Callbacks.S with type st = t * t = struct
    type nonrec st = t * t

    let on_init
        ( Sub { st = s1; callbacks = (module CB1) },
          Sub { st = s2; callbacks = (module CB2) } ) ~time_ns =
      CB1.on_init s1 ~time_ns;
      CB2.on_init s2 ~time_ns

    let on_shutdown
        ( Sub { st = s1; callbacks = (module CB1) },
          Sub { st = s2; callbacks = (module CB2) } ) ~time_ns =
      CB1.on_shutdown s1 ~time_ns;
      CB2.on_shutdown s2 ~time_ns

    let on_name_thread
        ( Sub { st = s1; callbacks = (module CB1) },
          Sub { st = s2; callbacks = (module CB2) } ) ~time_ns ~tid ~name =
      CB1.on_name_thread s1 ~time_ns ~tid ~name;
      CB2.on_name_thread s2 ~time_ns ~tid ~name

    let on_name_process
        ( Sub { st = s1; callbacks = (module CB1) },
          Sub { st = s2; callbacks = (module CB2) } ) ~time_ns ~tid ~name =
      CB1.on_name_process s1 ~time_ns ~tid ~name;
      CB2.on_name_process s2 ~time_ns ~tid ~name

    let on_enter_span
        ( Sub { st = s1; callbacks = (module CB1) },
          Sub { st = s2; callbacks = (module CB2) } ) ~__FUNCTION__ ~__FILE__
        ~__LINE__ ~time_ns ~tid ~data ~name span =
      CB1.on_enter_span s1 ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns ~tid ~data
        ~name span;
      CB2.on_enter_span s2 ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns ~tid ~data
        ~name span

    let on_exit_span
        ( Sub { st = s1; callbacks = (module CB1) },
          Sub { st = s2; callbacks = (module CB2) } ) ~time_ns ~tid span =
      CB1.on_exit_span s1 ~time_ns ~tid span;
      CB2.on_exit_span s2 ~time_ns ~tid span

    let on_add_data
        ( Sub { st = s1; callbacks = (module CB1) },
          Sub { st = s2; callbacks = (module CB2) } ) ~data span =
      CB1.on_add_data s1 ~data span;
      CB2.on_add_data s2 ~data span

    let on_message
        ( Sub { st = s1; callbacks = (module CB1) },
          Sub { st = s2; callbacks = (module CB2) } ) ~time_ns ~tid ~span ~data
        msg =
      CB1.on_message s1 ~time_ns ~tid ~span ~data msg;
      CB2.on_message s2 ~time_ns ~tid ~span ~data msg

    let on_counter
        ( Sub { st = s1; callbacks = (module CB1) },
          Sub { st = s2; callbacks = (module CB2) } ) ~time_ns ~tid ~data ~name
        n =
      CB1.on_counter s1 ~time_ns ~tid ~data ~name n;
      CB2.on_counter s2 ~time_ns ~tid ~data ~name n

    let on_enter_manual_span
        ( Sub { st = s1; callbacks = (module CB1) },
          Sub { st = s2; callbacks = (module CB2) } ) ~__FUNCTION__ ~__FILE__
        ~__LINE__ ~time_ns ~tid ~parent ~data ~name ~flavor ~trace_id span =
      CB1.on_enter_manual_span s1 ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns
        ~tid ~parent ~data ~name ~flavor ~trace_id span;
      CB2.on_enter_manual_span s2 ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns
        ~tid ~parent ~data ~name ~flavor ~trace_id span

    let on_exit_manual_span
        ( Sub { st = s1; callbacks = (module CB1) },
          Sub { st = s2; callbacks = (module CB2) } ) ~time_ns ~tid ~name ~data
        ~flavor ~trace_id span =
      CB1.on_exit_manual_span s1 ~time_ns ~tid ~name ~data ~flavor ~trace_id
        span;
      CB2.on_exit_manual_span s2 ~time_ns ~tid ~name ~data ~flavor ~trace_id
        span

    let on_extension_event
        ( Sub { st = s1; callbacks = (module CB1) },
          Sub { st = s2; callbacks = (module CB2) } ) ~time_ns ~tid ev : unit =
      CB1.on_extension_event s1 ~time_ns ~tid ev;
      CB2.on_extension_event s2 ~time_ns ~tid ev
  end
end

(** [tee s1 s2] is a subscriber that forwards every
    call to [s1] and [s2] both. *)
let tee (s1 : t) (s2 : t) : t =
  let st = s1, s2 in
  Sub { st; callbacks = (module Tee_cb) }

(** Tee multiple subscribers, ie return a subscriber that forwards
    to all the subscribers in [subs]. *)
let rec tee_l (subs : t list) : t =
  match subs with
  | [] -> dummy
  | [ s ] -> s
  | [ s1; s2 ] -> tee s1 s2
  | s1 :: s2 :: tl -> tee (tee s1 s2) (tee_l tl)