simon/sidekick
1
0
Fork 0
mirror of https://github.com/c-cube/sidekick.git synced 2025-12-06 03:05:31 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

feat(util): improve debug printer wrt newlines

Browse source
This commit is contained in:
Simon Cruanes 2022-11-01 22:20:56 -04:00
parent b68ce33b86
commit 5a7ca4ca2e
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
3 changed files with 17 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
src/util/Log.ml
View file

@ -15,13 +15,16 @@ let start_ = Unix.gettimeofday ()
let[@inline never] debug_real_ l k =
k (fun fmt ->
let now = Unix.gettimeofday () -. start_ in
(* print into buf_ in one go, so that outputs of nested debug calls
do not interleave on stdout *)
Buffer.clear buf_;
let once_done _fmt =
Format.fprintf _fmt "@]@?";
let msg = Buffer.contents buf_ in
(* forward to profiling *)
if Profile.enabled () then Profile.instant msg;
Format.fprintf !debug_fmt_ "@[<2>@{<Blue>[%d|%.3f]@}@ %s@]@." l now msg
Format.fprintf !debug_fmt_ "@[<2>@{<Blue>[%d|%.3f]@}@ %a@]@." l now
Util.pp_string_with_lines msg
in
Format.fprintf buf_fmt_ "@[<2>";

12
src/util/Util.ml
View file

@ -10,6 +10,18 @@ let pp_sep sep out () = Format.fprintf out "%s@," sep
let pp_list ?(sep = " ") pp out l = Fmt.list ~sep:(pp_sep sep) pp out l
let pp_iter ?(sep = " ") pp out l = Fmt.iter ~sep:(pp_sep sep) pp out l
let pp_string_with_lines out (s : string) : unit =
Fmt.fprintf out "@[<v>";
let i = ref 0 in
let n = String.length s in
while !i < n do
let j = try String.index_from s !i '\n' with Not_found -> n in
if !i > 0 then Fmt.fprintf out "@,";
Fmt.substring out (s, !i, j - !i);
i := j + 1
done;
Fmt.fprintf out "@]"
let pp_pair ?(sep = " ") pp1 pp2 out t =
Fmt.pair ~sep:(pp_sep sep) pp1 pp2 out t

1
src/util/Util.mli
View file

@ -8,6 +8,7 @@ val pp_list : ?sep:string -> 'a printer -> 'a list printer
val pp_iter : ?sep:string -> 'a printer -> 'a Iter.t printer
val pp_array : ?sep:string -> 'a printer -> 'a array printer
val pp_pair : ?sep:string -> 'a printer -> 'b printer -> ('a * 'b) printer
val pp_string_with_lines : string printer
val flat_map_l_arr : ('a -> 'b array) -> 'a list -> 'b list
val array_of_list_map : ('a -> 'b) -> 'a list -> 'b array