test_lwt.ml

(*---------------------------------------------------------------------------
   Copyright (c) 2015 The logs programmers. All rights reserved.
   SPDX-License-Identifier: ISC
  ---------------------------------------------------------------------------*)

open B0_testing

let ( >>= ) = Lwt.bind

let lwt_reporter () =
  let buf_fmt ~like =
    let b = Buffer.create 512 in
    Fmt.with_buffer ~like b,
    fun () -> let m = Buffer.contents b in Buffer.reset b; m
  in
  let app, app_flush = buf_fmt ~like:Fmt.stdout in
  let dst, dst_flush = buf_fmt ~like:Fmt.stderr in
  let reporter = Logs_fmt.reporter ~app ~dst () in
  let report src level ~over k msgf =
    let k () =
      let write () = match level with
      | Logs.App -> Lwt_io.write Lwt_io.stdout (app_flush ())
      | _ -> Lwt_io.write Lwt_io.stderr (dst_flush ())
      in
      let unblock () = over (); Lwt.return_unit in
      Lwt.finalize write unblock |> Lwt.ignore_result;
      k ()
    in
    reporter.Logs.report src level ~over:(fun () -> ()) k msgf;
  in
  { Logs.report = report }

let test_count () =
  let logit () =
    Logs_lwt.warn (fun m -> m "Hey") >>= fun () ->
    Logs_lwt.err (fun m -> m "Ho") >>= fun () ->
    Logs_lwt.warn (fun m -> m "Let's go")
  in
  Test.int (Logs.err_count ()) 1 ~__POS__;
  Test.int (Logs.warn_count ()) 1 ~__POS__;
  Logs.set_level None;
  logit () >>= fun () ->
  Test.int (Logs.err_count ()) 2 ~__POS__;
  Test.int (Logs.warn_count ()) 3 ~__POS__;
  Lwt.return_unit

let main () =
  Test.main @@ fun () ->
  Fmt_tty.setup_std_outputs ();
  Logs.set_reporter @@ lwt_reporter ();
  Lwt_main.run @@ begin
  Logs.set_level (Some Logs.Debug);
  Logs_lwt.info (fun m -> m ~header:"START" ?tags:None "Starting main")
  >>= fun () -> Logs_lwt.warn (fun m -> m "Hey be warned by %d." 7)
  >>= fun () -> Logs_lwt.err (fun m -> m "Hey be errored.")
  >>= fun () -> Logs_lwt.debug (fun m -> m "Be debugged a bit ?")
  >>= fun () -> Logs_lwt.app (fun m -> m "Application console or stdout.")
  >>= fun () -> Logs_lwt.info (fun m -> m "Ending main")
  >>= fun () -> test_count ()
end

let () = if !Sys.interactive then () else exit (main ())