toplevel emits round trip pprint of ast to console.
This commit is contained in:
56
log_js.ml
Normal file
56
log_js.ml
Normal file
@ -0,0 +1,56 @@
|
||||
module Logs_reporter = struct
|
||||
(* Console reporter *)
|
||||
|
||||
open Jsoo_runtime
|
||||
|
||||
let console : Logs.level -> string -> unit =
|
||||
fun level s ->
|
||||
let meth =
|
||||
match level with
|
||||
| Logs.Error -> "error"
|
||||
| Logs.Warning -> "warn"
|
||||
| Logs.Info -> "info"
|
||||
| Logs.Debug -> "debug"
|
||||
| Logs.App -> "log"
|
||||
in
|
||||
ignore
|
||||
(Js.meth_call
|
||||
(Js.pure_js_expr "console")
|
||||
meth
|
||||
[| Js.string s |])
|
||||
|
||||
let ppf, flush =
|
||||
let b = Buffer.create 255 in
|
||||
let flush () =
|
||||
let s = Buffer.contents b in
|
||||
Buffer.clear b;
|
||||
s
|
||||
in
|
||||
(Format.formatter_of_buffer b, flush)
|
||||
|
||||
let hook =
|
||||
ref (fun level s ->
|
||||
ignore (Logs.level_to_string (Some level) ^ ": " ^ s))
|
||||
|
||||
let console_report _src level ~over k msgf =
|
||||
let k _ =
|
||||
let s = flush () in
|
||||
console level s;
|
||||
!hook level s;
|
||||
over ();
|
||||
k ()
|
||||
in
|
||||
msgf @@ fun ?header ?tags fmt ->
|
||||
let _tags = tags in
|
||||
match header with
|
||||
| None -> Format.kfprintf k ppf ("@[" ^^ fmt ^^ "@]@.")
|
||||
| Some h -> Format.kfprintf k ppf ("[%s] @[" ^^ fmt ^^ "@]@.") h
|
||||
|
||||
let console_reporter () = { Logs.report = console_report }
|
||||
end
|
||||
|
||||
let _ =
|
||||
Logs.set_reporter (Logs_reporter.console_reporter ());
|
||||
Logs.set_level (Some Debug)
|
||||
|
||||
module Log = Logs
|
||||
Reference in New Issue
Block a user