Cmdliner terms for ergonomic logging configuration
Add .ocamlformat and format
+63
-53
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version = 0.28.1
+30
-27
lib/vlog.ml
+30
-27
lib/vlog.ml
···
20
20
Arg.(value & flag & info [ "q"; "quiet" ] ~doc)
21
21
22
22
let verbosity =
23
-
let doc = "Increase verbosity. Use once for info, twice for debug, \
24
-
three times to enable protocol tracing." in
23
+
let doc =
24
+
"Increase verbosity. Use once for info, twice for debug, three times to \
25
+
enable protocol tracing."
26
+
in
25
27
Arg.(value & flag_all & info [ "v"; "verbose" ] ~doc)
26
28
27
29
let level_of_verbosity ~quiet ~verbosity =
···
36
38
37
39
(** {1 Log Spec Parsing} *)
38
40
39
-
type directive = Global of Logs.level option | Source of string * Logs.level option
41
+
type directive =
42
+
| Global of Logs.level option
43
+
| Source of string * Logs.level option
40
44
41
45
let parse_directive s =
42
46
let s = String.trim s in
43
47
if s = "" then None
44
48
else
45
49
match String.index_opt s ':' with
46
-
| None ->
50
+
| None -> (
47
51
(* 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 ->
52
+
match Logs.level_of_string s with
53
+
| Ok lvl -> Some (Global lvl)
54
+
| Error _ ->
55
+
Fmt.epr "Warning: invalid log level '%s'@." s;
56
+
None)
57
+
| Some i -> (
54
58
let src = String.sub s 0 i in
55
59
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)
60
+
match Logs.level_of_string lvl_s with
61
+
| Ok lvl -> Some (Source (src, lvl))
62
+
| Error _ ->
63
+
Fmt.epr "Warning: invalid log level '%s' for source '%s'@." lvl_s
64
+
src;
65
+
None)
61
66
62
67
let parse_log_spec spec =
63
68
let directives = String.split_on_char ',' spec in
···
84
89
(* Match exact name or prefix with dot separator *)
85
90
if
86
91
String.equal name prefix
87
-
|| (String.length name > String.length prefix
92
+
|| String.length name > String.length prefix
88
93
&& String.sub name 0 (String.length prefix) = prefix
89
-
&& name.[String.length prefix] = '.')
94
+
&& name.[String.length prefix] = '.'
90
95
then Logs.Src.set_level src lvl)
91
96
all_sources)
92
97
specs
···
136
141
| Logs.Debug -> "debug"
137
142
in
138
143
Format.fprintf ppf
139
-
{|{"ts":"%s","src":"%s","level":"%s","msg":"%s"}@.|}
140
-
ts name level_s (String.escaped msg);
144
+
{|{"ts":"%s","src":"%s","level":"%s","msg":"%s"}@.|} ts name
145
+
level_s (String.escaped msg);
141
146
k ())
142
147
(Format.formatter_of_buffer buf)
143
148
fmt
···
157
162
let env =
158
163
Cmd.Env.info env_name
159
164
~doc:
160
-
(Printf.sprintf "Log configuration for %s. Format: LEVEL[,SRC:LEVEL,...]. \
161
-
Example: debug,tls.tracing:warning" app_name)
165
+
(Printf.sprintf
166
+
"Log configuration for %s. Format: LEVEL[,SRC:LEVEL,...]. Example: \
167
+
debug,tls.tracing:warning"
168
+
app_name)
162
169
in
163
170
let doc =
164
171
"Set log level and per-source overrides. Format: LEVEL[,SRC:LEVEL,...]. \
···
232
239
let setup ?json_reporter app_name =
233
240
Term.(
234
241
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)
242
+
$ Fmt_cli.style_renderer () $ quiet $ verbosity $ log_term app_name
243
+
$ trace_file $ json)
+30
-26
lib/vlog.mli
+30
-26
lib/vlog.mli
···
32
32
{2 Verbosity Levels}
33
33
34
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 |
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
42
]} *)
43
43
44
44
(** {1 Configuration} *)
45
45
46
46
type config = {
47
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 *)
48
+
json : bool; (** Whether JSON output was requested *)
49
+
trace_file : string option; (** The trace file path, if any *)
50
50
}
51
51
(** Configuration returned by {!setup}. *)
52
52
53
53
(** {1 Setup} *)
54
54
55
-
val setup : ?json_reporter:(unit -> Logs.reporter) -> string -> config Cmdliner.Term.t
55
+
val setup :
56
+
?json_reporter:(unit -> Logs.reporter) -> string -> config Cmdliner.Term.t
56
57
(** [setup ?json_reporter app_name] returns a cmdliner term that configures
57
58
logging for application [app_name].
58
59
···
65
66
66
67
Environment variable [$APP_NAME_LOG] is also checked (e.g., [MYAPP_LOG]).
67
68
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. *)
69
+
@param json_reporter
70
+
Optional JSON reporter factory. If provided and [--json] is passed, this
71
+
reporter will be used instead of {!Logs_fmt.reporter}. Use
72
+
[Json_logs.reporter] from the [json-logs] package. *)
71
73
72
74
(** {1 Individual Terms}
73
75
···
91
93
92
94
(** {1 Parsing Utilities} *)
93
95
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)].
96
+
val parse_log_spec :
97
+
string -> Logs.level option * (string * Logs.level option) list
98
+
(** [parse_log_spec spec] parses a RUST_LOG-style specification. Returns
99
+
[(global_level, source_overrides)].
97
100
98
101
Examples:
99
-
- ["debug"] -> [Some Debug, \[\]]
100
-
- ["info,http:debug"] -> [Some Info, \[("http", Some Debug)\]]
101
-
- ["conpool:warning"] -> [None, \[("conpool", Some Warning)\]] *)
102
+
- ["debug"] -> [Some Debug, []]
103
+
- ["info,http:debug"] -> [Some Info, [("http", Some Debug)]]
104
+
- ["conpool:warning"] -> [None, [("conpool", Some Warning)]] *)
102
105
103
106
val apply_source_overrides : (string * Logs.level option) list -> unit
104
107
(** [apply_source_overrides overrides] sets log levels for matching sources.
···
106
109
["http.client"], ["http.server"]). *)
107
110
108
111
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
+
(** [configure_tracing_sources ~enable] enables or silences all [*.tracing] log
113
+
sources. When [enable] is false, tracing sources are set to Warning level to
114
+
suppress verbose protocol output. *)
112
115
113
116
(** {1 Verbosity Helpers} *)
114
117
115
118
val level_of_verbosity : quiet:bool -> verbosity:unit list -> Logs.level option
116
119
(** [level_of_verbosity ~quiet ~verbosity] computes the log level from flags.
117
120
- [quiet=true]: Error
118
-
- [verbosity=\[\]]: Warning
119
-
- [verbosity=\[_\]]: Info
120
-
- [verbosity=\[_;_\]] or more: Debug *)
121
+
- [verbosity=[]]: Warning
122
+
- [verbosity=[_]]: Info
123
+
- [verbosity=[_;_]] or more: Debug *)
121
124
122
125
val enable_tracing : verbosity:unit list -> bool
123
-
(** [enable_tracing ~verbosity] returns [true] if verbosity >= 3 (i.e., [-vvv]). *)
126
+
(** [enable_tracing ~verbosity] returns [true] if verbosity >= 3 (i.e., [-vvv]).
127
+
*)
+2
test/test_cli.ml
+2
test/test_cli.ml
···
9
9
10
10
(* Create a test log source *)
11
11
let src = Logs.Src.create "test" ~doc:"Test source"
12
+
12
13
module Log = (val Logs.src_log src : Logs.LOG)
13
14
14
15
(* Create a tracing source *)
15
16
let tracing_src = Logs.Src.create "test.tracing" ~doc:"Test tracing source"
17
+
16
18
module Trace = (val Logs.src_log tracing_src : Logs.LOG)
17
19
18
20
let run _config =