Cmdliner terms for ergonomic logging configuration
fix(ocaml-vlog): refactor trace reporter and fix docs
Extract write_tracing_entry helper to reduce duplication in
trace_reporter, and remove redundant .mli files for test modules.
+32
-32
+25
-24
lib/vlog.ml
+25
-24
lib/vlog.ml
···
110
110
111
111
(** {1 Trace File Reporter} *)
112
112
113
+
let level_string = function
114
+
| Logs.App -> "app"
115
+
| Logs.Error -> "error"
116
+
| Logs.Warning -> "warning"
117
+
| Logs.Info -> "info"
118
+
| Logs.Debug -> "debug"
119
+
120
+
let write_json_trace ppf ~ts ~name ~level_s msg k =
121
+
Fmt.pf ppf {|{"ts":"%s","src":"%s","level":"%s","msg":"%s"}@.|} ts name
122
+
level_s (String.escaped msg);
123
+
k ()
124
+
125
+
let write_tracing_entry ~json ppf ts name level fmt k =
126
+
if json then
127
+
Fmt.kstr
128
+
(fun msg ->
129
+
write_json_trace ppf ~ts ~name ~level_s:(level_string level) msg k)
130
+
fmt
131
+
else Fmt.kpf k ppf ("%s %s " ^^ fmt ^^ "@.") ts name
132
+
113
133
let trace_reporter ~json file_path =
114
134
let oc = open_out file_path in
115
135
let ppf = Format.formatter_of_out_channel oc in
···
126
146
k ()
127
147
in
128
148
let ts = Ptime_clock.now () |> Ptime.to_rfc3339 in
129
-
if json then
130
-
(* JSON format *)
131
-
let buf = Buffer.create 256 in
132
-
Format.kfprintf
133
-
(fun _ ->
134
-
let msg = Buffer.contents buf in
135
-
let level_s =
136
-
match level with
137
-
| Logs.App -> "app"
138
-
| Logs.Error -> "error"
139
-
| Logs.Warning -> "warning"
140
-
| Logs.Info -> "info"
141
-
| Logs.Debug -> "debug"
142
-
in
143
-
Fmt.pf ppf {|{"ts":"%s","src":"%s","level":"%s","msg":"%s"}@.|} ts
144
-
name level_s (String.escaped msg);
145
-
k ())
146
-
(Format.formatter_of_buffer buf)
147
-
fmt
148
-
else
149
-
(* Plain text format *)
150
-
Format.kfprintf k ppf ("%s %s " ^^ fmt ^^ "@.") ts name
149
+
write_tracing_entry ~json ppf ts name level fmt k
151
150
else (
152
151
over ();
153
152
k ())
···
183
182
let doc = "Output as JSON (affects both data output and logs)." in
184
183
Arg.(value & flag & info [ "json" ] ~doc)
185
184
185
+
let err_invalid_tag s =
186
+
Error (`Msg (Fmt.str "Invalid tag format '%s', expected KEY=VALUE" s))
187
+
186
188
let parse_tag s =
187
189
match String.index_opt s '=' with
188
-
| None ->
189
-
Error (`Msg (Fmt.str "Invalid tag format '%s', expected KEY=VALUE" s))
190
+
| None -> err_invalid_tag s
190
191
| Some i ->
191
192
let key = String.sub s 0 i in
192
193
let value = String.sub s (i + 1) (String.length s - i - 1) in
+7
-6
lib/vlog.mli
+7
-6
lib/vlog.mli
···
78
78
For advanced use cases where you need more control. *)
79
79
80
80
val quiet : bool Cmdliner.Term.t
81
-
(** Term for [-q]/[--quiet] flag. *)
81
+
(** [quiet] is the term for [-q]/[--quiet] flag. *)
82
82
83
83
val verbosity : bool list Cmdliner.Term.t
84
-
(** Term for [-v]/[--verbose] flags. Length indicates verbosity level. *)
84
+
(** [verbosity] is the term for [-v]/[--verbose] flags. Length indicates
85
+
verbosity level. *)
85
86
86
87
val log_term : string -> string option Cmdliner.Term.t
87
88
(** [log_term app_name] returns a term for [--log] with environment variable
···
91
92
(** Term for [--trace FILE] flag. *)
92
93
93
94
val json : bool Cmdliner.Term.t
94
-
(** Term for [--json] flag. *)
95
+
(** [json] is the term for [--json] flag. *)
95
96
96
97
val log_tags : (string * string) list Cmdliner.Term.t
97
98
(** Term for [--log-tag KEY=VALUE] flags. *)
···
106
107
Examples:
107
108
- ["debug"] -> [Some Debug, []]
108
109
- ["info,http:debug"] -> [Some Info, [("http", Some Debug)]]
109
-
- ["conpool:warning"] -> [None, [("conpool", Some Warning)]] *)
110
+
- ["conpool:warning"] -> [None, [("conpool", Some Warning)]]. *)
110
111
111
112
val apply_source_overrides : (string * Logs.level option) list -> unit
112
113
(** [apply_source_overrides overrides] sets log levels for matching sources.
···
125
126
- [quiet=true]: Error
126
127
- [verbosity=[]]: Warning
127
128
- [verbosity=[_]]: Info
128
-
- [verbosity=[_;_]] or more: Debug *)
129
+
- [verbosity=[_;_]] or more: Debug. *)
129
130
130
131
val enable_tracing : verbosity:bool list -> bool
131
132
(** [enable_tracing ~verbosity] returns [true] if verbosity >= 3 (i.e., [-vvv]).
···
169
170
This follows patterns from other languages:
170
171
- Rust: [RUST_LOG=warn,mycrate::module=debug]
171
172
- Go (IPFS): [GOLOG_LOG_LEVEL=error,subsystem=debug]
172
-
- Node.js: [DEBUG=prefix:*] or [LOG_LEVEL=debug] *)
173
+
- Node.js: [DEBUG=prefix:*] or [LOG_LEVEL=debug]. *)
-1
test/test_cli.mli
-1
test/test_cli.mli
···
1
-
(* empty *)
-1
test/test_cli_no_json.mli
-1
test/test_cli_no_json.mli
···
1
-
(* empty *)