My working unpac space for OCaml projects in development
Merge opam/patches/logs
+2464
+10
vendor/opam/logs/.gitignore
+10
vendor/opam/logs/.gitignore
+4
vendor/opam/logs/.merlin
+4
vendor/opam/logs/.merlin
+131
vendor/opam/logs/B0.ml
+131
vendor/opam/logs/B0.ml
···
1
+
open B0_kit.V000
2
+
3
+
(* OCaml library names *)
4
+
5
+
let b0_std = B0_ocaml.libname "b0.std"
6
+
7
+
let compiler_libs_toplevel = B0_ocaml.libname "compiler-libs.toplevel"
8
+
let mtime = B0_ocaml.libname "mtime"
9
+
let mtime_clock = B0_ocaml.libname "mtime.clock"
10
+
let unix = B0_ocaml.libname "unix"
11
+
let threads = B0_ocaml.libname "threads.posix"
12
+
let cmdliner = B0_ocaml.libname "cmdliner"
13
+
let fmt = B0_ocaml.libname "fmt"
14
+
let fmt_tty = B0_ocaml.libname "fmt.tty"
15
+
let fmt_cli = B0_ocaml.libname "fmt.cli"
16
+
let lwt = B0_ocaml.libname "lwt"
17
+
let lwt_unix = B0_ocaml.libname "lwt.unix"
18
+
let js_of_ocaml_compiler_runtime =
19
+
B0_ocaml.libname "js_of_ocaml-compiler.runtime"
20
+
21
+
let logs = B0_ocaml.libname "logs"
22
+
let logs_fmt = B0_ocaml.libname "logs.fmt"
23
+
let logs_browser = B0_ocaml.libname "logs.browser"
24
+
let logs_cli = B0_ocaml.libname "logs.cli"
25
+
let logs_lwt = B0_ocaml.libname "logs.lwt"
26
+
let logs_threaded = B0_ocaml.libname "logs.threaded"
27
+
let logs_top = B0_ocaml.libname "logs.top"
28
+
29
+
(* Libraries *)
30
+
31
+
let logs_lib =
32
+
B0_ocaml.lib logs ~srcs:[`Dir ~/"src"] ~requires:[]
33
+
34
+
let logs_fmt_lib =
35
+
let srcs = [`Dir ~/"src/fmt"] in
36
+
B0_ocaml.lib logs_fmt ~srcs ~requires:[logs; fmt] ~exports:[logs]
37
+
38
+
let logs_browser_lib =
39
+
let srcs = [`Dir ~/"src/browser"] in
40
+
let requires = [logs; js_of_ocaml_compiler_runtime] in
41
+
B0_ocaml.lib logs_browser ~srcs ~requires ~exports:[logs]
42
+
43
+
let logs_threaded_lib =
44
+
let srcs = [`Dir ~/"src/threaded"] in
45
+
B0_ocaml.lib logs_threaded ~srcs ~requires:[logs; threads] ~exports:[logs]
46
+
47
+
let logs_cli_lib =
48
+
let srcs = [`Dir ~/"src/cli"] in
49
+
B0_ocaml.lib logs_cli ~srcs ~requires:[logs; cmdliner] ~exports:[logs]
50
+
51
+
let logs_lwt_lib =
52
+
let srcs = [`Dir ~/"src/lwt"] in
53
+
B0_ocaml.lib logs_lwt ~srcs ~requires:[logs; lwt] ~exports:[logs]
54
+
55
+
let logs_top_lib =
56
+
let srcs = [`Dir ~/"src/top"] in
57
+
B0_ocaml.lib logs_top ~srcs ~requires:[logs; compiler_libs_toplevel]
58
+
59
+
(* Tests *)
60
+
61
+
let test ?(requires = []) = B0_ocaml.test ~requires:(logs :: requires)
62
+
63
+
let test_fmt =
64
+
let requires = [fmt_tty; logs_fmt] in
65
+
test ~/"test/test_fmt.ml" ~requires ~run:false (* exits with 1. *)
66
+
67
+
let test_formatter =
68
+
test ~/"test/test_formatter.ml" ~run:false (* exits with 1. *)
69
+
70
+
let test_tool =
71
+
let requires = [logs_fmt; logs_cli; fmt_cli; fmt_tty; cmdliner] in
72
+
test ~/"test/tool.ml" ~requires ~run:false (* exits with 1 *)
73
+
74
+
let test_tags =
75
+
test ~/"test/tags.ml" ~requires:[mtime; mtime_clock]
76
+
77
+
let test_multi =
78
+
test ~/"test/test_multi.ml" ~requires:[logs; logs_fmt; fmt_tty]
79
+
80
+
let test_threaded =
81
+
test ~/"test/test_threaded.ml" ~requires:[logs_fmt; logs_threaded; threads]
82
+
83
+
let test_mutext_safe =
84
+
test ~/"test/test_mutex_safe.ml" ~requires:[logs_fmt; logs_threaded; threads]
85
+
86
+
let test_lwt =
87
+
let requires = [b0_std; logs_fmt; logs_lwt; fmt; fmt_tty; lwt; lwt_unix] in
88
+
test ~/"test/test_lwt.ml" ~requires
89
+
90
+
let test_count = test ~/"test/test_count.ml" ~requires:[b0_std]
91
+
92
+
(* Packs *)
93
+
94
+
let default =
95
+
let meta =
96
+
B0_meta.empty
97
+
|> ~~ B0_meta.authors ["The logs programmers"]
98
+
|> ~~ B0_meta.maintainers ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
99
+
|> ~~ B0_meta.homepage "https://erratique.ch/software/logs"
100
+
|> ~~ B0_meta.online_doc "https://erratique.ch/software/logs/doc"
101
+
|> ~~ B0_meta.licenses ["ISC"]
102
+
|> ~~ B0_meta.repo "git+https://erratique.ch/repos/logs.git"
103
+
|> ~~ B0_meta.issues "https://github.com/dbuenzli/logs/issues"
104
+
|> ~~ B0_meta.description_tags ["log"; "system"; "org:erratique"; ]
105
+
|> B0_meta.tag B0_opam.tag
106
+
|> ~~ B0_opam.build
107
+
{|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"
108
+
"--with-js_of_ocaml-compiler" "%{js_of_ocaml-compiler:installed}%"
109
+
"--with-fmt" "%{fmt:installed}%"
110
+
"--with-cmdliner" "%{cmdliner:installed}%"
111
+
"--with-lwt" "%{lwt:installed}%"
112
+
"--with-base-threads" "%{base-threads:installed}%"]]|}
113
+
|> ~~ B0_opam.depopts
114
+
["cmdliner", "";
115
+
"js_of_ocaml-compiler", "";
116
+
"fmt", "";
117
+
"lwt", "";
118
+
"base-threads", ""]
119
+
|> B0_meta.add B0_opam.conflicts [
120
+
"cmdliner", {|< "1.3.0"|};
121
+
"js_of_ocaml-compiler", {|< "5.5.0"|};
122
+
"fmt", {|< "0.9.0"|}; ]
123
+
|> ~~ B0_opam.depends
124
+
[ "ocaml", {|>= "4.14.0"|};
125
+
"ocamlfind", {|build|};
126
+
"ocamlbuild", {|build|};
127
+
"topkg", {|build & >= "1.1.0"|};
128
+
"mtime", {|with-test|};]
129
+
in
130
+
B0_pack.make "default" ~doc:"logs package" ~meta ~locked:true @@
131
+
B0_unit.list ()
+1
vendor/opam/logs/BRZO
+1
vendor/opam/logs/BRZO
···
1
+
(srcs-x tmp pkg)
+106
vendor/opam/logs/CHANGES.md
+106
vendor/opam/logs/CHANGES.md
···
1
+
2
+
3
+
* Make log mutex immune to raising logging functions.
4
+
Thanks to Nathan Taylor for the report and the repro (#57).
5
+
6
+
v0.9.0 2025-07-08 Zagreb
7
+
------------------------
8
+
9
+
* Replace references and mutable fields by atomic references to avoid
10
+
race conditions (#56). Thanks to Nathan Taylor for reporting.
11
+
* Fix `Logs.{err,warn}_count`. The counts were counting the reports
12
+
not the logs which is not what the spec says. This means the counts
13
+
were wrong when the reporting level was below the corresponding
14
+
level (#55). Thanks to Mathieu Barbin for the report.
15
+
* Fix `Log.Tag.list` always returning the empty list.
16
+
* `Logs.format_reporter` and `Logs_fmt.reporter` replace a few format
17
+
strings and `^^` uses by direct calls to `Format` primitives.
18
+
* Requires OCaml >= 4.14.
19
+
* Use Format.pp_print_text instead of our own.
20
+
* Export `logs` from each sub library.
21
+
22
+
v0.8.0 2025-03-10 La Forclaz (VS)
23
+
---------------------------------
24
+
25
+
* Install one library per directory (#48). Thanks to @mefyl
26
+
for the suggestion.
27
+
* Requires OCaml >= 4.08, Cmdliner >= 1.3.0, Fmt >= 0.9.0
28
+
and js_of_ocaml-compiler >= 5.5.0
29
+
* Depend on the `js_of_ocaml-compiler.runtime` library rather than
30
+
`js_of_ocaml`.
31
+
* Handle `cmdliner` deprecations.
32
+
33
+
v0.7.0 2019-08-09 Zagreb
34
+
------------------------
35
+
36
+
Support for thread safe logging, thanks to Jules Aguillon for the
37
+
work.
38
+
39
+
* Add `Logs.set_reporter_mutex` for installing mutual exclusion
40
+
primitives to access the reporter.
41
+
* Add `Logs_threaded.enable` to install mutual exclusion
42
+
primitives for OCaml threads.
43
+
44
+
v0.6.3 2019-04-19 La Forclaz (VS)
45
+
---------------------------------
46
+
47
+
* Make the package compatible with `js_of_ocaml` 3.3.0's
48
+
namespacing. Thanks to Hugo Heuzard for the patch.
49
+
* Fix toplevel initialisation for `Omod` (#21).
50
+
* Fix 4.08 `Pervasives` deprecation.
51
+
* Drop support for ocaml < 4.03.0
52
+
* Doc: various improvements and typo fixing.
53
+
54
+
v0.6.2 2016-08-10 Zagreb
55
+
------------------------
56
+
57
+
* 4.04.0 compatibility. Thanks to Damien Doligez for the patch.
58
+
59
+
60
+
v0.6.1 2016-06-08 Cambridge (UK)
61
+
--------------------------------
62
+
63
+
* Fix logs.top package on case sensitive file systems.
64
+
65
+
v0.6.0 2016-05-23 La Forclaz (VS)
66
+
---------------------------------
67
+
68
+
* Build depend on topkg.
69
+
* Relicensed from BSD3 to ISC.
70
+
* Revise the command line interface provided by `Logs_cli`. Removes
71
+
the argument from option `-v`. See issue #13 for details.
72
+
* Add `Logs.format_reporter` a reporter like `Logs_fmt.reporter`
73
+
but without colors and hence without the dependency on `Fmt`.
74
+
Thanks to Simon Cruanes for the suggestion.
75
+
* `Logs_fmt.reporter`, the optional argument `prefix` is changed to
76
+
`pp_header` and becomes a formatter. The default prefix now favors
77
+
the basename of `Sys.argv.(0)` if it exists over
78
+
`Sys.executable_name`; this gives better results for interpreted
79
+
programs.
80
+
* Fix colors in `Logs_fmt.pp_header`, only `Logs.err_style` was
81
+
being used.
82
+
* Add `Logs.level_{of,to}_string`.
83
+
84
+
85
+
v0.5.0 2016-01-07 La Forclaz (VS)
86
+
---------------------------------
87
+
88
+
* Support for OCaml 4.01.0
89
+
* Change the logging structure from `Logs.err fmt (fun m -> m ...)`
90
+
to `Logs.err (fun m -> m fmt ...)`. See the documentation basics
91
+
for more details. Thanks to Edwin Török for suggesting this.
92
+
* Remove the `Logs.unit[_msgf]` functions, they are no longer needed.
93
+
* Rename the `Logs_stdo` library to `Logs_fmt`.
94
+
* Changes the signature of reporters to take a callback function to
95
+
call unconditionally once the report is over. Thanks to Edwin Török
96
+
for suggesting the mecanism.
97
+
* Add the optional `Logs_lwt` library. Provides logging functions
98
+
returning `lwt` threads that proceed only once the report is over.
99
+
* Add `Logs_fmt.pp_header` and `Logs_fmt.{err_warn,info_debug}_style`.
100
+
* Add `Logs.pp_{level,header}`.
101
+
102
+
103
+
v0.4.2 2015-12-03 Cambridge (UK)
104
+
--------------------------------
105
+
106
+
First release.
+6
vendor/opam/logs/DEVEL.md
+6
vendor/opam/logs/DEVEL.md
···
1
+
This project uses (perhaps the development version of) [`b0`] for
2
+
development. Consult [b0 occasionally] for quick hints on how to
3
+
perform common development tasks.
4
+
5
+
[`b0`]: https://erratique.ch/software/b0
6
+
[b0 occasionally]: https://erratique.ch/software/b0/doc/occasionally.html
+13
vendor/opam/logs/LICENSE.md
+13
vendor/opam/logs/LICENSE.md
···
1
+
Copyright (c) 2016 The logs programmers
2
+
3
+
Permission to use, copy, modify, and/or distribute this software for any
4
+
purpose with or without fee is hereby granted, provided that the above
5
+
copyright notice and this permission notice appear in all copies.
6
+
7
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+51
vendor/opam/logs/README.md
+51
vendor/opam/logs/README.md
···
1
+
Logs — Logging infrastructure for OCaml
2
+
=======================================
3
+
4
+
Logs provides a logging infrastructure for OCaml. Logging is performed
5
+
on sources whose reporting level can be set independently. Log message
6
+
report is decoupled from logging and is handled by a reporter.
7
+
8
+
A few optional log reporters are distributed with the base library and
9
+
the API easily allows to implement your own.
10
+
11
+
`Logs` has no dependencies. The optional `Logs_fmt` reporter on OCaml
12
+
formatters depends on [Fmt][fmt]. The optional `Logs_browser`
13
+
reporter that reports to the web browser console depends on
14
+
[js_of_ocaml][jsoo]. The optional `Logs_cli` library that provides
15
+
command line support for controlling Logs depends on
16
+
[`Cmdliner`][cmdliner]. The optional `Logs_lwt` library that provides
17
+
Lwt logging functions depends on [`Lwt`][lwt]
18
+
19
+
Logs and its reporters are distributed under the ISC license.
20
+
21
+
[fmt]: http://erratique.ch/software/fmt
22
+
[jsoo]: http://ocsigen.org/js_of_ocaml/
23
+
[cmdliner]: http://erratique.ch/software/cmdliner
24
+
[lwt]: http://ocsigen.org/lwt/
25
+
26
+
Home page: <http://erratique.ch/software/logs>
27
+
28
+
## Installation
29
+
30
+
Logs can be installed with `opam`:
31
+
32
+
opam install logs
33
+
opam install fmt cmdliner lwt js_of_ocaml logs # Install all opt libraries
34
+
35
+
If you don't use `opam` consult the [`opam`](opam) file for build
36
+
instructions.
37
+
38
+
## Documentation
39
+
40
+
The documentation can be consulted [online][doc] or via `odig doc logs`.
41
+
42
+
Questions are welcome but better asked on the [OCaml forum][ocaml-forum]
43
+
than on the issue tracker.
44
+
45
+
[doc]: https://erratique.ch/software/logs/doc
46
+
[ocaml-forum]: https://discuss.ocaml.org/
47
+
48
+
## Sample programs
49
+
50
+
A few tests can be found in the [`test`](test/) directory.
51
+
+26
vendor/opam/logs/doc/index.mld
+26
vendor/opam/logs/doc/index.mld
···
1
+
{0 Logs {%html: <span class="version">%%VERSION%%</span>%}}
2
+
3
+
Logs provides a logging infrastructure.
4
+
5
+
Logging is performed on sources whose reporting level can be set
6
+
independently. Log message report is decoupled from logging and is
7
+
handled by a reporter. A few optional log reporters are distributed
8
+
with the package and the API easily allows to implement your own.
9
+
10
+
See the {{!Logs.basics}basics}.
11
+
12
+
{1:library_logs Library [logs]}
13
+
14
+
{!modules: Logs}
15
+
16
+
{1:libraries Libraries [logs.{browser,cli,fmt,lwt,threaded}]}
17
+
18
+
Each of these modules lives in its own library.
19
+
20
+
{!modules:
21
+
Logs_browser
22
+
Logs_cli
23
+
Logs_fmt
24
+
Logs_lwt
25
+
Logs_threaded
26
+
}
+49
vendor/opam/logs/dune-project
+49
vendor/opam/logs/dune-project
···
1
+
(lang dune 3.0)
2
+
(name logs)
3
+
4
+
(generate_opam_files false)
5
+
6
+
(source (github dbuenzli/logs))
7
+
(license ISC)
8
+
(authors "The logs programmers")
9
+
(maintainers "Daniel Bünzli <daniel.buenzl i@erratique.ch>")
10
+
11
+
(package
12
+
(name logs)
13
+
(synopsis "Logging infrastructure for OCaml")
14
+
(description "Logs provides a logging infrastructure for OCaml. Logging is performed
15
+
on sources whose reporting level can be set independently. Log message
16
+
report is decoupled from logging and is handled by a reporter.
17
+
18
+
A few optional log reporters are distributed with the base library and
19
+
the API easily allows to implement your own.
20
+
21
+
`Logs` has no dependencies. The optional `Logs_fmt` reporter on OCaml
22
+
formatters depends on [Fmt][fmt]. The optional `Logs_browser`
23
+
reporter that reports to the web browser console depends on
24
+
[js_of_ocaml][jsoo]. The optional `Logs_cli` library that provides
25
+
command line support for controlling Logs depends on
26
+
[`Cmdliner`][cmdliner]. The optional `Logs_lwt` library that provides
27
+
Lwt logging functions depends on [`Lwt`][lwt]
28
+
29
+
Logs and its reporters are distributed under the ISC license.
30
+
31
+
[fmt]: http://erratique.ch/software/fmt
32
+
[jsoo]: http://ocsigen.org/js_of_ocaml/
33
+
[cmdliner]: http://erratique.ch/software/cmdliner
34
+
[lwt]: http://ocsigen.org/lwt/
35
+
36
+
Home page: <http://erratique.ch/software/logs>")
37
+
(depends
38
+
(ocaml (>= 4.14.0)))
39
+
(depopts
40
+
cmdliner
41
+
js_of_ocaml-compiler
42
+
fmt
43
+
lwt
44
+
base-threads)
45
+
(conflicts
46
+
(cmdliner (< 1.3.0))
47
+
(js_of_ocaml-compiler (< 5.5.0))
48
+
(fmt (< 0.9.0)))
49
+
(tags (log system "org:erratique")))
+51
vendor/opam/logs/opam
+51
vendor/opam/logs/opam
···
1
+
opam-version: "2.0"
2
+
name: "logs"
3
+
synopsis: "Logging infrastructure for OCaml"
4
+
description: """\
5
+
Logs provides a logging infrastructure for OCaml. Logging is performed
6
+
on sources whose reporting level can be set independently. Log message
7
+
report is decoupled from logging and is handled by a reporter.
8
+
9
+
A few optional log reporters are distributed with the base library and
10
+
the API easily allows to implement your own.
11
+
12
+
`Logs` has no dependencies. The optional `Logs_fmt` reporter on OCaml
13
+
formatters depends on [Fmt][fmt]. The optional `Logs_browser`
14
+
reporter that reports to the web browser console depends on
15
+
[js_of_ocaml][jsoo]. The optional `Logs_cli` library that provides
16
+
command line support for controlling Logs depends on
17
+
[`Cmdliner`][cmdliner]. The optional `Logs_lwt` library that provides
18
+
Lwt logging functions depends on [`Lwt`][lwt]
19
+
20
+
Logs and its reporters are distributed under the ISC license.
21
+
22
+
[fmt]: http://erratique.ch/software/fmt
23
+
[jsoo]: http://ocsigen.org/js_of_ocaml/
24
+
[cmdliner]: http://erratique.ch/software/cmdliner
25
+
[lwt]: http://ocsigen.org/lwt/
26
+
27
+
Home page: <http://erratique.ch/software/logs>"""
28
+
maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
29
+
authors: "The logs programmers"
30
+
license: "ISC"
31
+
tags: ["log" "system" "org:erratique"]
32
+
homepage: "https://erratique.ch/software/logs"
33
+
doc: "https://erratique.ch/software/logs/doc"
34
+
bug-reports: "https://github.com/dbuenzli/logs/issues"
35
+
depends: [
36
+
"ocaml" {>= "4.14.0"}
37
+
"dune" {>= "3.0"}
38
+
"mtime" {with-test}
39
+
]
40
+
depopts: ["cmdliner" "js_of_ocaml-compiler" "fmt" "lwt" "base-threads"]
41
+
conflicts: [
42
+
"cmdliner" {< "1.3.0"}
43
+
"js_of_ocaml-compiler" {< "5.5.0"}
44
+
"fmt" {< "0.9.0"}
45
+
]
46
+
build: [
47
+
["dune" "subst"] {dev}
48
+
["dune" "build" "-p" name "-j" jobs]
49
+
]
50
+
dev-repo: "git+https://erratique.ch/repos/logs.git"
51
+
x-maintenance-intent: ["(latest)"]
+85
vendor/opam/logs/pkg/META
+85
vendor/opam/logs/pkg/META
···
1
+
description = "Logging infrastructure for OCaml"
2
+
version = "%%VERSION_NUM%%"
3
+
requires = ""
4
+
archive(byte) = "logs.cma"
5
+
archive(native) = "logs.cmxa"
6
+
plugin(byte) = "logs.cma"
7
+
plugin(native) = "logs.cmxs"
8
+
exists_if = "logs.cma logs.cmxa"
9
+
10
+
package "browser" (
11
+
directory = "browser"
12
+
description = "The logs.browser library"
13
+
version = "%%VERSION_NUM%%"
14
+
requires = "logs js_of_ocaml-compiler.runtime"
15
+
exports = "logs"
16
+
archive(byte) = "logs_browser.cma"
17
+
archive(native) = "logs_browser.cmxa"
18
+
plugin(byte) = "logs_browser.cma"
19
+
plugin(native) = "logs_browser.cmxs"
20
+
exists_if = "logs_browser.cma logs_browser.cmxa"
21
+
)
22
+
23
+
package "cli" (
24
+
directory = "cli"
25
+
description = "The logs.cli library"
26
+
version = "%%VERSION_NUM%%"
27
+
requires = "logs cmdliner"
28
+
exports = "logs"
29
+
archive(byte) = "logs_cli.cma"
30
+
archive(native) = "logs_cli.cmxa"
31
+
plugin(byte) = "logs_cli.cma"
32
+
plugin(native) = "logs_cli.cmxs"
33
+
exists_if = "logs_cli.cma logs_cli.cmxa"
34
+
)
35
+
36
+
package "fmt" (
37
+
directory = "fmt"
38
+
description = "The logs.fmt library"
39
+
version = "%%VERSION_NUM%%"
40
+
requires = "logs fmt"
41
+
exports = "logs"
42
+
archive(byte) = "logs_fmt.cma"
43
+
archive(native) = "logs_fmt.cmxa"
44
+
plugin(byte) = "logs_fmt.cma"
45
+
plugin(native) = "logs_fmt.cmxs"
46
+
exists_if = "logs_fmt.cma logs_fmt.cmxa"
47
+
)
48
+
49
+
package "lwt" (
50
+
directory = "lwt"
51
+
description = "The logs.lwt library"
52
+
version = "%%VERSION_NUM%%"
53
+
requires = "logs lwt"
54
+
exports = "logs"
55
+
archive(byte) = "logs_lwt.cma"
56
+
archive(native) = "logs_lwt.cmxa"
57
+
plugin(byte) = "logs_lwt.cma"
58
+
plugin(native) = "logs_lwt.cmxs"
59
+
exists_if = "logs_lwt.cma logs_lwt.cmxa"
60
+
)
61
+
62
+
package "threaded" (
63
+
directory = "threaded"
64
+
description = "The logs.threaded library"
65
+
version = "%%VERSION_NUM%%"
66
+
requires = "logs threads.posix"
67
+
exports = "logs"
68
+
archive(byte) = "logs_threaded.cma"
69
+
archive(native) = "logs_threaded.cmxa"
70
+
plugin(byte) = "logs_threaded.cma"
71
+
plugin(native) = "logs_threaded.cmxs"
72
+
exists_if = "logs_threaded.cma logs_threaded.cmxa"
73
+
)
74
+
75
+
package "top" (
76
+
directory = "top"
77
+
description = "The logs.top library"
78
+
version = "%%VERSION_NUM%%"
79
+
requires = "logs"
80
+
archive(byte) = "logs_top.cma"
81
+
archive(native) = "logs_top.cmxa"
82
+
plugin(byte) = "logs_top.cma"
83
+
plugin(native) = "logs_top.cmxs"
84
+
exists_if = "logs_top.cma logs_top.cmxa"
85
+
)
+29
vendor/opam/logs/pkg/pkg.ml
+29
vendor/opam/logs/pkg/pkg.ml
···
1
+
#!/usr/bin/env ocaml
2
+
#use "topfind"
3
+
#require "topkg"
4
+
open Topkg
5
+
6
+
let jsoo = Conf.with_pkg "js_of_ocaml-compiler"
7
+
let cmdliner = Conf.with_pkg "cmdliner"
8
+
let fmt = Conf.with_pkg "fmt"
9
+
let lwt = Conf.with_pkg "lwt"
10
+
let threads = Conf.with_pkg "base-threads"
11
+
let () =
12
+
Pkg.describe "logs" @@ fun c ->
13
+
let jsoo = Conf.value c jsoo in
14
+
let cmdliner = Conf.value c cmdliner in
15
+
let fmt = Conf.value c fmt in
16
+
let lwt = Conf.value c lwt in
17
+
let threads = Conf.value c threads in
18
+
Ok [ Pkg.mllib "src/logs.mllib";
19
+
Pkg.mllib ~cond:fmt "src/fmt/logs_fmt.mllib" ~dst_dir:"fmt";
20
+
Pkg.mllib ~cond:jsoo "src/browser/logs_browser.mllib" ~dst_dir:"browser";
21
+
Pkg.mllib ~cond:cmdliner "src/cli/logs_cli.mllib" ~dst_dir:"cli";
22
+
Pkg.mllib ~cond:lwt "src/lwt/logs_lwt.mllib" ~dst_dir:"lwt";
23
+
Pkg.mllib ~cond:fmt ~api:[] "src/top/logs_top.mllib" ~dst_dir:"top";
24
+
Pkg.mllib ~cond:threads
25
+
"src/threaded/logs_threaded.mllib" ~dst_dir:"threaded";
26
+
Pkg.lib "src/top/logs_top_init.ml";
27
+
Pkg.lib "src/top/logs_top_init.ml" ~dst:"top/logs_top_init_ml";
28
+
Pkg.lib "src/fmt/logs_fmt_top_init.ml" ~dst:"fmt/logs_fmt_top_init.ml";
29
+
Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld"]
+6
vendor/opam/logs/src/browser/dune
+6
vendor/opam/logs/src/browser/dune
+34
vendor/opam/logs/src/browser/logs_browser.ml
+34
vendor/opam/logs/src/browser/logs_browser.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Console reporter *)
7
+
8
+
open Jsoo_runtime
9
+
10
+
let console_obj = Js.pure_js_expr "console"
11
+
let console : Logs.level -> string -> unit =
12
+
fun level s ->
13
+
let meth = match level with
14
+
| Logs.Error -> "error"
15
+
| Logs.Warning -> "warn"
16
+
| Logs.Info -> "info"
17
+
| Logs.Debug -> "debug"
18
+
| Logs.App -> "log"
19
+
in
20
+
ignore (Js.meth_call console_obj meth [| Js.string s |])
21
+
22
+
let ppf, flush =
23
+
let b = Buffer.create 255 in
24
+
let flush () = let s = Buffer.contents b in Buffer.clear b; s in
25
+
Format.formatter_of_buffer b, flush
26
+
27
+
let console_report src level ~over k msgf =
28
+
let k _ = console level (flush ()); over (); k () in
29
+
msgf @@ fun ?header ?tags fmt ->
30
+
match header with
31
+
| None -> Format.kfprintf k ppf ("@[" ^^ fmt ^^ "@]@.")
32
+
| Some h -> Format.kfprintf k ppf ("[%s] @[" ^^ fmt ^^ "@]@.") h
33
+
34
+
let console_reporter () = { Logs.report = console_report }
+19
vendor/opam/logs/src/browser/logs_browser.mli
+19
vendor/opam/logs/src/browser/logs_browser.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Web browser reporters for {!Logs}. *)
7
+
8
+
(** {1 Reporters} *)
9
+
10
+
val console_reporter : unit -> Logs.reporter
11
+
(** [console_reporter ()] logs message using the
12
+
{{:https://github.com/DeveloperToolsWG/console-object/blob/master/api.md}
13
+
browser console object} at the corresponding level and uses
14
+
[console.log] for the [App] level.
15
+
16
+
The reporter does not process or render information about
17
+
message sources or tags.
18
+
19
+
Consult the {{:http://caniuse.com/#search=console}browser support}. *)
+1
vendor/opam/logs/src/browser/logs_browser.mllib
+1
vendor/opam/logs/src/browser/logs_browser.mllib
···
1
+
Logs_browser
+7
vendor/opam/logs/src/cli/dune
+7
vendor/opam/logs/src/cli/dune
+47
vendor/opam/logs/src/cli/logs_cli.ml
+47
vendor/opam/logs/src/cli/logs_cli.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Cmdliner
7
+
8
+
let strf = Format.asprintf
9
+
10
+
let level ?env ?docs () =
11
+
let vopts =
12
+
let doc = "Increase verbosity. Repeatable, but more than twice does
13
+
not bring more."
14
+
in
15
+
Arg.(value & flag_all & info ["v"; "verbose"] ~doc ?docs)
16
+
in
17
+
let verbosity =
18
+
let enum =
19
+
[ "warning", None; (* Hack for the option's absent rendering *)
20
+
"quiet", Some None;
21
+
"error", Some (Some Logs.Error);
22
+
"warning", Some (Some Logs.Warning);
23
+
"info", Some (Some Logs.Info);
24
+
"debug", Some (Some Logs.Debug); ]
25
+
in
26
+
let log_level = Arg.enum enum in
27
+
let enum_alts = Arg.doc_alts_enum List.(tl enum) in
28
+
let doc = strf "Be more or less verbose. $(docv) must be %s. Takes over
29
+
$(b,-v)." enum_alts
30
+
in
31
+
Arg.(value & opt log_level None &
32
+
info ["verbosity"] ?env ~docv:"LEVEL" ~doc ?docs)
33
+
in
34
+
let quiet =
35
+
let doc = "Be quiet. Takes over $(b,-v) and $(b,--verbosity)." in
36
+
Arg.(value & flag & info ["q"; "quiet"] ~doc ?docs)
37
+
in
38
+
let choose quiet verbosity vopts =
39
+
if quiet then None else match verbosity with
40
+
| Some verbosity -> verbosity
41
+
| None ->
42
+
match List.length vopts with
43
+
| 0 -> Some Logs.Warning
44
+
| 1 -> Some Logs.Info
45
+
| n -> Some Logs.Debug
46
+
in
47
+
Term.(const choose $ quiet $ verbosity $ vopts)
+76
vendor/opam/logs/src/cli/logs_cli.mli
+76
vendor/opam/logs/src/cli/logs_cli.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** {!Cmdliner} support for {!Logs}.
7
+
8
+
See a full {{!ex}example}. *)
9
+
10
+
(** {1 Options for setting the report level} *)
11
+
12
+
val level : ?env:Cmdliner.Cmd.Env.info -> ?docs:string -> unit ->
13
+
Logs.level option Cmdliner.Term.t
14
+
(** [level ?env ?docs ()] is a term for three {!Cmdliner} options that
15
+
can be used with {!Logs.set_level}. The options are documented
16
+
under [docs] (defaults to the default of {!Cmdliner.Arg.info}).
17
+
18
+
The options work as follows:
19
+
{ul
20
+
{- [-v] or [--verbose], if it appears once, the value of
21
+
the term is [Some Logs.Info] and more than once
22
+
[Some Logs.Debug].}
23
+
{- [--verbosity=LEVEL], the value of the term is [l] where
24
+
[l] depends on on [LEVEL]. Takes over the option [-v].}
25
+
{- [-q] or [--quiet], the value of the term is [None]. Takes
26
+
over the [-v] and [--verbosity] options.}
27
+
{- If both options are absent the default value is
28
+
[Some Logs.warning]}}
29
+
30
+
If [env] is provided, the default value in case all options are
31
+
absent can be overridden by the corresponding environment
32
+
variable. *)
33
+
34
+
(** {1:ex Example}
35
+
36
+
The following example shows how to setup {!Logs} and {!Fmt} so
37
+
that logging is performed on standard outputs with ANSI coloring
38
+
if these are [tty]s. The command line interface provides options
39
+
to control the use of colors and the log reporting level.
40
+
{[
41
+
let hello _ msg =
42
+
Logs.app (fun m -> m "%s" msg);
43
+
Logs.info (fun m -> m "End-user information.");
44
+
Logs.debug (fun m -> m "Developer information.");
45
+
Logs.err (fun m -> m "Something bad happened.");
46
+
Logs.warn (fun m -> m "Something bad may happen in the future.");
47
+
if Logs.err_count () > 0 then 1 else 0
48
+
49
+
let setup_log ~style_renderer ~level =
50
+
Fmt_tty.setup_std_outputs ?style_renderer ();
51
+
Logs.set_level level;
52
+
Logs.set_reporter (Logs_fmt.reporter ())
53
+
54
+
(* Command line interface *)
55
+
56
+
open Cmdliner
57
+
open Cmdliner.Term.Syntax
58
+
59
+
let cmd =
60
+
Cmd.make (Cmd.info "tool") @@
61
+
let env = Cmd.Env.info "TOOL_VERBOSITY" in
62
+
let+ style_renderer = Fmt_cli.style_renderer ()
63
+
and+ level = Logs_cli.level ~env ()
64
+
and+ msg =
65
+
let doc = "The message to output." in
66
+
Arg.(value & pos 0 string "Hello horrible world!" & info [] ~doc)
67
+
in
68
+
setup_log ~style_renderer ~level;
69
+
hello msg
70
+
71
+
72
+
let main () = Cmd.eval' cmd
73
+
let () = if !Sys.interactive then () else exit (main ())
74
+
]}
75
+
76
+
*)
+1
vendor/opam/logs/src/cli/logs_cli.mllib
+1
vendor/opam/logs/src/cli/logs_cli.mllib
···
1
+
Logs_cli
+5
vendor/opam/logs/src/dune
+5
vendor/opam/logs/src/dune
+13
vendor/opam/logs/src/fmt/dune
+13
vendor/opam/logs/src/fmt/dune
+48
vendor/opam/logs/src/fmt/logs_fmt.ml
+48
vendor/opam/logs/src/fmt/logs_fmt.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let app_style = `Cyan
7
+
let err_style = `Red
8
+
let warn_style = `Yellow
9
+
let info_style = `Blue
10
+
let debug_style = `Green
11
+
12
+
let pp_brackets pp_v ppf v = Fmt.char ppf '['; pp_v ppf v; Fmt.char ppf ']'
13
+
14
+
let pp_header ~pp_h ppf (l, h) = match l with
15
+
| Logs.App ->
16
+
begin match h with
17
+
| None -> ()
18
+
| Some h ->
19
+
pp_brackets Fmt.(styled app_style string) ppf h; Fmt.char ppf ' '
20
+
end
21
+
| Logs.Error ->
22
+
pp_h ppf err_style (match h with None -> "ERROR" | Some h -> h)
23
+
| Logs.Warning ->
24
+
pp_h ppf warn_style (match h with None -> "WARNING" | Some h -> h)
25
+
| Logs.Info ->
26
+
pp_h ppf info_style (match h with None -> "INFO" | Some h -> h)
27
+
| Logs.Debug ->
28
+
pp_h ppf debug_style (match h with None -> "DEBUG" | Some h -> h)
29
+
30
+
let pp_exec_header =
31
+
let exec = match Array.length Sys.argv with
32
+
| 0 -> Filename.basename Sys.executable_name
33
+
| n -> Filename.basename Sys.argv.(0)
34
+
in
35
+
let pp_h ppf style h =
36
+
Fmt.string ppf exec;
37
+
Fmt.string ppf ": ";
38
+
pp_brackets Fmt.(styled style string) ppf h;
39
+
Fmt.char ppf ' ';
40
+
in
41
+
pp_header ~pp_h
42
+
43
+
let reporter ?(pp_header = pp_exec_header) ?app ?dst () =
44
+
Logs.format_reporter ~pp_header ?app ?dst ()
45
+
46
+
let pp_header =
47
+
let pp_h ppf style h = pp_brackets Fmt.(styled style string) ppf h in
48
+
pp_header ~pp_h
+40
vendor/opam/logs/src/fmt/logs_fmt.mli
+40
vendor/opam/logs/src/fmt/logs_fmt.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** {!Format} colorful reporter for {!Logs}. *)
7
+
8
+
(** {1 Reporter} *)
9
+
10
+
val reporter :
11
+
?pp_header:(Logs.level * string option) Fmt.t ->
12
+
?app:Format.formatter ->
13
+
?dst:Format.formatter -> unit -> Logs.reporter
14
+
(** [reporter] is like {!Logs.format_reporter} except ANSI colors may be
15
+
used in message header rendering if the formatters are configured to do so;
16
+
see {!Fmt.set_style_renderer} and {!Fmt_tty}.
17
+
18
+
Consult a full command line {{!Logs_cli.ex}setup example}. *)
19
+
20
+
(** {1:cheader Colored message headers} *)
21
+
22
+
val app_style : Fmt.style
23
+
(** [app_style] is the style used to render headers at app level. *)
24
+
25
+
val err_style : Fmt.style
26
+
(** [err_style] is the style used to render headers at error level. *)
27
+
28
+
val warn_style : Fmt.style
29
+
(** [warn_style] is the style used to render headers at warning level. *)
30
+
31
+
val info_style : Fmt.style
32
+
(** [info_style] is the style used to render headers at info level. *)
33
+
34
+
val debug_style : Fmt.style
35
+
(** [debug_style] is the style used to render headers at debug level. *)
36
+
37
+
val pp_header : (Logs.level * string option) Fmt.t
38
+
(** [pp_header] is like {!Logs.pp_header} but may use ANSI colors if the
39
+
formatter is configured to do so, see {!Fmt.set_style_renderer} and
40
+
{!Fmt_tty}. *)
+1
vendor/opam/logs/src/fmt/logs_fmt.mllib
+1
vendor/opam/logs/src/fmt/logs_fmt.mllib
···
1
+
Logs_fmt
+8
vendor/opam/logs/src/fmt/logs_fmt_top_init.ml
+8
vendor/opam/logs/src/fmt/logs_fmt_top_init.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let () =
7
+
Logs.set_reporter (Logs_fmt.reporter ());
8
+
()
+328
vendor/opam/logs/src/logs.ml
+328
vendor/opam/logs/src/logs.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let rec atomic_list_cons v atomic =
7
+
let l = Atomic.get atomic in
8
+
if Atomic.compare_and_set atomic l (v :: l) then () else
9
+
atomic_list_cons v atomic
10
+
11
+
(* Reporting levels *)
12
+
13
+
type level = App | Error | Warning | Info | Debug
14
+
let level' = Atomic.make (Some Warning)
15
+
let level () = Atomic.get level'
16
+
let pp_level ppf = function
17
+
| App -> ()
18
+
| Error -> Format.pp_print_string ppf "ERROR"
19
+
| Warning -> Format.pp_print_string ppf "WARNING"
20
+
| Info -> Format.pp_print_string ppf "INFO"
21
+
| Debug -> Format.pp_print_string ppf "DEBUG"
22
+
23
+
let level_to_string = function
24
+
| None -> "quiet" | Some App -> "app" | Some Error -> "error"
25
+
| Some Warning -> "warning" | Some Info -> "info" | Some Debug -> "debug"
26
+
27
+
let level_of_string = function
28
+
| "quiet" -> Ok None
29
+
| "app" -> Ok (Some App)
30
+
| "error" -> Ok (Some Error)
31
+
| "warning" -> Ok (Some Warning)
32
+
| "info" -> Ok (Some Info)
33
+
| "debug" -> Ok (Some Debug)
34
+
| l -> Error (`Msg (Printf.sprintf "%S: unknown log level" l))
35
+
36
+
(* Sources *)
37
+
38
+
module Src = struct
39
+
type t =
40
+
{ uid : int;
41
+
name : string;
42
+
doc : string;
43
+
level : level option Atomic.t }
44
+
45
+
let uid =
46
+
let id = Atomic.make 0 in
47
+
fun () -> Atomic.fetch_and_add id 1
48
+
49
+
let list = Atomic.make []
50
+
51
+
let create ?(doc = "undocumented") name =
52
+
let level = Atomic.make (Atomic.get level') in
53
+
let src = { uid = uid (); name; doc; level } in
54
+
atomic_list_cons src list; src
55
+
56
+
let name s = s.name
57
+
let doc s = s.doc
58
+
let level s = Atomic.get (s.level)
59
+
let set_level s l = Atomic.set s.level l
60
+
let equal src0 src1 = src0.uid = src1.uid
61
+
let compare src0 src1 = (compare : int -> int -> int) src0.uid src1.uid
62
+
63
+
let pp ppf src = Format.fprintf ppf
64
+
"@[<1>(src@ @[<1>(name %S)@]@ @[<1>(uid %d)@] @[<1>(doc %S)@])@]"
65
+
src.name src.uid src.doc
66
+
67
+
let list () = Atomic.get list
68
+
end
69
+
70
+
type src = Src.t
71
+
72
+
let default = Src.create "application" ~doc:"The application log"
73
+
74
+
let set_level ?(all = true) l =
75
+
Atomic.set level' l;
76
+
if all then List.iter (fun s -> Src.set_level s l) (Src.list ())
77
+
78
+
(* Message tags *)
79
+
80
+
module Tag = struct
81
+
82
+
(* Universal type, see http://mlton.org/UniversalType.
83
+
Note: we can get rid of that once we have OCaml >= 5.1 *)
84
+
85
+
type univ = exn
86
+
let univ (type s) () =
87
+
let module M = struct exception E of s option end in
88
+
(fun x -> M.E (Some x)), (function M.E x -> x | _ -> None)
89
+
90
+
(* Tag definitions *)
91
+
92
+
type 'a def =
93
+
{ uid : int;
94
+
to_univ : 'a -> univ;
95
+
of_univ : univ -> 'a option;
96
+
name : string;
97
+
doc : string;
98
+
pp : Format.formatter -> 'a -> unit; }
99
+
100
+
type def_e = Def : 'a def -> def_e
101
+
102
+
let list = Atomic.make ([] : def_e list)
103
+
let uid =
104
+
let id = Atomic.make 0 in
105
+
fun () -> Atomic.fetch_and_add id 1
106
+
107
+
let def ?(doc = "undocumented") name pp =
108
+
let to_univ, of_univ = univ () in
109
+
let tag = { uid = uid (); to_univ; of_univ; name; doc; pp } in
110
+
atomic_list_cons (Def tag) list;
111
+
tag
112
+
113
+
let name d = d.name
114
+
let doc d = d.doc
115
+
let printer d = d.pp
116
+
let pp_def ppf d = Format.fprintf ppf "tag:%s" d.name
117
+
let list () = Atomic.get list
118
+
119
+
(* Tag values *)
120
+
121
+
type t = V : 'a def * 'a -> t
122
+
123
+
let pp ppf (V (d, v)) =
124
+
Format.fprintf ppf "@[<1>(%a@ @[%a@])@]" pp_def d d.pp v
125
+
126
+
(* Tag sets *)
127
+
128
+
module Key = struct
129
+
type t = V : 'a def -> t
130
+
let compare (V k0) (V k1) = (compare : int -> int -> int) k0.uid k1.uid
131
+
end
132
+
133
+
module M = Map.Make (Key)
134
+
135
+
type set = t M.t
136
+
137
+
let empty = M.empty
138
+
let is_empty = M.is_empty
139
+
let mem k s = M.mem (Key.V k) s
140
+
let add k v s = M.add (Key.V k) (V (k, v)) s
141
+
let rem k s = M.remove (Key.V k) s
142
+
let find : type a. a def -> set -> a option =
143
+
fun k s ->
144
+
try match M.find (Key.V k) s with
145
+
| V (k', v) -> k.of_univ (k'.to_univ v)
146
+
with Not_found -> None
147
+
148
+
let get k s = match find k s with
149
+
| None -> invalid_arg (Printf.sprintf "tag named %s not found in set" k.name)
150
+
| Some v -> v
151
+
152
+
let fold f s acc = M.fold (fun _ t acc -> f t acc) s acc
153
+
let pp_set ppf s =
154
+
let pp_tag tag is_first =
155
+
if is_first then () else Format.fprintf ppf "@,";
156
+
Format.fprintf ppf "%a" pp tag;
157
+
false
158
+
in
159
+
Format.fprintf ppf "@[<1>{";
160
+
ignore (fold pp_tag s true);
161
+
Format.fprintf ppf "}@]";
162
+
()
163
+
end
164
+
165
+
(* Reporters *)
166
+
167
+
type ('a, 'b) msgf =
168
+
(?header:string -> ?tags:Tag.set ->
169
+
('a, Format.formatter, unit, 'b) format4 -> 'a) -> 'b
170
+
171
+
type reporter_mutex = { lock : unit -> unit; unlock : unit -> unit }
172
+
let reporter_mutex' =
173
+
Atomic.make { lock = (fun () -> ()); unlock = (fun () -> ()) }
174
+
175
+
let set_reporter_mutex ~lock ~unlock =
176
+
Atomic.set reporter_mutex' { lock; unlock }
177
+
178
+
type reporter =
179
+
{ report :
180
+
'a 'b. src -> level -> over:(unit -> unit) -> (unit -> 'b) ->
181
+
('a, 'b) msgf -> 'b }
182
+
183
+
let nop_reporter = { report = fun _ _ ~over k _ -> over (); k () }
184
+
let reporter' = Atomic.make nop_reporter
185
+
let set_reporter r = Atomic.set reporter' r
186
+
let reporter () = Atomic.get reporter'
187
+
let report src level ~over k msgf =
188
+
let mutex = Atomic.get reporter_mutex' in
189
+
let over () = over (); mutex.unlock () in
190
+
mutex.lock ();
191
+
try (Atomic.get reporter').report src level ~over k msgf with
192
+
| exn ->
193
+
let bt = Printexc.get_raw_backtrace () in
194
+
over ();
195
+
Printexc.raise_with_backtrace exn bt
196
+
197
+
let pp_brackets pp_v ppf v =
198
+
Format.pp_print_char ppf '['; pp_v ppf v; Format.pp_print_char ppf ']'
199
+
200
+
let pp_header ppf (l, h) = match h with
201
+
| None -> if l = App then () else pp_brackets pp_level ppf l
202
+
| Some h -> pp_brackets Format.pp_print_string ppf h
203
+
204
+
let pp_exec_header =
205
+
let exec = match Array.length Sys.argv with
206
+
| 0 -> Filename.basename Sys.executable_name
207
+
| n -> Filename.basename Sys.argv.(0)
208
+
in
209
+
fun ppf (l, h) ->
210
+
if l = App then match h with
211
+
| None -> ()
212
+
| Some h ->
213
+
pp_brackets Format.pp_print_string ppf h;
214
+
Format.pp_print_char ppf ' '
215
+
else match h with
216
+
| None ->
217
+
Format.pp_print_string ppf exec;
218
+
Format.pp_print_string ppf ": ";
219
+
pp_brackets pp_level ppf l;
220
+
Format.pp_print_char ppf ' '
221
+
| Some h ->
222
+
Format.pp_print_string ppf exec;
223
+
Format.pp_print_string ppf ": ";
224
+
pp_brackets Format.pp_print_string ppf h;
225
+
Format.pp_print_char ppf ' '
226
+
227
+
let format_reporter
228
+
?(pp_header = pp_exec_header)
229
+
?(app = Format.std_formatter)
230
+
?(dst = Format.err_formatter) ()
231
+
=
232
+
let report src level ~over k msgf =
233
+
let k ppf =
234
+
Format.pp_close_box ppf ();
235
+
Format.pp_print_newline ppf ();
236
+
over (); k ()
237
+
in
238
+
msgf @@ fun ?header ?tags fmt ->
239
+
let ppf = if level = App then app else dst in
240
+
pp_header ppf (level, header);
241
+
Format.pp_open_box ppf 0;
242
+
Format.kfprintf k ppf fmt
243
+
in
244
+
{ report }
245
+
246
+
(* Log functions *)
247
+
248
+
let err_count' = Atomic.make 0
249
+
let err_count () = Atomic.get err_count'
250
+
let incr_err_count () = Atomic.incr err_count'
251
+
252
+
let warn_count' = Atomic.make 0
253
+
let warn_count () = Atomic.get warn_count'
254
+
let incr_warn_count () = Atomic.incr warn_count'
255
+
256
+
type 'a log = ('a, unit) msgf -> unit
257
+
258
+
let over () = ()
259
+
let kmsg k ?(src = default) level msgf =
260
+
begin match level with
261
+
| Error -> Atomic.incr err_count'
262
+
| Warning -> Atomic.incr warn_count'
263
+
| _ -> ()
264
+
end;
265
+
match Src.level src with
266
+
| None -> k ()
267
+
| Some current_level when level > current_level -> k ()
268
+
| Some _ -> report src level ~over k msgf
269
+
270
+
let kunit _ = ()
271
+
let msg ?src level msgf = kmsg kunit ?src level msgf
272
+
let app ?src msgf = kmsg kunit ?src App msgf
273
+
let err ?src msgf = kmsg kunit ?src Error msgf
274
+
let warn ?src msgf = kmsg kunit ?src Warning msgf
275
+
let info ?src msgf = kmsg kunit ?src Info msgf
276
+
let debug ?src msgf = kmsg kunit ?src Debug msgf
277
+
278
+
(* Log result errors *)
279
+
280
+
let on_error ?src ?(level = Error) ?header ?tags ~pp ~use = function
281
+
| Ok v -> v
282
+
| Error e ->
283
+
kmsg (fun () -> use e) ?src level @@ fun m ->
284
+
m ?header ?tags "@[%a@]" pp e
285
+
286
+
let on_error_msg ?src ?(level = Error) ?header ?tags ~use = function
287
+
| Ok v -> v
288
+
| Error (`Msg msg) ->
289
+
kmsg use ?src level @@ fun m ->
290
+
m ?header ?tags "@[%a@]" Format.pp_print_text msg
291
+
292
+
(* Source specific logging functions *)
293
+
294
+
module type LOG = sig
295
+
val msg : level -> 'a log
296
+
val app : 'a log
297
+
val err : 'a log
298
+
val warn : 'a log
299
+
val info : 'a log
300
+
val debug : 'a log
301
+
val kmsg : (unit -> 'b) -> level -> ('a, 'b) msgf -> 'b
302
+
val on_error :
303
+
?level:level -> ?header:string -> ?tags:Tag.set ->
304
+
pp:(Format.formatter -> 'b -> unit) -> use:('b -> 'a) -> ('a, 'b) result ->
305
+
'a
306
+
307
+
val on_error_msg :
308
+
?level:level -> ?header:string -> ?tags:Tag.set ->
309
+
use:(unit -> 'a) -> ('a, [`Msg of string]) result -> 'a
310
+
end
311
+
312
+
let src_log src =
313
+
let module Log = struct
314
+
let msg level msgf = msg ~src level msgf
315
+
let kmsg k level msgf = kmsg k ~src level msgf
316
+
let app msgf = msg App msgf
317
+
let err msgf = msg Error msgf
318
+
let warn msgf = msg Warning msgf
319
+
let info msgf = msg Info msgf
320
+
let debug msgf = msg Debug msgf
321
+
let on_error ?level ?header ?tags ~pp ~use =
322
+
on_error ~src ?level ?header ?tags ~pp ~use
323
+
324
+
let on_error_msg ?level ?header ?tags ~use =
325
+
on_error_msg ~src ?level ?header ?tags ~use
326
+
end
327
+
in
328
+
(module Log : LOG)
+609
vendor/opam/logs/src/logs.mli
+609
vendor/opam/logs/src/logs.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Logging.
7
+
8
+
[Logs] provides a basic logging infrastructure. {{!func}Logging}
9
+
is performed on {{!srcs}sources} whose reporting
10
+
{{!type:level}level} can be set independently. Log message
11
+
report is decoupled from logging and handled by a
12
+
{{!reporters}reporter}.
13
+
14
+
See the {{!basics}basics}, a few {{!usage}usage conventions} to
15
+
respect and a note on {{!sync}synchronous logging}. *)
16
+
17
+
(** {1:levels Reporting levels} *)
18
+
19
+
(** The type for reporting levels. For level semantics see the
20
+
{{!usage}usage conventions}.
21
+
22
+
Log {{!srcs}sources} have an optional {{!Src.level}reporting level}. If
23
+
the level is [Some l] then any message whose level is smaller or
24
+
equal to [l] is reported. If the level is [None] no message is
25
+
ever reported. *)
26
+
type level = App | Error | Warning | Info | Debug
27
+
28
+
val level : unit -> level option
29
+
(** [level ()] is the reporting level given to {{!Src.create}new sources}. *)
30
+
31
+
val set_level : ?all:bool -> level option -> unit
32
+
(** [set_level ?all l] sets the reporting level given to
33
+
{{!Src.create}new sources}. If [all] is [true] (default), also
34
+
sets the reporting level of all {{!Src.list}existing sources}. Use
35
+
{!Src.set_level} to only affect a specific source. Only applications
36
+
should use this function directly see {{!usage}usage conventions}. *)
37
+
38
+
val pp_level : Format.formatter -> level -> unit
39
+
(** [pp_level ppf l] prints an unspecified representation of [l] on
40
+
[ppf]. *)
41
+
42
+
val level_to_string : level option -> string
43
+
(** [level_to_string l] converts [l] to an US-ASCII string that can be
44
+
parsed back by {!level_of_string} and by the [LEVEL] option
45
+
argument of {!Logs_cli.level}. *)
46
+
47
+
val level_of_string : string -> (level option, [`Msg of string]) result
48
+
(** [level_of_string s] parses the representation of {!level_to_string}
49
+
from [s]. *)
50
+
51
+
(** {1:srcs Log sources} *)
52
+
53
+
type src
54
+
(** The type for log sources. A source defines a named unit of logging
55
+
whose reporting level can be set independently. *)
56
+
57
+
val default : src
58
+
(** [default] is a logging source that is reserved for use by
59
+
applications. See {{!usage}usage conventions}. *)
60
+
61
+
(** Sources. *)
62
+
module Src : sig
63
+
64
+
(** {1 Sources} *)
65
+
66
+
type t = src
67
+
(** The type for log sources. *)
68
+
69
+
val create : ?doc:string -> string -> src
70
+
(** [create ?doc name] is a new log source. [name] is the name of
71
+
the source; it doesn't need to be unique but it is good practice
72
+
to prefix the name with the name of your package or library
73
+
(e.g. ["mypkg.network"]). [doc] is a documentation string
74
+
describing the source, defaults to ["undocumented"]. The initial
75
+
reporting level of the source is defined by {!Logs.level}. *)
76
+
77
+
val name : src -> string
78
+
(** [name] is [src]'s name. *)
79
+
80
+
val doc : src -> string
81
+
(** [doc src] is [src]'s documentation string. *)
82
+
83
+
val level : src -> level option
84
+
(** [level src] is the report level of [src] (if any). *)
85
+
86
+
val set_level : src -> level option -> unit
87
+
(** [set_level src l] sets the report level of [src] to [l]. Only
88
+
applications should use this function directly, see {{!usage}usage
89
+
conventions}. *)
90
+
91
+
val equal : src -> src -> bool
92
+
(** [equal src src'] is [true] iff [src] and [src'] are the same source. *)
93
+
94
+
val compare : src -> src -> int
95
+
(** [compare src src'] is a total order on sources. *)
96
+
97
+
val pp : Format.formatter -> src -> unit
98
+
(** [pp ppf src] prints an unspecified representation of [src] on
99
+
[ppf]. *)
100
+
101
+
val list : unit -> src list
102
+
(** [list ()] is the current exisiting source list. *)
103
+
end
104
+
105
+
(** {1:func Log functions} *)
106
+
107
+
(** Message tags.
108
+
109
+
Message tags are arbitrary named and typed values that can be
110
+
associated to log messages. See an {{!ex1}example}. *)
111
+
module Tag : sig
112
+
113
+
(** {1 Tag definitions} *)
114
+
115
+
type 'a def
116
+
(** The type for tag definitions. The type ['a] is the type of the
117
+
tag. The definition specifies a name for the tag, a pretty-printer
118
+
for the type of the tag and a documentation string. See {!val:def}. *)
119
+
120
+
(** The type for existential tag definitions. *)
121
+
type def_e = Def : 'a def -> def_e
122
+
123
+
val def : ?doc:string -> string -> (Format.formatter -> 'a -> unit) -> 'a def
124
+
(** [def ~doc name pp] is a tag definition. [name] is the name of
125
+
the tag, it doesn't need to be unique. [pp] is a printer for the
126
+
type of the tag. [doc] is a documentation string describing
127
+
the tag (defaults to ["undocumented"]). *)
128
+
129
+
val name : 'a def -> string
130
+
(** [name d] is [d]'s name. *)
131
+
132
+
val doc : 'a def -> string
133
+
(** [doc d] is [d]'s documentation string. *)
134
+
135
+
val printer : 'a def -> (Format.formatter -> 'a -> unit)
136
+
(** [printer d] is [d]'s type pretty-printer. *)
137
+
138
+
val pp_def : Format.formatter -> 'a def -> unit
139
+
(** [pp_def ppf d] prints an unspecified representation of [d] on [ppf]. *)
140
+
141
+
val list : unit -> def_e list
142
+
(** [tag_list ()] is the list of currently existing tag definitions. *)
143
+
144
+
(** {1 Tags} *)
145
+
146
+
(** The type for tags. Tuples the tag definition and its value. *)
147
+
type t = V : 'a def * 'a -> t
148
+
149
+
val pp : Format.formatter -> t -> unit
150
+
(** [pp ppf t] prints an unspecified representation of [t] on [ppf]. *)
151
+
152
+
(** {1 Tag sets} *)
153
+
154
+
type set
155
+
(** The type for tag sets. A tag set contains at most one tag per
156
+
tag definition. *)
157
+
158
+
val empty : set
159
+
(** [empty] is the empty set. *)
160
+
161
+
val is_empty : set -> bool
162
+
(** [is_empty s] is [true] iff [s] is empty. *)
163
+
164
+
val mem : 'a def -> set -> bool
165
+
(** [mem d s] is [true] iff [s] has a tag with definition [d]. *)
166
+
167
+
val add : 'a def -> 'a -> set -> set
168
+
(** [add d v s] is [s] with the tag [(V (d, v))] added. If there was a tag
169
+
with definition [d] in [s] it is replaced. *)
170
+
171
+
val rem : 'a def -> set -> set
172
+
(** [rem d s] is [s] without the tag defined by [d] (if there was one). *)
173
+
174
+
val find : 'a def -> set -> 'a option
175
+
(** [find d s] is the tag value with definition [d] in [s] (if any). *)
176
+
177
+
val get : 'a def -> set -> 'a
178
+
(** [get d s] is like [find d s] but @raise Invalid_argument if there
179
+
is no tag with definition [d] in [s]. *)
180
+
181
+
val fold : (t -> 'a -> 'a) -> set -> 'a -> 'a
182
+
(** [fold f s acc] is the result of folding [f] over the tags
183
+
of [s] starting with [acc]. *)
184
+
185
+
val pp_set : Format.formatter -> set -> unit
186
+
(** [pp_set ppf s] prints an unspecified representation of s on [ppf]. *)
187
+
end
188
+
189
+
type ('a, 'b) msgf =
190
+
(?header:string -> ?tags:Tag.set ->
191
+
('a, Format.formatter, unit, 'b) format4 -> 'a) -> 'b
192
+
(** The type for client specified message formatting functions.
193
+
194
+
Message formatting functions are called with a message
195
+
construction function whenever a message needs to be reported. The
196
+
message formatting function must call the given message
197
+
construction function with a format string and its arguments to
198
+
define the message contents, see the {{!logging}basics} for examples.
199
+
The optional arguments of the message construction function are:
200
+
{ul
201
+
{- [header], an optional printable message header. Default to [None].}
202
+
{- [tags], a set of tags to attach to the message. Defaults
203
+
{!Tag.empty}.}} *)
204
+
205
+
type 'a log = ('a, unit) msgf -> unit
206
+
(** The type for log functions. See the {{!logging}basics} to understand
207
+
how to use log functions. *)
208
+
209
+
val msg : ?src:src -> level -> 'a log
210
+
(** [msg ?src l (fun m -> m fmt ...)] logs with level [l] on the source
211
+
[src] (defaults to {!default}) a message formatted with [fmt]. For the
212
+
semantics of levels see the {{!usage}the usage conventions}. *)
213
+
214
+
val app : ?src:src -> 'a log
215
+
(** [app] is [msg App]. *)
216
+
217
+
val err : ?src:src -> 'a log
218
+
(** [err] is [msg Error]. *)
219
+
220
+
val warn : ?src:src -> 'a log
221
+
(** [warn] is [msg Warning]. *)
222
+
223
+
val info : ?src:src -> 'a log
224
+
(** [info] is [msg Info]. *)
225
+
226
+
val debug : ?src:src -> 'a log
227
+
(** [debug] is [msg Debug]. *)
228
+
229
+
val kmsg : (unit -> 'b) -> ?src:src -> level -> ('a, 'b) msgf -> 'b
230
+
(** [kmsg k] is like {!msg} but calls [k] for returning. *)
231
+
232
+
(** {2:result Logging [result] value [Error]s} *)
233
+
234
+
val on_error : ?src:src -> ?level:level -> ?header:string -> ?tags:Tag.set ->
235
+
pp:(Format.formatter -> 'b -> unit) -> use:('b -> 'a) -> ('a, 'b) result -> 'a
236
+
(** [on_error ~level ~pp ~use r] is:
237
+
{ul
238
+
{- [v] if [r = Ok v]}
239
+
{- [use e] if [r = Error e]. As a side effect [msg] is logged
240
+
with [pp] on level [level] (defaults to {!Logs.Error}).}} *)
241
+
242
+
val on_error_msg : ?src:src -> ?level:level -> ?header:string ->
243
+
?tags:Tag.set -> use:(unit -> 'a) ->
244
+
('a, [`Msg of string]) result -> 'a
245
+
(** [on_error_msg] is like {!on_error} but uses
246
+
{!Format.pp_print_text} to format the message. *)
247
+
248
+
(** {1:srcfunc Source specific log functions} *)
249
+
250
+
(** The type for source specific logging functions. *)
251
+
module type LOG = sig
252
+
253
+
(** {1:func Log functions} *)
254
+
255
+
val msg : level -> 'a log
256
+
(** See {!Logs.msg}. *)
257
+
258
+
val app : 'a log
259
+
(** [app] is [msg App]. *)
260
+
261
+
val err : 'a log
262
+
(** [err] is [msg Error]. *)
263
+
264
+
val warn : 'a log
265
+
(** [warn] is [msg Warning]. *)
266
+
267
+
val info : 'a log
268
+
(** [info] is [msg Info]. *)
269
+
270
+
val debug : 'a log
271
+
(** [debug] is [msg Debug]. *)
272
+
273
+
val kmsg : (unit -> 'b) -> level -> ('a, 'b) msgf -> 'b
274
+
(** See {!Logs.kmsg}. *)
275
+
276
+
(** {2:result Logging [result] value [Error]s} *)
277
+
278
+
val on_error : ?level:level -> ?header:string -> ?tags:Tag.set ->
279
+
pp:(Format.formatter -> 'b -> unit) -> use:('b -> 'a) -> ('a, 'b) result ->
280
+
'a
281
+
(** See {!Logs.on_error}. *)
282
+
283
+
val on_error_msg : ?level:level -> ?header:string -> ?tags:Tag.set ->
284
+
use:(unit -> 'a) -> ('a, [`Msg of string]) result -> 'a
285
+
(** See {!Logs.on_error_msg}. *)
286
+
end
287
+
288
+
val src_log : src -> (module LOG)
289
+
(** [src_log src] is a {{!LOG}set of logging functions} for [src]. *)
290
+
291
+
(** {1:reporters Reporters} *)
292
+
293
+
type reporter =
294
+
{ report : 'a 'b. src -> level -> over:(unit -> unit) -> (unit -> 'b) ->
295
+
('a, 'b) msgf -> 'b }
296
+
(** The type for reporters.
297
+
298
+
A reporter formats and handles log messages that get
299
+
reported. Whenever a {{!func}log function} gets called on a source
300
+
with a level equal or smaller to the {{!Src.level}source's reporting
301
+
level}, the {{!reporter}current reporter}'s field [r.report]
302
+
gets called as [r.report src level ~over k msgf]
303
+
where:
304
+
{ul
305
+
{- [src] is the logging source.}
306
+
{- [level] is the reporting level.}
307
+
{- [over] must be called by the reporter once the logging operation is
308
+
over from the reporter's perspective. This may happen before or
309
+
after [k] is called.}
310
+
{- [k] is the function to invoke to return.}
311
+
{- [msgf] is the {{!msgf}message formatting function} to call.}}
312
+
See an {{!ex1}example}. *)
313
+
314
+
val nop_reporter : reporter
315
+
(** [nop_reporter] is the initial reporter returned by {!reporter}, it
316
+
does nothing if a log message gets reported. *)
317
+
318
+
val format_reporter :
319
+
?pp_header:(Format.formatter -> (level * string option) -> unit) ->
320
+
?app:Format.formatter -> ?dst:Format.formatter -> unit -> reporter
321
+
(** [format_reporter ~pp_header ~app ~dst ()] is a reporter that reports
322
+
{!App} level messages on [app] (defauts to {!Format.std_formatter})
323
+
and all other level on [dst] (defaults to {!Format.err_formatter}).
324
+
325
+
[pp_header] determines how message headers are rendered. The default
326
+
prefixes the program name and renders the header with {!pp_header}.
327
+
Use {!Logs_fmt.reporter} if you want colored headers rendering.
328
+
329
+
The reporter does not process or render information about message
330
+
sources or tags.
331
+
332
+
{b Important.} This is a synchronous reporter it considers the log
333
+
operation to be over once the message was formatted and before
334
+
calling the continuation (see the {{!Logs.sync}note on synchronous
335
+
logging}). In particular if the formatters are backed by channels,
336
+
it will block until the message has been formatted on the channel
337
+
before proceeding which may not be suitable in a cooperative
338
+
concurrency setting like {!Lwt}. *)
339
+
340
+
val reporter : unit -> reporter
341
+
(** [reporter ()] is the current repporter. *)
342
+
343
+
val set_reporter : reporter -> unit
344
+
(** [set_reporter r] sets the current reporter to [r]. *)
345
+
346
+
val set_reporter_mutex : lock:(unit -> unit) -> unlock:(unit -> unit) -> unit
347
+
(** [set_reporter_mutex ~lock ~unlock] sets the mutex primitives used
348
+
to access the reporter. [lock] is called before invoking the
349
+
reporter and [unlock] after it returns. Initially both [lock] and
350
+
[unlock] are [fun () -> ()]. *)
351
+
352
+
(**/**)
353
+
val report : src -> level -> over:(unit -> unit) -> (unit -> 'b) ->
354
+
('a, 'b) msgf -> 'b
355
+
val incr_err_count : unit -> unit
356
+
val incr_warn_count : unit -> unit
357
+
(**/**)
358
+
359
+
val pp_header : Format.formatter -> (level * string option) -> unit
360
+
(** [pp_header ppf (l, h)] prints an unspecified representation
361
+
of log header [h] for level [l]. *)
362
+
363
+
(** {1:monitoring Logs monitoring} *)
364
+
365
+
val err_count : unit -> int
366
+
(** [err_count ()] is the number of messages logged with level [Error]
367
+
across all sources. *)
368
+
369
+
val warn_count : unit -> int
370
+
(** [warn_count ()] is the number of messages logged with level
371
+
[Warning] across all sources. *)
372
+
373
+
(** {1:basics Basics}
374
+
375
+
{2:logging Logging}
376
+
377
+
In order to minimize the overhead whenever a log message is not reported,
378
+
message formatting only occurs on actual message report via the
379
+
{{!msgf}message formatting function} you provide to log functions. This
380
+
leads to the following logging structure:
381
+
{[
382
+
let k, v = ... in
383
+
Logs.err (fun m -> m "invalid kv (%a,%a)" pp_key k pp_val v);
384
+
Logs.err (fun m -> m "NO CARRIER");
385
+
]}
386
+
The pattern is quite simple: it is as if you were formatting with
387
+
a [printf]-like function except you get this function in the [m]
388
+
argument of the function you give to the logging function.
389
+
390
+
If you want to abstract a repeated log report it is better to keep
391
+
the message formatting function structure for the arguments of the
392
+
messages. Here's how the above examples can be abstracted and
393
+
invoked:
394
+
{[
395
+
let err_invalid_kv args =
396
+
Logs.err @@ fun m ->
397
+
args (fun k v -> m "invalid kv (%a,%a)" pp_key k pp_val v)
398
+
399
+
let err_no_carrier args =
400
+
Logs.err @@ fun m -> args (m "NO CARRIER")
401
+
402
+
let () =
403
+
err_invalid_kv (fun args -> args "key" "value");
404
+
err_no_carrier (fun () -> ());
405
+
()
406
+
]}
407
+
Note that log messages are formatted and hit the reporter only if
408
+
they have not been filtered out by the current
409
+
{{!Src.level}reporting level} of the source you log on. See also
410
+
the log source and reporting level {{!usage}usage conventions}.
411
+
412
+
{2:setupreporter Reporter setup}
413
+
414
+
If you are writing an application you must remember to
415
+
{{!set_reporter}set} the reporter before any logging operation
416
+
takes place otherwise no messages will be reported. For example if
417
+
you are using the {{!Logs_fmt}formatter reporter}, logging
418
+
can be setup as follows:
419
+
{[
420
+
let main () =
421
+
Logs.set_reporter (Logs_fmt.reporter ());
422
+
...
423
+
if Logs.err_count () > 0 then 1 else 0
424
+
425
+
let () = if !Sys.interactive then () else exit (main ())
426
+
]}
427
+
If you have logging code that is performed in the toplevel
428
+
initialization code of modules (not a good idea) or you depend on
429
+
(bad) libraries that do so, you must call and link the reporter
430
+
install code before these initialization bits are being executed
431
+
otherwise you will miss these messages.
432
+
433
+
In multi-threaded programs you likely want to ensure mutual
434
+
exclusion on reporter access. This can be done by invoking
435
+
{!Logs.set_reporter_mutex} with suitable mutual exclusion
436
+
primitives. If you use OCaml {!Thread}s simply calling
437
+
{!Logs_threaded.enable} with handle that for you.
438
+
439
+
If you need to use multiple reporters in your program see this
440
+
{{!ex2}sample code}.
441
+
442
+
The documentation of {!Logs_cli} module has a {{!Logs_cli.ex}full setup
443
+
example} that includes command line options to control color and log
444
+
reporting level.
445
+
446
+
If you are writing a library you should neither install reporters, nor
447
+
set the reporting level of sources, nor log on the {!default} source or
448
+
at the [App] level; follow the {{!usage}the usage conventions}. A
449
+
library should simply log on another existing source or define
450
+
its own source like in the example below:
451
+
{[
452
+
let src = Logs.Src.create "mylib.network" ~doc:"logs mylib's network events"
453
+
module Log = (val Logs.src_log src : Logs.LOG)
454
+
]}
455
+
The [Log] module defines logging functions that are specific to the
456
+
source [src].
457
+
458
+
{1:usage Usage conventions}
459
+
460
+
A library should never log on the {!default} source or at the
461
+
[App] level these are reserved for use by the application. It
462
+
should either create a source for itself or log on the source
463
+
defined by one of its dependencies. It should also never set the
464
+
reporting level of the sources it deals with or install reporters since
465
+
control over this must be left to the application.
466
+
467
+
The semantics of {{!type:level}reporting levels} should be understood
468
+
as follows:
469
+
{ul
470
+
{- [App], this level can be used for the standard output or console
471
+
of an application. It should never be used by libraries.}
472
+
{- [Error], error condition that prevent the program from
473
+
running normally.}
474
+
{- [Warning], suspicious condition that does not prevent the
475
+
program from running normally but may eventually lead to an
476
+
error condition.}
477
+
{- [Info], condition that allows the program {e user} to get a better
478
+
understanding of what the program is doing.}
479
+
{- [Debug], condition that allows the program {e developer} to get a
480
+
better understanding of what the program is doing.}}
481
+
482
+
{1:sync Note on synchronous logging}
483
+
484
+
In synchronous logging, a client call to a log function proceeds
485
+
only once the reporter has finished the report operation. In
486
+
[Logs] this depends both on the reporter and the log functions
487
+
that the client uses.
488
+
489
+
Whenever the client uses a log function that results in a report,
490
+
it gives the reporter a continuation that defines the result type
491
+
of the log function and a callback to be called whenever the log
492
+
operation is over from the reporter's perspective (see {!type:reporter}).
493
+
The typical use of the callback is to unblock the continuation given
494
+
to the reporter. This is used by {!Logs_lwt}'s log functions to make
495
+
sure that the threads they return proceed only once the report is over.
496
+
In the functions of {!Logs} however the callback does nothing as there
497
+
is no way to block the polymorphic continuation.
498
+
499
+
Now considering reporters, at the extreme we have:
500
+
{ul
501
+
{- A completely asynchronous reporter. This reporter formats the
502
+
message in memory and immediately invoke the callback followed
503
+
by the continuation. This provides no guarantee of persistency
504
+
in case a crash occurs. All log functions behave asynchronously
505
+
and return as soon as possible.}
506
+
{- A completely synchronous reporter. This reporter formats the
507
+
message, persist it, invoke the client callback followed by the
508
+
continuation. All log functions behave synchronously. An
509
+
example of such a reporter is {!Logs_fmt.reporter} with
510
+
formatters baked by channels: when formatting returns the
511
+
message has been written on the channel.}}
512
+
513
+
However a purely synchronous reporter like {!Logs_fmt.reporter}
514
+
acting on channels does not play well with [Lwt]'s cooperative
515
+
runtime system. It is possible to reuse {!Logs_fmt.reporter} to
516
+
define a cooperative reporter, see {{!Logs_lwt.report_ex}this
517
+
example}. However while this reporter makes {!Logs_lwt}'s log
518
+
functions synchronous, those of {!Logs} behave asynchronously. For
519
+
now it seems it that this is unfortunately the best we can do if
520
+
we want to preserve the ability to use [Logs] with or without
521
+
cooperative concurency.
522
+
523
+
{1:ex1 Example with custom reporter and tags}
524
+
525
+
This example uses a {{!Tag}tag} to attach {!Mtime} time spans in
526
+
log messages. The custom reporter uses these time spans to format
527
+
relative timings for runs of a given function. Note that as done
528
+
below the timings do include logging time.
529
+
{[
530
+
let stamp_tag : Mtime.span Logs.Tag.def =
531
+
Logs.Tag.def "stamp" ~doc:"Relative monotonic time stamp" Mtime.Span.pp
532
+
533
+
let stamp c = Logs.Tag.(empty |> add stamp_tag (Mtime_clock.count c))
534
+
535
+
let run () =
536
+
let rec wait n = if n = 0 then () else wait (n - 1) in
537
+
let c = Mtime_clock.counter () in
538
+
Logs.info (fun m -> m "Starting run");
539
+
let delay1, delay2, delay3 = 10_000, 20_000, 40_000 in
540
+
Logs.info (fun m -> m "Start action 1 (%d)." delay1 ~tags:(stamp c));
541
+
wait delay1;
542
+
Logs.info (fun m -> m "Start action 2 (%d)." delay2 ~tags:(stamp c));
543
+
wait delay2;
544
+
Logs.info (fun m -> m "Start action 3 (%d)." delay3 ~tags:(stamp c));
545
+
wait delay3;
546
+
Logs.info (fun m -> m "Done." ?header:None ~tags:(stamp c));
547
+
()
548
+
549
+
let reporter ppf =
550
+
let report src level ~over k msgf =
551
+
let k _ = over (); k () in
552
+
let with_stamp h tags k ppf fmt =
553
+
let stamp = match tags with
554
+
| None -> None
555
+
| Some tags -> Logs.Tag.find stamp_tag tags
556
+
in
557
+
let dt = match stamp with None -> 0. | Some s -> Mtime.Span.to_us s in
558
+
Format.kfprintf k ppf ("%a[%0+04.0fus] @[" ^^ fmt ^^ "@]@.")
559
+
Logs.pp_header (level, h) dt
560
+
in
561
+
msgf @@ fun ?header ?tags fmt -> with_stamp header tags k ppf fmt
562
+
in
563
+
{ Logs.report = report }
564
+
565
+
let main () =
566
+
Logs.set_reporter (reporter (Format.std_formatter));
567
+
Logs.set_level (Some Logs.Info);
568
+
run ();
569
+
run ();
570
+
if Logs.err_count () > 0 then 1 else 0
571
+
572
+
let () = if !Sys.interactive then () else main ()
573
+
]}
574
+
Here is the standard output of a sample run of the program:
575
+
{v
576
+
[INFO][+000us] Starting run
577
+
[INFO][+168us] Start action 1 (10000).
578
+
[INFO][+206us] Start action 2 (20000).
579
+
[INFO][+243us] Start action 3 (40000).
580
+
[INFO][+303us] Done.
581
+
[INFO][+000us] Starting run
582
+
[INFO][+012us] Start action 1 (10000).
583
+
[INFO][+038us] Start action 2 (20000).
584
+
[INFO][+074us] Start action 3 (40000).
585
+
[INFO][+133us] Done.
586
+
v}
587
+
588
+
{1:ex2 Logging to multiple reporters}
589
+
590
+
Logging to multiple reporters can be achieved by defining a new reporter
591
+
that simply forwards to them. The following example combines
592
+
two reporters:
593
+
{[
594
+
let combine r1 r2 =
595
+
let report = fun src level ~over k msgf ->
596
+
let v = r1.Logs.report src level ~over:(fun () -> ()) k msgf in
597
+
r2.Logs.report src level ~over (fun () -> v) msgf
598
+
in
599
+
{ Logs.report }
600
+
601
+
let () =
602
+
let r1 = Logs.format_reporter () in
603
+
let r2 = Logs_fmt.reporter () in
604
+
Fmt_tty.setup_std_outputs ();
605
+
Logs.set_reporter (combine r1 r2);
606
+
Logs.err (fun m -> m "HEY HO!");
607
+
()
608
+
]}
609
+
*)
+1
vendor/opam/logs/src/logs.mllib
+1
vendor/opam/logs/src/logs.mllib
···
1
+
Logs
+7
vendor/opam/logs/src/lwt/dune
+7
vendor/opam/logs/src/lwt/dune
+82
vendor/opam/logs/src/lwt/logs_lwt.ml
+82
vendor/opam/logs/src/lwt/logs_lwt.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type 'a log = ('a, unit Lwt.t) Logs.msgf -> unit Lwt.t
7
+
8
+
let kmsg k ?(src = Logs.default) level msgf =
9
+
begin match level with
10
+
| Logs.Error -> Logs.incr_err_count ()
11
+
| Logs.Warning -> Logs.incr_warn_count ()
12
+
| _ -> ()
13
+
end;
14
+
match Logs.Src.level src with
15
+
| None -> k ()
16
+
| Some current_level when level > current_level -> k ()
17
+
| Some _ ->
18
+
let (ret, unblock) = Lwt.wait () in
19
+
let k () = Lwt.bind ret k in
20
+
let over () = Lwt.wakeup unblock () in
21
+
Logs.report src level ~over k msgf
22
+
23
+
let kunit _ = Lwt.return ()
24
+
let msg ?src level msgf = kmsg kunit ?src level msgf
25
+
let app ?src msgf = kmsg kunit ?src Logs.App msgf
26
+
let err ?src msgf = kmsg kunit ?src Logs.Error msgf
27
+
let warn ?src msgf = kmsg kunit ?src Logs.Warning msgf
28
+
let info ?src msgf = kmsg kunit ?src Logs.Info msgf
29
+
let debug ?src msgf = kmsg kunit ?src Logs.Debug msgf
30
+
31
+
let on_error ?src ?(level = Logs.Error) ?header ?tags ~pp ~use t =
32
+
Lwt.bind t @@ function
33
+
| Ok v -> Lwt.return v
34
+
| Error e ->
35
+
kmsg (fun () -> use e) ?src level @@ fun m ->
36
+
m ?header ?tags "@[%a@]" pp e
37
+
38
+
let on_error_msg ?src ?(level = Logs.Error) ?header ?tags ~use t =
39
+
Lwt.bind t @@ function
40
+
| Ok v -> Lwt.return v
41
+
| Error (`Msg e) ->
42
+
kmsg use ?src level @@ fun m ->
43
+
m ?header ?tags "@[%a@]" Format.pp_print_text e
44
+
45
+
(* Source specific functions *)
46
+
47
+
module type LOG = sig
48
+
val msg : Logs.level -> 'a log
49
+
val app : 'a log
50
+
val err : 'a log
51
+
val warn : 'a log
52
+
val info : 'a log
53
+
val debug : 'a log
54
+
val kmsg : ?over:(unit -> unit) -> (unit -> 'b Lwt.t) ->
55
+
Logs.level -> ('a, 'b Lwt.t) Logs.msgf -> 'b Lwt.t
56
+
57
+
val on_error : ?level:Logs.level -> ?header:string -> ?tags:Logs.Tag.set ->
58
+
pp:(Format.formatter -> 'b -> unit) -> use:('b -> 'a Lwt.t) ->
59
+
('a, 'b) result Lwt.t -> 'a Lwt.t
60
+
61
+
val on_error_msg : ?level:Logs.level -> ?header:string ->
62
+
?tags:Logs.Tag.set -> use:(unit -> 'a Lwt.t) ->
63
+
('a, [`Msg of string]) result Lwt.t -> 'a Lwt.t
64
+
end
65
+
66
+
let src_log src =
67
+
let module Log = struct
68
+
let msg level msgf = msg ~src level msgf
69
+
let kmsg ?over k level msgf = kmsg k ~src level msgf
70
+
let app msgf = msg Logs.App msgf
71
+
let err msgf = msg Logs.Error msgf
72
+
let warn msgf = msg Logs.Warning msgf
73
+
let info msgf = msg Logs.Info msgf
74
+
let debug msgf = msg Logs.Debug msgf
75
+
let on_error ?level ?header ?tags ~pp ~use =
76
+
on_error ~src ?level ?header ?tags ~pp ~use
77
+
78
+
let on_error_msg ?level ?header ?tags ~use =
79
+
on_error_msg ~src ?level ?header ?tags ~use
80
+
end
81
+
in
82
+
(module Log : LOG)
+129
vendor/opam/logs/src/lwt/logs_lwt.mli
+129
vendor/opam/logs/src/lwt/logs_lwt.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** {!Lwt} logging.
7
+
8
+
The log functions of this module return [Lwt] threads that proceed
9
+
only when the log operation is over, as defined by the current
10
+
{!Logs.reporter}.
11
+
12
+
See a {{!report_ex}cooperative reporter example}. *)
13
+
14
+
(** {1 Log functions} *)
15
+
16
+
type 'a log = ('a, unit Lwt.t) Logs.msgf -> unit Lwt.t
17
+
(** The type for Lwt log functions. The returned thread only proceeds
18
+
once the log operation is over. See {!Logs.log}. *)
19
+
20
+
val msg : ?src:Logs.src -> Logs.level -> 'a log
21
+
(** See {!Logs.msg}. *)
22
+
23
+
val app : ?src:Logs.src -> 'a log
24
+
(** See {!Logs.app}. *)
25
+
26
+
val err : ?src:Logs.src -> 'a log
27
+
(** See {!Logs.err}. *)
28
+
29
+
val warn : ?src:Logs.src -> 'a log
30
+
(** See {!Logs.warn}. *)
31
+
32
+
val info : ?src:Logs.src -> 'a log
33
+
(** See {!Logs.info}. *)
34
+
35
+
val debug : ?src:Logs.src -> 'a log
36
+
(** See {!Logs.debug}. *)
37
+
38
+
val kmsg : (unit -> 'b Lwt.t) -> ?src:Logs.src ->
39
+
Logs.level -> ('a, 'b Lwt.t) Logs.msgf -> 'b Lwt.t
40
+
(** See {!Logs.kmsg}. *)
41
+
42
+
(** {2 Logging {!result} value [Error]s} *)
43
+
44
+
val on_error : ?src:Logs.src -> ?level:Logs.level -> ?header:string ->
45
+
?tags:Logs.Tag.set -> pp:(Format.formatter -> 'b -> unit) ->
46
+
use:('b -> 'a Lwt.t) -> ('a, 'b) result Lwt.t -> 'a Lwt.t
47
+
(** See {!Logs.on_error}. *)
48
+
49
+
val on_error_msg : ?src:Logs.src -> ?level:Logs.level -> ?header:string ->
50
+
?tags:Logs.Tag.set -> use:(unit -> 'a Lwt.t) ->
51
+
('a, [`Msg of string]) result Lwt.t -> 'a Lwt.t
52
+
(** See {!Logs.on_error_msg}. *)
53
+
54
+
(** {1 Source specific log functions} *)
55
+
56
+
module type LOG = sig
57
+
val msg : Logs.level -> 'a log
58
+
(** See {!Logs.msg}. *)
59
+
60
+
val app : 'a log
61
+
(** See {!Logs.app}. *)
62
+
63
+
val err : 'a log
64
+
(** See {!Logs.err}. *)
65
+
66
+
val warn : 'a log
67
+
(** See {!Logs.warn}. *)
68
+
69
+
val info : 'a log
70
+
(** See {!Logs.info}. *)
71
+
72
+
val debug : 'a log
73
+
(** See {!Logs.debug}. *)
74
+
75
+
val kmsg : ?over:(unit -> unit) -> (unit -> 'b Lwt.t) ->
76
+
Logs.level -> ('a, 'b Lwt.t) Logs.msgf -> 'b Lwt.t
77
+
(** See {!Logs.kmsg}. *)
78
+
79
+
(** {2 Logging {!result} value [Error]s} *)
80
+
81
+
val on_error : ?level:Logs.level -> ?header:string ->
82
+
?tags:Logs.Tag.set -> pp:(Format.formatter -> 'b -> unit) ->
83
+
use:('b -> 'a Lwt.t) -> ('a, 'b) result Lwt.t -> 'a Lwt.t
84
+
(** See {!Logs.on_error}. *)
85
+
86
+
val on_error_msg : ?level:Logs.level -> ?header:string ->
87
+
?tags:Logs.Tag.set -> use:(unit -> 'a Lwt.t) -> ('a, [`Msg of
88
+
string]) result Lwt.t -> 'a Lwt.t
89
+
(** See {!Logs.on_error_msg}. *)
90
+
end
91
+
92
+
val src_log : Logs.src -> (module LOG)
93
+
(** [src_log src] is a {{!LOG}set of logging functions} for [src]. *)
94
+
95
+
(** {1:report_ex Cooperative reporter example}
96
+
97
+
The following reporter will play nice with [Lwt]'s runtime, it
98
+
will behave synchronously for the log functions of this module and
99
+
asynchronously for those of the {!Logs} module (see {!Logs.sync}).
100
+
101
+
It reuses {!Logs_fmt.reporter} and will produce colorful output if
102
+
the standard formatters are setup to do so. For example it can be
103
+
used instead of {!Logs_fmt.reporter} in the {{!Logs_cli.ex}full
104
+
setup example}.
105
+
{[
106
+
let lwt_reporter () =
107
+
let buf_fmt ~like =
108
+
let b = Buffer.create 512 in
109
+
Fmt.with_buffer ~like b,
110
+
fun () -> let m = Buffer.contents b in Buffer.reset b; m
111
+
in
112
+
let app, app_flush = buf_fmt ~like:Fmt.stdout in
113
+
let dst, dst_flush = buf_fmt ~like:Fmt.stderr in
114
+
let reporter = Logs_fmt.reporter ~app ~dst () in
115
+
let report src level ~over k msgf =
116
+
let k () =
117
+
let write () = match level with
118
+
| Logs.App -> Lwt_io.write Lwt_io.stdout (app_flush ())
119
+
| _ -> Lwt_io.write Lwt_io.stderr (dst_flush ())
120
+
in
121
+
let unblock () = over (); Lwt.return_unit in
122
+
Lwt.finalize write unblock |> Lwt.ignore_result;
123
+
k ()
124
+
in
125
+
reporter.Logs.report src level ~over:(fun () -> ()) k msgf;
126
+
in
127
+
{ Logs.report = report }
128
+
]}
129
+
*)
+1
vendor/opam/logs/src/lwt/logs_lwt.mllib
+1
vendor/opam/logs/src/lwt/logs_lwt.mllib
···
1
+
Logs_lwt
+6
vendor/opam/logs/src/threaded/dune
+6
vendor/opam/logs/src/threaded/dune
+9
vendor/opam/logs/src/threaded/logs_threaded.ml
+9
vendor/opam/logs/src/threaded/logs_threaded.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2019 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let enable () =
7
+
let lock = Mutex.create () in
8
+
let lock () = Mutex.lock lock and unlock () = Mutex.unlock lock in
9
+
Logs.set_reporter_mutex ~lock ~unlock
+11
vendor/opam/logs/src/threaded/logs_threaded.mli
+11
vendor/opam/logs/src/threaded/logs_threaded.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2019 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Thread safe logging. *)
7
+
8
+
val enable : unit -> unit
9
+
(** [enable ()] enables thread safe logging for OCaml {!Thread}s by
10
+
installing mutual exclusion primitives via
11
+
{!Logs.set_reporter_mutex}. *)
+1
vendor/opam/logs/src/threaded/logs_threaded.mllib
+1
vendor/opam/logs/src/threaded/logs_threaded.mllib
···
1
+
Logs_threaded
+13
vendor/opam/logs/src/top/dune
+13
vendor/opam/logs/src/top/dune
···
1
+
(library
2
+
(name logs_top)
3
+
(public_name logs.top)
4
+
(modules logs_top)
5
+
(libraries logs compiler-libs.toplevel)
6
+
(optional))
7
+
8
+
(install
9
+
(section lib)
10
+
(package logs)
11
+
(files
12
+
(logs_top_init.ml as top/logs_top_init.ml)
13
+
(logs_top_init.ml as top/logs_top_init_ml)))
+6
vendor/opam/logs/src/top/logs_top.ml
+6
vendor/opam/logs/src/top/logs_top.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let () = ignore (Toploop.use_file Format.err_formatter "logs_top_init.ml")
+1
vendor/opam/logs/src/top/logs_top.mllib
+1
vendor/opam/logs/src/top/logs_top.mllib
···
1
+
Logs_top
+9
vendor/opam/logs/src/top/logs_top_init.ml
+9
vendor/opam/logs/src/top/logs_top_init.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let () =
7
+
Logs.set_level (Some Logs.Debug);
8
+
Logs.set_reporter (Logs.format_reporter ());
9
+
()
+48
vendor/opam/logs/test/test_browser.html
+48
vendor/opam/logs/test/test_browser.html
···
1
+
<!DOCTYPE html>
2
+
<!--
3
+
Copyright (c) 2015 The logs programmers. All rights reserved.
4
+
Distributed under the ISC license, see license at the end of the file.
5
+
-->
6
+
<html lang="en">
7
+
<head>
8
+
<meta charset="utf-8">
9
+
<meta name="viewport" content="width=device-width,
10
+
initial-scale=1.0">
11
+
<script type="text/javascript" defer="defer" src="test_browser.js"></script>
12
+
<style type="text/css">
13
+
h1 { font-size: 2.5rem; font-weight: 300; text-transform: uppercase; }
14
+
body { background-color: black;
15
+
color: #A0A0A0;
16
+
font-size: 1rem;
17
+
line-height: 1.3125rem;
18
+
font-family: monospace;
19
+
font-weight: 300;
20
+
margin: 4em; }
21
+
22
+
div { font-size: 0.8rem; margin-top:1.3125rem; }
23
+
p { margin:0rem; padding:0rem; white-space: pre; }
24
+
</style>
25
+
<title>Logs test</title>
26
+
</head>
27
+
<body>
28
+
<noscript>Sorry, you need to enable JavaScript to see this page.</noscript>
29
+
<h1>Logs test</h1>
30
+
See the browser console.
31
+
</body>
32
+
</html>
33
+
34
+
<!--
35
+
Copyright (c) 2015 The logs programmers
36
+
37
+
Permission to use, copy, modify, and/or distribute this software for any
38
+
purpose with or without fee is hereby granted, provided that the above
39
+
copyright notice and this permission notice appear in all copies.
40
+
41
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
42
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
43
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
44
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
45
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
46
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
47
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
48
+
-->
+21
vendor/opam/logs/test/test_browser.ml
+21
vendor/opam/logs/test/test_browser.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Js_of_ocaml
7
+
8
+
let main _ =
9
+
Logs.set_level @@ Some Logs.Debug;
10
+
Logs.set_reporter @@ Logs_browser.console_reporter ();
11
+
Logs.info (fun m -> m ~header:"START" ?tags:None "Starting main");
12
+
Logs.warn (fun m -> m "Hey be warned by %d." 7);
13
+
Logs.err (fun m -> m "Hey be errored.");
14
+
Logs.debug (fun m -> m "Would you mind to be debugged a bit ?");
15
+
Logs.app (fun m -> m "This is for the application console or stdout.");
16
+
Logs.app (fun m -> m ~header:"HEAD" "Idem but with a header");
17
+
Logs.err (fun m -> m "NO CARRIER");
18
+
Logs.info (fun m -> m "Ending main");
19
+
Js._false
20
+
21
+
let () = Js.Unsafe.set Dom_html.window "onload" (Dom_html.handler main)
+25
vendor/opam/logs/test/test_count.ml
+25
vendor/opam/logs/test/test_count.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open B0_testing
7
+
8
+
let test_count =
9
+
Test.test "Logs.{err,warn}_count" @@ fun () ->
10
+
let logit () =
11
+
Logs.warn (fun m -> m "Hey");
12
+
Logs.err (fun m -> m "Ho");
13
+
Logs.warn (fun m -> m "Let's go");
14
+
in
15
+
logit ();
16
+
Test.int (Logs.err_count ()) 1 ~__POS__;
17
+
Test.int (Logs.warn_count ()) 2 ~__POS__;
18
+
Logs.set_level None;
19
+
logit ();
20
+
Test.int (Logs.err_count ()) 2 ~__POS__;
21
+
Test.int (Logs.warn_count ()) 4 ~__POS__;
22
+
()
23
+
24
+
let main () = Test.main @@ fun () -> Test.autorun ()
25
+
let () = if !Sys.interactive then () else exit (main ())
+36
vendor/opam/logs/test/test_fmt.ml
+36
vendor/opam/logs/test/test_fmt.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let pp_key = Format.pp_print_string
7
+
let pp_val = Format.pp_print_string
8
+
9
+
10
+
let err_invalid_kv args =
11
+
Logs.err @@ fun m ->
12
+
args (fun k v -> m "invalid kv (%a,%a)" pp_key k pp_val v)
13
+
14
+
let err_no_carrier args =
15
+
Logs.err @@ fun m -> args (m "NO CARRIER")
16
+
17
+
let main () =
18
+
Fmt_tty.setup_std_outputs ();
19
+
Logs.set_level @@ Some Logs.Debug;
20
+
Logs.set_reporter @@ Logs_fmt.reporter ();
21
+
Logs.info (fun m -> m ~header:"START" ?tags:None "Starting main");
22
+
Logs.warn (fun m -> m "Hey be warned by %d." 7);
23
+
Logs.err (fun m -> m "Hey be errored.");
24
+
Logs.debug (fun m -> m "Would you mind to be debugged a bit ?");
25
+
Logs.app (fun m -> m "This is for the application console or stdout.");
26
+
Logs.app (fun m -> m ~header:"HEAD" "Idem but with a header");
27
+
let k = "key" in
28
+
let v = "value" in
29
+
Logs.err (fun m -> m "invalid kv (%a,%a)" pp_key k pp_val v);
30
+
Logs.err (fun m -> m "NO CARRIER");
31
+
err_invalid_kv (fun args -> args k v);
32
+
err_no_carrier (fun () -> ());
33
+
Logs.info (fun m -> m "Ending main");
34
+
exit (if (Logs.err_count () > 0) then 1 else 0)
35
+
36
+
let () = main ()
+33
vendor/opam/logs/test/test_formatter.ml
+33
vendor/opam/logs/test/test_formatter.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2016 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let pp_key = Format.pp_print_string
7
+
let pp_val = Format.pp_print_string
8
+
9
+
let err_invalid_kv args =
10
+
Logs.err @@ fun m ->
11
+
args (fun k v -> m "invalid kv (%a,%a)" pp_key k pp_val v)
12
+
13
+
let err_no_carrier args =
14
+
Logs.err @@ fun m -> args (m "NO CARRIER")
15
+
16
+
let main () =
17
+
Logs.set_level @@ Some Logs.Debug;
18
+
Logs.set_reporter @@ Logs.format_reporter ();
19
+
Logs.info (fun m -> m ~header:"START" ?tags:None "Starting main");
20
+
Logs.warn (fun m -> m "Hey be warned by %d." 7);
21
+
Logs.err (fun m -> m "Hey be errored.");
22
+
Logs.debug (fun m -> m "Would you mind to be debugged a bit ?");
23
+
Logs.app (fun m -> m "This is for the application console or stdout.");
24
+
let k = "key" in
25
+
let v = "value" in
26
+
Logs.err (fun m -> m "invalid kv (%a,%a)" pp_key k pp_val v);
27
+
Logs.err (fun m -> m "NO CARRIER");
28
+
err_invalid_kv (fun args -> args k v);
29
+
err_no_carrier (fun () -> ());
30
+
Logs.info (fun m -> m "Ending main");
31
+
if (Logs.err_count () > 0) then 1 else 0
32
+
33
+
let () = if !Sys.interactive then () else exit (main ())
+62
vendor/opam/logs/test/test_lwt.ml
+62
vendor/opam/logs/test/test_lwt.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open B0_testing
7
+
8
+
let ( >>= ) = Lwt.bind
9
+
10
+
let lwt_reporter () =
11
+
let buf_fmt ~like =
12
+
let b = Buffer.create 512 in
13
+
Fmt.with_buffer ~like b,
14
+
fun () -> let m = Buffer.contents b in Buffer.reset b; m
15
+
in
16
+
let app, app_flush = buf_fmt ~like:Fmt.stdout in
17
+
let dst, dst_flush = buf_fmt ~like:Fmt.stderr in
18
+
let reporter = Logs_fmt.reporter ~app ~dst () in
19
+
let report src level ~over k msgf =
20
+
let k () =
21
+
let write () = match level with
22
+
| Logs.App -> Lwt_io.write Lwt_io.stdout (app_flush ())
23
+
| _ -> Lwt_io.write Lwt_io.stderr (dst_flush ())
24
+
in
25
+
let unblock () = over (); Lwt.return_unit in
26
+
Lwt.finalize write unblock |> Lwt.ignore_result;
27
+
k ()
28
+
in
29
+
reporter.Logs.report src level ~over:(fun () -> ()) k msgf;
30
+
in
31
+
{ Logs.report = report }
32
+
33
+
let test_count () =
34
+
let logit () =
35
+
Logs_lwt.warn (fun m -> m "Hey") >>= fun () ->
36
+
Logs_lwt.err (fun m -> m "Ho") >>= fun () ->
37
+
Logs_lwt.warn (fun m -> m "Let's go")
38
+
in
39
+
Test.int (Logs.err_count ()) 1 ~__POS__;
40
+
Test.int (Logs.warn_count ()) 1 ~__POS__;
41
+
Logs.set_level None;
42
+
logit () >>= fun () ->
43
+
Test.int (Logs.err_count ()) 2 ~__POS__;
44
+
Test.int (Logs.warn_count ()) 3 ~__POS__;
45
+
Lwt.return_unit
46
+
47
+
let main () =
48
+
Test.main @@ fun () ->
49
+
Fmt_tty.setup_std_outputs ();
50
+
Logs.set_reporter @@ lwt_reporter ();
51
+
Lwt_main.run @@ begin
52
+
Logs.set_level (Some Logs.Debug);
53
+
Logs_lwt.info (fun m -> m ~header:"START" ?tags:None "Starting main")
54
+
>>= fun () -> Logs_lwt.warn (fun m -> m "Hey be warned by %d." 7)
55
+
>>= fun () -> Logs_lwt.err (fun m -> m "Hey be errored.")
56
+
>>= fun () -> Logs_lwt.debug (fun m -> m "Be debugged a bit ?")
57
+
>>= fun () -> Logs_lwt.app (fun m -> m "Application console or stdout.")
58
+
>>= fun () -> Logs_lwt.info (fun m -> m "Ending main")
59
+
>>= fun () -> test_count ()
60
+
end
61
+
62
+
let () = if !Sys.interactive then () else exit (main ())
+18
vendor/opam/logs/test/test_multi.ml
+18
vendor/opam/logs/test/test_multi.ml
···
1
+
(* This code is in the public domain. *)
2
+
3
+
(* Example for installing multiple reporters. *)
4
+
5
+
let combine r1 r2 =
6
+
let report = fun src level ~over k msgf ->
7
+
let v = r1.Logs.report src level ~over:(fun () -> ()) k msgf in
8
+
r2.Logs.report src level ~over (fun () -> v) msgf
9
+
in
10
+
{ Logs.report }
11
+
12
+
let () =
13
+
let r1 = Logs.format_reporter () in
14
+
let r2 = Logs_fmt.reporter () in
15
+
Fmt_tty.setup_std_outputs ();
16
+
Logs.set_reporter (combine r1 r2);
17
+
Logs.err (fun m -> m "HEY HO!");
18
+
()
+23
vendor/opam/logs/test/test_mutex_safe.ml
+23
vendor/opam/logs/test/test_mutex_safe.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 The logs programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* See https://github.com/dbuenzli/logs/issues/57 *)
7
+
8
+
let src = Logs.Src.create "repro case"
9
+
module Log = (val Logs.src_log src)
10
+
11
+
let setup_logs () =
12
+
Logs.set_reporter (Logs_fmt.reporter ());
13
+
Logs.set_level ~all:true (Some Logs.Debug);
14
+
Logs_threaded.enable ();
15
+
()
16
+
17
+
let main () =
18
+
setup_logs ();
19
+
(try Logs.app (fun _m -> failwith "uh oh...") with Failure _ -> ());
20
+
Logs.app (fun m -> m "It works!");
21
+
0
22
+
23
+
let () = if !Sys.interactive then () else exit (main ())
+14
vendor/opam/logs/test/test_threaded.ml
+14
vendor/opam/logs/test/test_threaded.ml
···
1
+
let loop s =
2
+
for _ = 0 to 10 do
3
+
Logs.info (fun f -> f "%s.%s" s s)
4
+
done
5
+
6
+
let () =
7
+
Logs_threaded.enable ();
8
+
Logs.set_level (Some Logs.Debug);
9
+
Logs.set_reporter (Logs_fmt.reporter ());
10
+
let t1 = Thread.create loop "aaaa" in
11
+
let t2 = Thread.create loop "bbbb" in
12
+
loop "cccc";
13
+
Thread.join t1;
14
+
Thread.join t2
+7
vendor/opam/logs/test/tests.itarget
+7
vendor/opam/logs/test/tests.itarget
+37
vendor/opam/logs/test/tool.ml
+37
vendor/opam/logs/test/tool.ml
···
1
+
(* This code is in the public domain. *)
2
+
3
+
(* Example setup for a simple command line tool with colorful output. *)
4
+
5
+
let hello msg =
6
+
Logs.app (fun m -> m "%s" msg);
7
+
Logs.info (fun m -> m "End-user information.");
8
+
Logs.debug (fun m -> m "Developer information.");
9
+
Logs.err (fun m -> m "Something bad happened.");
10
+
Logs.warn (fun m -> m "Something bad may happen in the future.");
11
+
if Logs.err_count () > 0 then 1 else 0
12
+
13
+
let setup_log ~style_renderer ~level =
14
+
Fmt_tty.setup_std_outputs ?style_renderer ();
15
+
Logs.set_level level;
16
+
Logs.set_reporter (Logs_fmt.reporter ())
17
+
18
+
(* Command line interface *)
19
+
20
+
open Cmdliner
21
+
open Cmdliner.Term.Syntax
22
+
23
+
let cmd =
24
+
Cmd.make (Cmd.info "tool") @@
25
+
let env = Cmd.Env.info "TOOL_VERBOSITY" in
26
+
let+ style_renderer = Fmt_cli.style_renderer ()
27
+
and+ level = Logs_cli.level ~env ()
28
+
and+ msg =
29
+
let doc = "The message to output." in
30
+
Arg.(value & pos 0 string "Hello horrible world!" & info [] ~doc)
31
+
in
32
+
setup_log ~style_renderer ~level;
33
+
hello msg
34
+
35
+
36
+
let main () = Cmd.eval' cmd
37
+
let () = if !Sys.interactive then () else exit (main ())