From 46242cd8178a1a2753e19e6bf6a4c68d9297a304 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 11 Apr 2025 12:25:47 -0400 Subject: [PATCH] format --- bench/dune | 33 +++--- dune | 11 +- src/core/collector.ml | 41 ++++---- src/core/dune | 22 ++-- src/core/gen/dune | 3 +- src/core/level.ml | 15 ++- src/core/trace_core.mli | 155 ++++++++++++++-------------- src/core/types.ml | 28 ++--- src/dune | 4 +- src/fuchsia/bg_thread.ml | 5 +- src/fuchsia/dune | 22 ++-- src/fuchsia/fcollector.ml | 4 +- src/fuchsia/trace_fuchsia.mli | 41 ++++---- src/fuchsia/write/dune | 16 +-- src/ppx/dune | 4 +- src/ppx/ppx_trace.ml | 28 ++--- src/subscriber/callbacks.ml | 43 ++++---- src/subscriber/dune | 29 +++--- src/subscriber/subscriber.ml | 14 +-- src/subscriber/trace_subscriber.ml | 4 +- src/subscriber/trace_subscriber.mli | 12 +-- src/tef-tldrs/trace_tef_tldrs.mli | 36 +++---- src/tef/trace_tef.mli | 32 +++--- src/util/b_queue.mli | 5 +- src/util/dune | 24 +++-- test/dune | 22 ++-- test/fuchsia/write/dune | 7 +- 27 files changed, 333 insertions(+), 327 deletions(-) diff --git a/bench/dune b/bench/dune index 837ef79..31c0547 100644 --- a/bench/dune +++ b/bench/dune @@ -1,22 +1,23 @@ +(executable + (name trace1) + (modules trace1) + (libraries trace.core trace-tef)) (executable - (name trace1) - (modules trace1) - (libraries trace.core trace-tef)) + (name trace_fx) + (modules trace_fx) + (preprocess + (pps ppx_trace)) + (libraries trace.core trace-fuchsia)) (executable - (name trace_fx) - (modules trace_fx) - (preprocess (pps ppx_trace)) - (libraries trace.core trace-fuchsia)) + (name trace_tldrs) + (modules trace_tldrs) + (preprocess + (pps ppx_trace)) + (libraries trace.core trace-tef.tldrs)) (executable - (name trace_tldrs) - (modules trace_tldrs) - (preprocess (pps ppx_trace)) - (libraries trace.core trace-tef.tldrs)) - -(executable - (name bench_fuchsia_write) - (modules bench_fuchsia_write) - (libraries benchmark trace-fuchsia.write)) + (name bench_fuchsia_write) + (modules bench_fuchsia_write) + (libraries benchmark trace-fuchsia.write)) diff --git a/dune b/dune index db65d82..d284422 100644 --- a/dune +++ b/dune @@ -1,4 +1,9 @@ - (env - (_ (flags :standard -strict-sequence -warn-error -a+8+26+27 -w +a-4-40-42-44-70))) - + (_ + (flags + :standard + -strict-sequence + -warn-error + -a+8+26+27 + -w + +a-4-40-42-44-70))) diff --git a/src/core/collector.ml b/src/core/collector.ml index 72d8755..59d36d4 100644 --- a/src/core/collector.ml +++ b/src/core/collector.ml @@ -1,9 +1,8 @@ (** A global collector. - The collector, if present, is responsible for collecting messages - and spans, and storing them, recording them, forward them, or - offering them to other services and processes. -*) + The collector, if present, is responsible for collecting messages and spans, + and storing them, recording them, forward them, or offering them to other + services and processes. *) open Types @@ -30,7 +29,7 @@ module type S = sig (span -> 'a) -> 'a (** Run the function in a new span. - @since 0.3 *) + @since 0.3 *) val enter_span : __FUNCTION__:string option -> @@ -39,14 +38,14 @@ module type S = sig data:(string * user_data) list -> string -> span - (** Enter a new implicit span. For many uses cases, {!with_span} will - be easier to use. + (** Enter a new implicit span. For many uses cases, {!with_span} will be + easier to use. @since 0.6 *) val exit_span : span -> unit - (** Exit span. This should be called on the same thread - as the corresponding {!enter_span}, and nest properly with - other calls to enter/exit_span and {!with_span}. + (** Exit span. This should be called on the same thread as the corresponding + {!enter_span}, and nest properly with other calls to enter/exit_span and + {!with_span}. @since 0.6 *) val enter_manual_span : @@ -58,16 +57,16 @@ module type S = sig data:(string * user_data) list -> string -> explicit_span - (** Enter an explicit span. Surrounding scope, if any, is provided by [parent], - and this function can store as much metadata as it wants in the hmap - in the {!explicit_span}'s [meta] field. + (** Enter an explicit span. Surrounding scope, if any, is provided by + [parent], and this function can store as much metadata as it wants in the + hmap in the {!explicit_span}'s [meta] field. - {b NOTE} the [parent] argument is now an {!explicit_span_ctx} and not - an {!explicit_span} since NEXT_RELEASE. + {b NOTE} the [parent] argument is now an {!explicit_span_ctx} and not an + {!explicit_span} since NEXT_RELEASE. - This means that the collector doesn't need to implement contextual - storage mapping {!span} to scopes, metadata, etc. on its side; - everything can be transmitted in the {!explicit_span}. + This means that the collector doesn't need to implement contextual storage + mapping {!span} to scopes, metadata, etc. on its side; everything can be + transmitted in the {!explicit_span}. @since 0.3 *) val exit_manual_span : explicit_span -> unit @@ -76,6 +75,7 @@ module type S = sig val add_data_to_span : span -> (string * user_data) list -> unit (** @since Adds data to the current span. + 0.4 *) val add_data_to_manual_span : @@ -99,9 +99,8 @@ module type S = sig (** Float counter. *) val extension_event : extension_event -> unit - (** Handle an extension event. - A collector {b MUST} simple ignore events it doesn't know, - and return [()] silently. + (** Handle an extension event. A collector {b MUST} simple ignore events it + doesn't know, and return [()] silently. @since 0.8 *) val shutdown : unit -> unit diff --git a/src/core/dune b/src/core/dune index b872cef..c8eb8d2 100644 --- a/src/core/dune +++ b/src/core/dune @@ -1,15 +1,17 @@ - (library (name trace_core) (public_name trace.core) - (libraries (select meta_map.ml from - (hmap -> meta_map.hmap.ml) - (-> meta_map.ourown.ml))) - (synopsis "Lightweight stub for tracing") -) + (libraries + (select + meta_map.ml + from + (hmap -> meta_map.hmap.ml) + (-> meta_map.ourown.ml))) + (synopsis "Lightweight stub for tracing")) (rule - (targets atomic_.ml) - (action - (with-stdout-to %{targets} - (run ./gen/gen.exe --ocaml %{ocaml_version} --atomic)))) + (targets atomic_.ml) + (action + (with-stdout-to + %{targets} + (run ./gen/gen.exe --ocaml %{ocaml_version} --atomic)))) diff --git a/src/core/gen/dune b/src/core/gen/dune index cd463d8..9df6b51 100644 --- a/src/core/gen/dune +++ b/src/core/gen/dune @@ -1,3 +1,2 @@ - (executable - (name gen)) + (name gen)) diff --git a/src/core/level.ml b/src/core/level.ml index d6d7ebb..bad928d 100644 --- a/src/core/level.ml +++ b/src/core/level.ml @@ -1,16 +1,15 @@ (** Tracing levels. - This is similar to log levels in, say, [Logs]. - In a thoroughly instrumented program, there will be a {b lot} - of spans, and enabling them all in production might slow - down the application or overwhelm the tracing system; yet - they might be useful in debug situations. + This is similar to log levels in, say, [Logs]. In a thoroughly instrumented + program, there will be a {b lot} of spans, and enabling them all in + production might slow down the application or overwhelm the tracing system; + yet they might be useful in debug situations. @since 0.7 *) -(** Level of tracing. These levels are in increasing order, i.e if - level [Debug1] is enabled, everything below it (Error, Warning, Info, etc.) - are also enabled. +(** Level of tracing. These levels are in increasing order, i.e if level + [Debug1] is enabled, everything below it (Error, Warning, Info, etc.) are + also enabled. @since 0.7 *) type t = | Error (** Only errors *) diff --git a/src/core/trace_core.mli b/src/core/trace_core.mli index 4ab9152..57b97e4 100644 --- a/src/core/trace_core.mli +++ b/src/core/trace_core.mli @@ -19,16 +19,16 @@ end val enabled : unit -> bool (** Is there a collector? - This is fast, so that the traced program can check it before creating - any span or message. *) + This is fast, so that the traced program can check it before creating any + span or message. *) val get_default_level : unit -> Level.t (** Current default level for spans. @since 0.7 *) val set_default_level : Level.t -> unit -(** Set level used for spans that do not specify it. The default - default value is [Level.Trace]. +(** Set level used for spans that do not specify it. The default default value + is [Level.Trace]. @since 0.7 *) val ctx_of_span : explicit_span -> explicit_span_ctx @@ -44,22 +44,20 @@ val with_span : string -> (span -> 'a) -> 'a -(** [with_span ~__FILE__ ~__LINE__ name f] enters a new span [sp], - and calls [f sp]. - [sp] might be a dummy span if no collector is installed. - When [f sp] returns or raises, the span [sp] is exited. +(** [with_span ~__FILE__ ~__LINE__ name f] enters a new span [sp], and calls + [f sp]. [sp] might be a dummy span if no collector is installed. When [f sp] + returns or raises, the span [sp] is exited. This is the recommended way to instrument most code. - @param level optional level for this span. since 0.7. - Default is set via {!set_default_level}. + @param level + optional level for this span. since 0.7. Default is set via + {!set_default_level}. - {b NOTE} an important restriction is that this is only supposed to - work for synchronous, direct style code. Monadic concurrency, Effect-based - fibers, etc. might not play well with this style of spans on some - or all backends. If you use cooperative concurrency, - see {!enter_manual_span}. -*) + {b NOTE} an important restriction is that this is only supposed to work for + synchronous, direct style code. Monadic concurrency, Effect-based fibers, + etc. might not play well with this style of spans on some or all backends. + If you use cooperative concurrency, see {!enter_manual_span}. *) val enter_span : ?level:Level.t -> @@ -71,17 +69,17 @@ val enter_span : span (** Enter a span manually. - @param level optional level for this span. since 0.7. - Default is set via {!set_default_level}. *) + @param level + optional level for this span. since 0.7. Default is set via + {!set_default_level}. *) val exit_span : span -> unit -(** Exit a span manually. This must run on the same thread - as the corresponding {!enter_span}, and spans must nest - correctly. *) +(** Exit a span manually. This must run on the same thread as the corresponding + {!enter_span}, and spans must nest correctly. *) val add_data_to_span : span -> (string * user_data) list -> unit -(** Add structured data to the given active span (see {!with_span}). - Behavior is not specified if the span has been exited. +(** Add structured data to the given active span (see {!with_span}). Behavior is + not specified if the span has been exited. @since 0.4 *) val enter_manual_span : @@ -94,35 +92,37 @@ val enter_manual_span : ?data:(unit -> (string * user_data) list) -> string -> explicit_span -(** Like {!with_span} but the caller is responsible for - obtaining the [parent] span from their {e own} caller, and carry the resulting - {!explicit_span} to the matching {!exit_manual_span}. +(** Like {!with_span} but the caller is responsible for obtaining the [parent] + span from their {e own} caller, and carry the resulting {!explicit_span} to + the matching {!exit_manual_span}. - {b NOTE} this replaces [enter_manual_sub_span] and [enter_manual_toplevel_span] - by just making [parent] an explicit option. It is breaking anyway because we now pass - an {!explicit_span_ctx} instead of a full {!explicit_span} (the reason being that we - might receive this explicit_span_ctx from another process or machine). + {b NOTE} this replaces [enter_manual_sub_span] and + [enter_manual_toplevel_span] by just making [parent] an explicit option. It + is breaking anyway because we now pass an {!explicit_span_ctx} instead of a + full {!explicit_span} (the reason being that we might receive this + explicit_span_ctx from another process or machine). - @param flavor a description of the span that can be used by the {!Collector.S} - to decide how to represent the span. Typically, [`Sync] spans - start and stop on one thread, and are nested purely by their timestamp; - and [`Async] spans can overlap, migrate between threads, etc. (as happens in - Lwt, Eio, Async, etc.) which impacts how the collector might represent them. - @param level optional level for this span. since 0.7. - Default is set via {!set_default_level}. + @param flavor + a description of the span that can be used by the {!Collector.S} to decide + how to represent the span. Typically, [`Sync] spans start and stop on one + thread, and are nested purely by their timestamp; and [`Async] spans can + overlap, migrate between threads, etc. (as happens in Lwt, Eio, Async, + etc.) which impacts how the collector might represent them. + @param level + optional level for this span. since 0.7. Default is set via + {!set_default_level}. @since NEXT_RELEASE *) val exit_manual_span : explicit_span -> unit -(** Exit an explicit span. This can be on another thread, in a - fiber or lightweight thread, etc. and will be supported by backends - nonetheless. - The span can be obtained via {!enter_manual_sub_span} or +(** Exit an explicit span. This can be on another thread, in a fiber or + lightweight thread, etc. and will be supported by backends nonetheless. The + span can be obtained via {!enter_manual_sub_span} or {!enter_manual_toplevel_span}. @since 0.3 *) val add_data_to_manual_span : explicit_span -> (string * user_data) list -> unit -(** [add_data_explicit esp data] adds [data] to the span [esp]. - The behavior is not specified is the span has been exited already. +(** [add_data_explicit esp data] adds [data] to the span [esp]. The behavior is + not specified is the span has been exited already. @since 0.4 *) val message : @@ -131,11 +131,13 @@ val message : ?data:(unit -> (string * user_data) list) -> string -> unit -(** [message msg] logs a message [msg] (if a collector is installed). - Additional metadata can be provided. - @param level optional level for this span. since 0.7. - Default is set via {!set_default_level}. - @param span the surrounding span, if any. This might be ignored by the collector. *) +(** [message msg] logs a message [msg] (if a collector is installed). Additional + metadata can be provided. + @param level + optional level for this span. since 0.7. Default is set via + {!set_default_level}. + @param span + the surrounding span, if any. This might be ignored by the collector. *) val messagef : ?level:Level.t -> @@ -144,20 +146,19 @@ val messagef : ((('a, Format.formatter, unit, unit) format4 -> 'a) -> unit) -> unit (** [messagef (fun k->k"hello %s %d!" "world" 42)] is like - [message "hello world 42!"] but only computes the string formatting - if a collector is installed. - @param level optional level for this span. since 0.7. - Default is set via {!set_default_level}. *) + [message "hello world 42!"] but only computes the string formatting if a + collector is installed. + @param level + optional level for this span. since 0.7. Default is set via + {!set_default_level}. *) val set_thread_name : string -> unit -(** Give a name to the current thread. - This might be used by the collector - to display traces in a more informative way. *) +(** Give a name to the current thread. This might be used by the collector to + display traces in a more informative way. *) val set_process_name : string -> unit -(** Give a name to the current process. - This might be used by the collector - to display traces in a more informative way. *) +(** Give a name to the current process. This might be used by the collector to + display traces in a more informative way. *) val counter_int : ?level:Level.t -> @@ -165,10 +166,11 @@ val counter_int : string -> int -> unit -(** Emit a counter of type [int]. Counters represent the evolution of some quantity - over time. - @param level optional level for this span. since 0.7. - Default is set via {!set_default_level}. +(** Emit a counter of type [int]. Counters represent the evolution of some + quantity over time. + @param level + optional level for this span. since 0.7. Default is set via + {!set_default_level}. @param data metadata for this metric (since 0.4) *) val counter_float : @@ -178,8 +180,9 @@ val counter_float : float -> unit (** Emit a counter of type [float]. See {!counter_int} for more details. - @param level optional level for this span. since 0.7. - Default is set via {!set_default_level}. + @param level + optional level for this span. since 0.7. Default is set via + {!set_default_level}. @param data metadata for this metric (since 0.4) *) (** {2 Collector} *) @@ -191,32 +194,30 @@ type collector = (module Collector.S) val setup_collector : collector -> unit (** [setup_collector c] installs [c] as the current collector. - @raise Invalid_argument if there already is an established - collector. *) + @raise Invalid_argument if there already is an established collector. *) val get_current_level : unit -> Level.t -(** Get current level. This is only meaningful if - a collector was set up with {!setup_collector}. +(** Get current level. This is only meaningful if a collector was set up with + {!setup_collector}. @since 0.7 *) val set_current_level : Level.t -> unit -(** Set the current level of tracing. This only has a visible - effect if a collector was installed with {!setup_collector}. +(** Set the current level of tracing. This only has a visible effect if a + collector was installed with {!setup_collector}. @since 0.7 *) val shutdown : unit -> unit -(** [shutdown ()] shutdowns the current collector, if one was installed, - and waits for it to terminate before returning. *) +(** [shutdown ()] shutdowns the current collector, if one was installed, and + waits for it to terminate before returning. *) (** {2 Extensions} *) type extension_event = Types.extension_event = .. (** Extension event - @since 0.8 *) + @since 0.8 *) val extension_event : extension_event -> unit -(** Trigger an extension event, whose meaning depends on - the library that defines it. Some collectors will - simply ignore it. This does nothing if no collector - is setup. +(** Trigger an extension event, whose meaning depends on the library that + defines it. Some collectors will simply ignore it. This does nothing if no + collector is setup. @since 0.8 *) diff --git a/src/core/types.ml b/src/core/types.ml index f8a08ca..047a4eb 100644 --- a/src/core/types.ml +++ b/src/core/types.ml @@ -4,8 +4,8 @@ type span = int64 The meaning of the identifier depends on the collector. *) type trace_id = string -(** A bytestring representing a (possibly distributed) trace made of async spans. - With opentelemetry this is 16 bytes. +(** A bytestring representing a (possibly distributed) trace made of async + spans. With opentelemetry this is 16 bytes. @since NEXT_RELEASE *) type user_data = @@ -15,8 +15,8 @@ type user_data = | `Float of float | `None ] -(** User defined data, generally passed as key/value pairs to - whatever collector is installed (if any). *) +(** User defined data, generally passed as key/value pairs to whatever collector + is installed (if any). *) type explicit_span_ctx = { span: span; (** The current span *) @@ -28,18 +28,18 @@ type explicit_span_ctx = { type explicit_span = { span: span; (** Identifier for this span. Several explicit spans might share the same - identifier since we can differentiate between them via [meta]. *) + identifier since we can differentiate between them via [meta]. *) trace_id: trace_id; (** The trace this belongs to *) mutable meta: Meta_map.t; - (** Metadata for this span (and its context). This can be used by collectors to - carry collector-specific information from the beginning - of the span, to the end of the span. *) + (** Metadata for this span (and its context). This can be used by + collectors to carry collector-specific information from the beginning + of the span, to the end of the span. *) } -(** Explicit span, with collector-specific metadata. - This is richer than {!explicit_span_ctx} but not intended to be passed around - (or sent across the wire), unlike {!explicit_span_ctx}. *) +(** Explicit span, with collector-specific metadata. This is richer than + {!explicit_span_ctx} but not intended to be passed around (or sent across + the wire), unlike {!explicit_span_ctx}. *) type extension_event = .. -(** An extension event, used to add features that are backend specific - or simply not envisioned by [trace]. - @since 0.8 *) +(** An extension event, used to add features that are backend specific or simply + not envisioned by [trace]. + @since 0.8 *) diff --git a/src/dune b/src/dune index 2f777e2..ccc58e6 100644 --- a/src/dune +++ b/src/dune @@ -2,5 +2,5 @@ (name trace) (public_name trace) (synopsis "Lightweight stub for tracing") - (libraries (re_export trace.core)) -) + (libraries + (re_export trace.core))) diff --git a/src/fuchsia/bg_thread.ml b/src/fuchsia/bg_thread.ml index ecaf1c0..631a1db 100644 --- a/src/fuchsia/bg_thread.ml +++ b/src/fuchsia/bg_thread.ml @@ -51,9 +51,8 @@ let bg_thread ~buf_pool ~out ~(events : event B_queue.t) () : unit = let st = { oc; buf_pool; events } in bg_loop st -(** Thread that simply regularly "ticks", sending events to - the background thread so it has a chance to write to the file, - and call [f()] *) +(** Thread that simply regularly "ticks", sending events to the background + thread so it has a chance to write to the file, and call [f()] *) let tick_thread events : unit = try while true do diff --git a/src/fuchsia/dune b/src/fuchsia/dune index a63403b..8e4f0f4 100644 --- a/src/fuchsia/dune +++ b/src/fuchsia/dune @@ -1,9 +1,15 @@ - - (library - (name trace_fuchsia) - (public_name trace-fuchsia) - (synopsis "A high-performance backend for trace, emitting a Fuchsia trace into a file") - (libraries trace.core trace.private.util thread-local-storage - (re_export trace-fuchsia.write) bigarray - mtime mtime.clock.os unix threads)) + (name trace_fuchsia) + (public_name trace-fuchsia) + (synopsis + "A high-performance backend for trace, emitting a Fuchsia trace into a file") + (libraries + trace.core + trace.private.util + thread-local-storage + (re_export trace-fuchsia.write) + bigarray + mtime + mtime.clock.os + unix + threads)) diff --git a/src/fuchsia/fcollector.ml b/src/fuchsia/fcollector.ml index d07e997..c2fc367 100644 --- a/src/fuchsia/fcollector.ml +++ b/src/fuchsia/fcollector.ml @@ -135,8 +135,8 @@ type state = { buf_pool: Buf_pool.t; next_thread_ref: int A.t; (** in [0x01 .. 0xff], to allocate thread refs *) per_thread: per_thread_state Int_map.t A.t array; - (** the state keeps tabs on thread-local state, so it can flush writers - at the end. This is a tid-sharded array of maps. *) + (** the state keeps tabs on thread-local state, so it can flush writers at + the end. This is a tid-sharded array of maps. *) } let[@inline] mk_trace_id (self : state) : trace_id = diff --git a/src/fuchsia/trace_fuchsia.mli b/src/fuchsia/trace_fuchsia.mli index a104ec3..eaf1847 100644 --- a/src/fuchsia/trace_fuchsia.mli +++ b/src/fuchsia/trace_fuchsia.mli @@ -1,15 +1,15 @@ (** Fuchsia trace collector. - This provides a collector for traces that emits data into a file - using the compact binary - {{:https://fuchsia.dev/fuchsia-src/reference/tracing/trace-format} Fuchsia trace format}. - This reduces the tracing overhead compared to [trace-tef], at the expense of simplicity. -*) + This provides a collector for traces that emits data into a file using the + compact binary + {{:https://fuchsia.dev/fuchsia-src/reference/tracing/trace-format} Fuchsia + trace format}. This reduces the tracing overhead compared to [trace-tef], + at the expense of simplicity. *) val collector : out:[ `File of string | `Stderr | `Stdout ] -> unit -> Trace_core.collector -(** Make a collector that writes into the given output. - See {!setup} for more details. *) +(** Make a collector that writes into the given output. See {!setup} for more + details. *) type output = [ `Stdout @@ -20,29 +20,26 @@ type output = - [`Stdout] will enable tracing and print events on stdout - [`Stderr] will enable tracing and print events on stderr - - [`File "foo"] will enable tracing and print events into file - named "foo" + - [`File "foo"] will enable tracing and print events into file named "foo" *) val setup : ?out:[ output | `Env ] -> unit -> unit (** [setup ()] installs the collector depending on [out]. - @param out can take different values: - - regular {!output} value to specify where events go - - [`Env] will enable tracing if the environment - variable "TRACE" is set. + @param out + can take different values: + - regular {!output} value to specify where events go + - [`Env] will enable tracing if the environment variable "TRACE" is set. - - If it's set to "1", then the file is "trace.fxt". - - If it's set to "stdout", then logging happens on stdout (since 0.2) - - If it's set to "stderr", then logging happens on stdout (since 0.2) - - Otherwise, if it's set to a non empty string, the value is taken - to be the file path into which to write. -*) + - If it's set to "1", then the file is "trace.fxt". + - If it's set to "stdout", then logging happens on stdout (since 0.2) + - If it's set to "stderr", then logging happens on stdout (since 0.2) + - Otherwise, if it's set to a non empty string, the value is taken to be the + file path into which to write. *) val with_setup : ?out:[ output | `Env ] -> unit -> (unit -> 'a) -> 'a -(** [with_setup () f] (optionally) sets a collector up, calls [f()], - and makes sure to shutdown before exiting. -*) +(** [with_setup () f] (optionally) sets a collector up, calls [f()], and makes + sure to shutdown before exiting. *) (**/**) diff --git a/src/fuchsia/write/dune b/src/fuchsia/write/dune index e7b410d..88acba8 100644 --- a/src/fuchsia/write/dune +++ b/src/fuchsia/write/dune @@ -1,9 +1,9 @@ - (library - (name trace_fuchsia_write) - (public_name trace-fuchsia.write) - (synopsis "Serialization part of trace-fuchsia") - (ocamlopt_flags :standard - ;-dlambda - ) - (libraries trace.core threads)) + (name trace_fuchsia_write) + (public_name trace-fuchsia.write) + (synopsis "Serialization part of trace-fuchsia") + (ocamlopt_flags + :standard + ;-dlambda + ) + (libraries trace.core threads)) diff --git a/src/ppx/dune b/src/ppx/dune index 451c5fc..2eaed92 100644 --- a/src/ppx/dune +++ b/src/ppx/dune @@ -1,8 +1,8 @@ - (library (name ppx_trace) (public_name ppx_trace) (kind ppx_rewriter) - (preprocess (pps ppxlib.metaquot)) + (preprocess + (pps ppxlib.metaquot)) (ppx_runtime_libraries trace.core) (libraries ppxlib)) diff --git a/src/ppx/ppx_trace.ml b/src/ppx/ppx_trace.ml index af2dab3..fd84497 100644 --- a/src/ppx/ppx_trace.ml +++ b/src/ppx/ppx_trace.ml @@ -37,19 +37,19 @@ let expand_let ~ctxt (var : [ `Var of label loc | `Unit ]) (name : string) body let extension_let = Extension.V3.declare "trace" Extension.Context.expression (let open! Ast_pattern in - single_expr_payload - (pexp_let nonrecursive - (value_binding - ~pat: - (let pat_var = ppat_var __' |> map ~f:(fun f v -> f (`Var v)) in - let pat_unit = - as__ @@ ppat_construct (lident (string "()")) none - |> map ~f:(fun f _ -> f `Unit) - in - alt pat_var pat_unit) - ~expr:(estring __) - ^:: nil) - __)) + single_expr_payload + (pexp_let nonrecursive + (value_binding + ~pat: + (let pat_var = ppat_var __' |> map ~f:(fun f v -> f (`Var v)) in + let pat_unit = + as__ @@ ppat_construct (lident (string "()")) none + |> map ~f:(fun f _ -> f `Unit) + in + alt pat_var pat_unit) + ~expr:(estring __) + ^:: nil) + __)) expand_let let rule_let = Ppxlib.Context_free.Rule.extension extension_let @@ -90,7 +90,7 @@ let expand_top_let ~ctxt rec_flag (vbs : _ list) = let extension_top_let = Extension.V3.declare "trace" Extension.Context.structure_item (let open! Ast_pattern in - pstr (pstr_value __ __ ^:: nil)) + pstr (pstr_value __ __ ^:: nil)) expand_top_let let rule_top_let = Ppxlib.Context_free.Rule.extension extension_top_let diff --git a/src/subscriber/callbacks.ml b/src/subscriber/callbacks.ml index a90d4db..5d2c759 100644 --- a/src/subscriber/callbacks.ml +++ b/src/subscriber/callbacks.ml @@ -1,25 +1,25 @@ (** Callbacks used for subscribers. - Each subscriber defines a set of callbacks, for each possible - tracing event. These callbacks take a custom state that is paired - with the callbacks in {!Subscriber.t}. + Each subscriber defines a set of callbacks, for each possible tracing event. + These callbacks take a custom state that is paired with the callbacks in + {!Subscriber.t}. - To use a default implementation for some callbacks, use: + To use a default implementation for some callbacks, use: - {[ - module My_callbacks = struct - type st = … + {[ + module My_callbacks = struct + type st = … - include Trace_subscriber.Callbacks.Dummy + include Trace_subscriber.Callbacks.Dummy - let on_init (state:st) ~time_ns : unit = … + let on_init (state:st) ~time_ns : unit = … - (* … other custom callbacks … *) - end ]} + (* … other custom callbacks … *) + end + ]} - {b NOTE}: the [trace_id] passed alongside manual spans is guaranteed to be at - least 64 bits. -*) + {b NOTE}: the [trace_id] passed alongside manual spans is guaranteed to be + at least 64 bits. *) open Trace_core open Types @@ -55,7 +55,8 @@ module type S = sig (** Enter a regular (sync) span *) val on_exit_span : st -> time_ns:float -> tid:int -> span -> unit - (** Exit a span. This and [on_enter_span] must follow strict stack discipline *) + (** Exit a span. This and [on_enter_span] must follow strict stack discipline + *) val on_add_data : st -> data:(string * user_data) list -> span -> unit (** Add data to a regular span (which must be active) *) @@ -115,14 +116,12 @@ module type S = sig end type 'st t = (module S with type st = 'st) -(** Callbacks for a subscriber. There is one callback per event - in {!Trace}. The type ['st] is the state that is passed to - every single callback. *) +(** Callbacks for a subscriber. There is one callback per event in {!Trace}. The + type ['st] is the state that is passed to every single callback. *) -(** Dummy callbacks. - It can be useful to reuse some of these functions in a - real subscriber that doesn't want to handle {b all} - events, but only some of them. *) +(** Dummy callbacks. It can be useful to reuse some of these functions in a real + subscriber that doesn't want to handle {b all} events, but only some of + them. *) module Dummy = struct let on_init _ ~time_ns:_ = () let on_shutdown _ ~time_ns:_ = () diff --git a/src/subscriber/dune b/src/subscriber/dune index 30c53d6..478132a 100644 --- a/src/subscriber/dune +++ b/src/subscriber/dune @@ -1,14 +1,17 @@ - (library - (name trace_subscriber) - (public_name trace.subscriber) - (libraries (re_export trace.core) - (select thread_.ml from - (threads -> thread_.real.ml) - ( -> thread_.dummy.ml)) - (select time_.ml from - (mtime mtime.clock.os -> time_.mtime.ml) - (mtime mtime.clock.jsoo -> time_.mtime.ml) - (unix -> time_.unix.ml) - ( -> time_.dummy.ml)))) - + (name trace_subscriber) + (public_name trace.subscriber) + (libraries + (re_export trace.core) + (select + thread_.ml + from + (threads -> thread_.real.ml) + (-> thread_.dummy.ml)) + (select + time_.ml + from + (mtime mtime.clock.os -> time_.mtime.ml) + (mtime mtime.clock.jsoo -> time_.mtime.ml) + (unix -> time_.unix.ml) + (-> time_.dummy.ml)))) diff --git a/src/subscriber/subscriber.ml b/src/subscriber/subscriber.ml index 7230c3a..2b68296 100644 --- a/src/subscriber/subscriber.ml +++ b/src/subscriber/subscriber.ml @@ -1,8 +1,8 @@ (** 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.). +(** 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. *) @@ -105,14 +105,14 @@ open struct end end -(** [tee s1 s2] is a subscriber that forwards every - call to [s1] and [s2] both. *) +(** [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]. *) +(** 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 diff --git a/src/subscriber/trace_subscriber.ml b/src/subscriber/trace_subscriber.ml index 84f5cfd..b287d69 100644 --- a/src/subscriber/trace_subscriber.ml +++ b/src/subscriber/trace_subscriber.ml @@ -30,8 +30,8 @@ open struct mutable data: (string * user_data) list; } - (** Key used to carry some information between begin and end of - manual spans, by way of the meta map *) + (** Key used to carry some information between begin and end of manual spans, + by way of the meta map *) let key_manual_info : manual_span_info Meta_map.key = Meta_map.Key.create () end diff --git a/src/subscriber/trace_subscriber.mli b/src/subscriber/trace_subscriber.mli index 45b9978..a46bbeb 100644 --- a/src/subscriber/trace_subscriber.mli +++ b/src/subscriber/trace_subscriber.mli @@ -1,12 +1,10 @@ (** Generic subscribers. - This defines the notion of a {b subscriber}, - a set of callbacks for every trace event. - It also defines a collector that needs to be installed - for the subscriber(s) to be called. + This defines the notion of a {b subscriber}, a set of callbacks for every + trace event. It also defines a collector that needs to be installed for the + subscriber(s) to be called. - @since 0.8 -*) + @since 0.8 *) module Callbacks = Callbacks module Subscriber = Subscriber @@ -22,7 +20,7 @@ type t = Subscriber.t val collector : t -> Trace_core.collector (** A collector that calls the subscriber's callbacks. - It uses [mtime] (if available) to obtain timestamps. *) + It uses [mtime] (if available) to obtain timestamps. *) (**/**) diff --git a/src/tef-tldrs/trace_tef_tldrs.mli b/src/tef-tldrs/trace_tef_tldrs.mli index 79fd841..14f7825 100644 --- a/src/tef-tldrs/trace_tef_tldrs.mli +++ b/src/tef-tldrs/trace_tef_tldrs.mli @@ -1,8 +1,9 @@ -(** Emit traces by talking to the {{: https://github.com/imandra-ai/tldrs} tldrs} daemon *) +(** Emit traces by talking to the {{:https://github.com/imandra-ai/tldrs} tldrs} + daemon *) val collector : out:[ `File of string ] -> unit -> Trace_core.collector -(** Make a collector that writes into the given output. - See {!setup} for more details. *) +(** Make a collector that writes into the given output. See {!setup} for more + details. *) val subscriber : out:[ `File of string ] -> unit -> Trace_subscriber.t (** Make a subscriber that writes into the given output. @@ -10,29 +11,26 @@ val subscriber : out:[ `File of string ] -> unit -> Trace_subscriber.t type output = [ `File of string ] (** Output for tracing. - - [`File "foo"] will enable tracing and print events into file - named "foo". The file is only written at exit. -*) + - [`File "foo"] will enable tracing and print events into file named "foo". + The file is only written at exit. *) val setup : ?out:[ output | `Env ] -> unit -> unit (** [setup ()] installs the collector depending on [out]. - @param out can take different values: - - regular {!output} value to specify where events go - - [`Env] will enable tracing if the environment - variable "TRACE" is set. + @param out + can take different values: + - regular {!output} value to specify where events go + - [`Env] will enable tracing if the environment variable "TRACE" is set. - - If it's set to "1", then the file is "trace.json". - - If it's set to "stdout", then logging happens on stdout (since 0.2) - - If it's set to "stderr", then logging happens on stdout (since 0.2) - - Otherwise, if it's set to a non empty string, the value is taken - to be the file path into which to write. -*) + - If it's set to "1", then the file is "trace.json". + - If it's set to "stdout", then logging happens on stdout (since 0.2) + - If it's set to "stderr", then logging happens on stdout (since 0.2) + - Otherwise, if it's set to a non empty string, the value is taken to be the + file path into which to write. *) val with_setup : ?out:[ output | `Env ] -> unit -> (unit -> 'a) -> 'a -(** [with_setup () f] (optionally) sets a collector up, calls [f()], - and makes sure to shutdown before exiting. -*) +(** [with_setup () f] (optionally) sets a collector up, calls [f()], and makes + sure to shutdown before exiting. *) (**/**) diff --git a/src/tef/trace_tef.mli b/src/tef/trace_tef.mli index c2e5ab4..d5741fd 100644 --- a/src/tef/trace_tef.mli +++ b/src/tef/trace_tef.mli @@ -7,8 +7,7 @@ type output = - [`Stdout] will enable tracing and print events on stdout - [`Stderr] will enable tracing and print events on stderr - - [`File "foo"] will enable tracing and print events into file - named "foo" + - [`File "foo"] will enable tracing and print events into file named "foo" *) val subscriber : out:[< output ] -> unit -> Trace_subscriber.t @@ -16,29 +15,26 @@ val subscriber : out:[< output ] -> unit -> Trace_subscriber.t @since 0.8 *) val collector : out:[< output ] -> unit -> Trace_core.collector -(** Make a collector that writes into the given output. - See {!setup} for more details. *) +(** Make a collector that writes into the given output. See {!setup} for more + details. *) val setup : ?out:[ output | `Env ] -> unit -> unit (** [setup ()] installs the collector depending on [out]. - @param out can take different values: - - regular {!output} value to specify where events go - - [`Env] will enable tracing if the environment - variable "TRACE" is set. + @param out + can take different values: + - regular {!output} value to specify where events go + - [`Env] will enable tracing if the environment variable "TRACE" is set. - - If it's set to "1", then the file is "trace.json". - - If it's set to "stdout", then logging happens on stdout (since 0.2) - - If it's set to "stderr", then logging happens on stdout (since 0.2) - - Otherwise, if it's set to a non empty string, the value is taken - to be the file path into which to write. -*) + - If it's set to "1", then the file is "trace.json". + - If it's set to "stdout", then logging happens on stdout (since 0.2) + - If it's set to "stderr", then logging happens on stdout (since 0.2) + - Otherwise, if it's set to a non empty string, the value is taken to be the + file path into which to write. *) val with_setup : ?out:[ output | `Env ] -> unit -> (unit -> 'a) -> 'a -(** [with_setup () f] (optionally) sets a collector up, calls [f()], - and makes sure to shutdown before exiting. - since 0.2 a () argument was added. -*) +(** [with_setup () f] (optionally) sets a collector up, calls [f()], and makes + sure to shutdown before exiting. since 0.2 a () argument was added. *) (**/**) diff --git a/src/util/b_queue.mli b/src/util/b_queue.mli index cf3abb2..1fb8f5c 100644 --- a/src/util/b_queue.mli +++ b/src/util/b_queue.mli @@ -11,9 +11,8 @@ val push : 'a t -> 'a -> unit @raise Closed if [close q] was previously called.*) val pop_all : 'a t -> 'a list -(** [pop_all bq] returns all items presently - in [bq], in the same order, and clears [bq]. - It blocks if no element is in [bq]. *) +(** [pop_all bq] returns all items presently in [bq], in the same order, and + clears [bq]. It blocks if no element is in [bq]. *) val close : _ t -> unit (** Close the queue, meaning there won't be any more [push] allowed. *) diff --git a/src/util/dune b/src/util/dune index 0c08d4c..1e4de44 100644 --- a/src/util/dune +++ b/src/util/dune @@ -1,10 +1,16 @@ - (library - (public_name trace.private.util) - (synopsis "internal utilities for trace. No guarantees of stability.") - (name trace_private_util) - (optional) ; depends on mtime - (libraries trace.core mtime mtime.clock.os unix threads - (select domain_util.ml from - (base-domain -> domain_util.real.ml) - ( -> domain_util.dummy.ml)))) + (public_name trace.private.util) + (synopsis "internal utilities for trace. No guarantees of stability.") + (name trace_private_util) + (optional) ; depends on mtime + (libraries + trace.core + mtime + mtime.clock.os + unix + threads + (select + domain_util.ml + from + (base-domain -> domain_util.real.ml) + (-> domain_util.dummy.ml)))) diff --git a/test/dune b/test/dune index e52a276..1b3d26d 100644 --- a/test/dune +++ b/test/dune @@ -1,13 +1,13 @@ +(test + (name t1) + (package trace-tef) + (modules t1) + (libraries trace trace-tef)) (test - (name t1) - (package trace-tef) - (modules t1) - (libraries trace trace-tef)) - -(test - (name t2) - (package ppx_trace) - (modules t2) - (preprocess (pps ppx_trace)) - (libraries trace-tef)) + (name t2) + (package ppx_trace) + (modules t2) + (preprocess + (pps ppx_trace)) + (libraries trace-tef)) diff --git a/test/fuchsia/write/dune b/test/fuchsia/write/dune index 1261c4b..b277755 100644 --- a/test/fuchsia/write/dune +++ b/test/fuchsia/write/dune @@ -1,5 +1,4 @@ - (tests - (names t1 t2) - (package trace-fuchsia) - (libraries trace-fuchsia.write)) + (names t1 t2) + (package trace-fuchsia) + (libraries trace-fuchsia.write))