Cmdliner terms for ergonomic logging configuration
Initial release
+395
+28
dune-project
+28
dune-project
···
1
+
(lang dune 3.0)
2
+
3
+
(name vlog)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license MIT)
8
+
9
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
11
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
12
+
13
+
(source
14
+
(github gazagnaire.org/ocaml-vlog))
15
+
16
+
(documentation "https://gazagnaire.org/ocaml-vlog/")
17
+
18
+
(package
19
+
(name vlog)
20
+
(synopsis "Cmdliner terms for ergonomic logging configuration")
21
+
(description
22
+
"Provides cmdliner terms for configuring the Logs library with verbosity flags (-q, -v, -vv, -vvv), RUST_LOG-style configuration (--log=level,src:level), JSON output (--json), and protocol tracing (--trace FILE).")
23
+
(depends
24
+
(ocaml (>= 4.14))
25
+
(logs (>= 0.7))
26
+
(fmt (>= 0.9))
27
+
(cmdliner (>= 1.2))
28
+
(ptime (>= 1.0))))
+4
lib/dune
+4
lib/dune
+240
lib/vlog.ml
+240
lib/vlog.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Cmdliner terms for ergonomic logging configuration.
7
+
8
+
Provides RUST_LOG-style configuration via:
9
+
- Verbosity flags: [-q], [-v], [-vv], [-vvv]
10
+
- Log spec: [--log=level,src:level,...]
11
+
- JSON output: [--json]
12
+
- Protocol tracing: [--trace FILE] *)
13
+
14
+
open Cmdliner
15
+
16
+
(** {1 Verbosity Flags} *)
17
+
18
+
let quiet =
19
+
let doc = "Suppress output except errors." in
20
+
Arg.(value & flag & info [ "q"; "quiet" ] ~doc)
21
+
22
+
let verbosity =
23
+
let doc = "Increase verbosity. Use once for info, twice for debug, \
24
+
three times to enable protocol tracing." in
25
+
Arg.(value & flag_all & info [ "v"; "verbose" ] ~doc)
26
+
27
+
let level_of_verbosity ~quiet ~verbosity =
28
+
if quiet then Some Logs.Error
29
+
else
30
+
match List.length verbosity with
31
+
| 0 -> Some Logs.Warning
32
+
| 1 -> Some Logs.Info
33
+
| _ -> Some Logs.Debug
34
+
35
+
let enable_tracing ~verbosity = List.length verbosity >= 3
36
+
37
+
(** {1 Log Spec Parsing} *)
38
+
39
+
type directive = Global of Logs.level option | Source of string * Logs.level option
40
+
41
+
let parse_directive s =
42
+
let s = String.trim s in
43
+
if s = "" then None
44
+
else
45
+
match String.index_opt s ':' with
46
+
| None ->
47
+
(* Bare level = global setting *)
48
+
(match Logs.level_of_string s with
49
+
| Ok lvl -> Some (Global lvl)
50
+
| Error _ ->
51
+
Fmt.epr "Warning: invalid log level '%s'@." s;
52
+
None)
53
+
| Some i ->
54
+
let src = String.sub s 0 i in
55
+
let lvl_s = String.sub s (i + 1) (String.length s - i - 1) in
56
+
(match Logs.level_of_string lvl_s with
57
+
| Ok lvl -> Some (Source (src, lvl))
58
+
| Error _ ->
59
+
Fmt.epr "Warning: invalid log level '%s' for source '%s'@." lvl_s src;
60
+
None)
61
+
62
+
let parse_log_spec spec =
63
+
let directives = String.split_on_char ',' spec in
64
+
let global = ref None in
65
+
let sources = ref [] in
66
+
List.iter
67
+
(fun d ->
68
+
match parse_directive d with
69
+
| Some (Global lvl) -> global := lvl
70
+
| Some (Source (src, lvl)) -> sources := (src, lvl) :: !sources
71
+
| None -> ())
72
+
directives;
73
+
(!global, List.rev !sources)
74
+
75
+
(** {1 Source Filtering} *)
76
+
77
+
let apply_source_overrides specs =
78
+
let all_sources = Logs.Src.list () in
79
+
List.iter
80
+
(fun (prefix, lvl) ->
81
+
List.iter
82
+
(fun src ->
83
+
let name = Logs.Src.name src in
84
+
(* Match exact name or prefix with dot separator *)
85
+
if
86
+
String.equal name prefix
87
+
|| (String.length name > String.length prefix
88
+
&& String.sub name 0 (String.length prefix) = prefix
89
+
&& name.[String.length prefix] = '.')
90
+
then Logs.Src.set_level src lvl)
91
+
all_sources)
92
+
specs
93
+
94
+
let configure_tracing_sources ~enable =
95
+
let level = if enable then Some Logs.Debug else Some Logs.Warning in
96
+
List.iter
97
+
(fun src ->
98
+
let name = Logs.Src.name src in
99
+
(* Match *.tracing sources *)
100
+
if
101
+
String.length name > 8
102
+
&& String.sub name (String.length name - 8) 8 = ".tracing"
103
+
then Logs.Src.set_level src level)
104
+
(Logs.Src.list ())
105
+
106
+
(** {1 Trace File Reporter} *)
107
+
108
+
let trace_reporter ~json file_path =
109
+
let oc = open_out file_path in
110
+
let ppf = Format.formatter_of_out_channel oc in
111
+
let report src level ~over k msgf =
112
+
let name = Logs.Src.name src in
113
+
(* Only capture *.tracing sources *)
114
+
if
115
+
String.length name > 8
116
+
&& String.sub name (String.length name - 8) 8 = ".tracing"
117
+
then
118
+
msgf @@ fun ?header:_ ?tags:_ fmt ->
119
+
let k _ =
120
+
over ();
121
+
k ()
122
+
in
123
+
let ts = Ptime_clock.now () |> Ptime.to_rfc3339 in
124
+
if json then
125
+
(* JSON format *)
126
+
let buf = Buffer.create 256 in
127
+
Format.kfprintf
128
+
(fun _ ->
129
+
let msg = Buffer.contents buf in
130
+
let level_s =
131
+
match level with
132
+
| Logs.App -> "app"
133
+
| Logs.Error -> "error"
134
+
| Logs.Warning -> "warning"
135
+
| Logs.Info -> "info"
136
+
| Logs.Debug -> "debug"
137
+
in
138
+
Format.fprintf ppf
139
+
{|{"ts":"%s","src":"%s","level":"%s","msg":"%s"}@.|}
140
+
ts name level_s (String.escaped msg);
141
+
k ())
142
+
(Format.formatter_of_buffer buf)
143
+
fmt
144
+
else
145
+
(* Plain text format *)
146
+
Format.kfprintf k ppf ("%s %s " ^^ fmt ^^ "@.") ts name
147
+
else (
148
+
over ();
149
+
k ())
150
+
in
151
+
{ Logs.report }
152
+
153
+
(** {1 Cmdliner Terms} *)
154
+
155
+
let log_term app_name =
156
+
let env_name = String.uppercase_ascii app_name ^ "_LOG" in
157
+
let env =
158
+
Cmd.Env.info env_name
159
+
~doc:
160
+
(Printf.sprintf "Log configuration for %s. Format: LEVEL[,SRC:LEVEL,...]. \
161
+
Example: debug,tls.tracing:warning" app_name)
162
+
in
163
+
let doc =
164
+
"Set log level and per-source overrides. Format: LEVEL[,SRC:LEVEL,...]. \
165
+
Examples: $(b,debug), $(b,info,tls.tracing:warning), $(b,conpool:debug). \
166
+
Levels: error, warning, info, debug."
167
+
in
168
+
Arg.(value & opt (some string) None & info [ "log" ] ~env ~doc ~docv:"SPEC")
169
+
170
+
let trace_file =
171
+
let doc =
172
+
"Write protocol traces to $(docv). Automatically enables tracing sources."
173
+
in
174
+
Arg.(value & opt (some string) None & info [ "trace" ] ~doc ~docv:"FILE")
175
+
176
+
let json =
177
+
let doc = "Output as JSON (affects both data output and logs)." in
178
+
Arg.(value & flag & info [ "json" ] ~doc)
179
+
180
+
(** {1 Setup} *)
181
+
182
+
type config = {
183
+
level : Logs.level option;
184
+
json : bool;
185
+
trace_file : string option;
186
+
}
187
+
188
+
let setup_log ~json_reporter app_name style_renderer quiet verbosity log_spec
189
+
trace_file json =
190
+
Fmt_tty.setup_std_outputs ?style_renderer ();
191
+
(* Parse --log / <APP>_LOG spec *)
192
+
let global_override, source_overrides =
193
+
match log_spec with Some spec -> parse_log_spec spec | None -> (None, [])
194
+
in
195
+
(* Set reporter: JSON or Fmt (with optional trace file) *)
196
+
let main_reporter =
197
+
match (json, json_reporter) with
198
+
| true, Some mk_reporter -> mk_reporter ()
199
+
| _ -> Logs_fmt.reporter ()
200
+
in
201
+
let reporter =
202
+
match trace_file with
203
+
| Some path ->
204
+
(* Combine main reporter with trace file reporter *)
205
+
let trace_rep = trace_reporter ~json path in
206
+
let report src level ~over k msgf =
207
+
(* Send to both reporters *)
208
+
trace_rep.Logs.report src level
209
+
~over:(fun () -> ())
210
+
(fun () -> main_reporter.Logs.report src level ~over k msgf)
211
+
msgf
212
+
in
213
+
{ Logs.report }
214
+
| None -> main_reporter
215
+
in
216
+
Logs.set_reporter reporter;
217
+
(* Set global level: --log override > -q/-v flags *)
218
+
let level =
219
+
match global_override with
220
+
| Some lvl -> lvl
221
+
| None -> level_of_verbosity ~quiet ~verbosity
222
+
in
223
+
Logs.set_level level;
224
+
(* Configure tracing sources: -vvv or --trace enables them *)
225
+
let enable_trace = enable_tracing ~verbosity || Option.is_some trace_file in
226
+
configure_tracing_sources ~enable:enable_trace;
227
+
(* Apply per-source overrides from --log *)
228
+
apply_source_overrides source_overrides;
229
+
(* Return config for caller *)
230
+
{ level; json; trace_file }
231
+
232
+
let setup ?json_reporter app_name =
233
+
Term.(
234
+
const (setup_log ~json_reporter app_name)
235
+
$ Fmt_cli.style_renderer ()
236
+
$ quiet
237
+
$ verbosity
238
+
$ log_term app_name
239
+
$ trace_file
240
+
$ json)
+123
lib/vlog.mli
+123
lib/vlog.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Cmdliner terms for ergonomic logging configuration.
7
+
8
+
{b vlog} provides cmdliner terms that configure the {!Logs} library with:
9
+
- Verbosity flags: [-q], [-v], [-vv], [-vvv]
10
+
- RUST_LOG-style configuration: [--log=level,src:level,...]
11
+
- JSON output: [--json]
12
+
- Protocol tracing: [--trace FILE]
13
+
14
+
{2 Quick Start}
15
+
16
+
{[
17
+
let cmd =
18
+
let info = Cmd.info "myapp" in
19
+
Cmd.v info Term.(const run $ Vlog.setup "myapp" $ (* your args *))
20
+
]}
21
+
22
+
{2 Command Line Usage}
23
+
24
+
{v
25
+
myapp -vv # debug level
26
+
myapp --log=info,http:debug # info + http at debug
27
+
MYAPP_LOG=debug myapp # via env var
28
+
myapp --json # structured output
29
+
myapp --trace protocol.log # trace to file
30
+
v}
31
+
32
+
{2 Verbosity Levels}
33
+
34
+
{[
35
+
| Flag | Level | *.tracing sources |
36
+
|--------|---------|-------------------|
37
+
| -q | Error | Silenced |
38
+
| (none) | Warning | Silenced |
39
+
| -v | Info | Silenced |
40
+
| -vv | Debug | Silenced |
41
+
| -vvv | Debug | Enabled |
42
+
]} *)
43
+
44
+
(** {1 Configuration} *)
45
+
46
+
type config = {
47
+
level : Logs.level option; (** The configured log level *)
48
+
json : bool; (** Whether JSON output was requested *)
49
+
trace_file : string option; (** The trace file path, if any *)
50
+
}
51
+
(** Configuration returned by {!setup}. *)
52
+
53
+
(** {1 Setup} *)
54
+
55
+
val setup : ?json_reporter:(unit -> Logs.reporter) -> string -> config Cmdliner.Term.t
56
+
(** [setup ?json_reporter app_name] returns a cmdliner term that configures
57
+
logging for application [app_name].
58
+
59
+
The term provides these flags:
60
+
- [-q], [--quiet]: Error level only
61
+
- [-v], [--verbose]: Increase verbosity (can be repeated)
62
+
- [--log=SPEC]: RUST_LOG-style configuration
63
+
- [--json]: Enable JSON output
64
+
- [--trace=FILE]: Write protocol traces to file
65
+
66
+
Environment variable [$APP_NAME_LOG] is also checked (e.g., [MYAPP_LOG]).
67
+
68
+
@param json_reporter Optional JSON reporter factory. If provided and [--json]
69
+
is passed, this reporter will be used instead of {!Logs_fmt.reporter}.
70
+
Use [Json_logs.reporter] from the [json-logs] package. *)
71
+
72
+
(** {1 Individual Terms}
73
+
74
+
For advanced use cases where you need more control. *)
75
+
76
+
val quiet : bool Cmdliner.Term.t
77
+
(** Term for [-q]/[--quiet] flag. *)
78
+
79
+
val verbosity : unit list Cmdliner.Term.t
80
+
(** Term for [-v]/[--verbose] flags. Length indicates verbosity level. *)
81
+
82
+
val log_term : string -> string option Cmdliner.Term.t
83
+
(** [log_term app_name] returns a term for [--log] with environment variable
84
+
[$APP_NAME_LOG]. *)
85
+
86
+
val trace_file : string option Cmdliner.Term.t
87
+
(** Term for [--trace FILE] flag. *)
88
+
89
+
val json : bool Cmdliner.Term.t
90
+
(** Term for [--json] flag. *)
91
+
92
+
(** {1 Parsing Utilities} *)
93
+
94
+
val parse_log_spec : string -> Logs.level option * (string * Logs.level option) list
95
+
(** [parse_log_spec spec] parses a RUST_LOG-style specification.
96
+
Returns [(global_level, source_overrides)].
97
+
98
+
Examples:
99
+
- ["debug"] -> [Some Debug, \[\]]
100
+
- ["info,http:debug"] -> [Some Info, \[("http", Some Debug)\]]
101
+
- ["conpool:warning"] -> [None, \[("conpool", Some Warning)\]] *)
102
+
103
+
val apply_source_overrides : (string * Logs.level option) list -> unit
104
+
(** [apply_source_overrides overrides] sets log levels for matching sources.
105
+
Sources are matched by exact name or prefix (e.g., ["http"] matches
106
+
["http.client"], ["http.server"]). *)
107
+
108
+
val configure_tracing_sources : enable:bool -> unit
109
+
(** [configure_tracing_sources ~enable] enables or silences all [*.tracing]
110
+
log sources. When [enable] is false, tracing sources are set to Warning
111
+
level to suppress verbose protocol output. *)
112
+
113
+
(** {1 Verbosity Helpers} *)
114
+
115
+
val level_of_verbosity : quiet:bool -> verbosity:unit list -> Logs.level option
116
+
(** [level_of_verbosity ~quiet ~verbosity] computes the log level from flags.
117
+
- [quiet=true]: Error
118
+
- [verbosity=\[\]]: Warning
119
+
- [verbosity=\[_\]]: Info
120
+
- [verbosity=\[_;_\]] or more: Debug *)
121
+
122
+
val enable_tracing : verbosity:unit list -> bool
123
+
(** [enable_tracing ~verbosity] returns [true] if verbosity >= 3 (i.e., [-vvv]). *)