Custom Logs.reporter with Lwt

Learning
,
1

I needed to write a custom reporter that will output my logs in a file like Lwt_log.file.

Here is what I have so far:

open Lwt.Infix
open Logs

let lwt_file_reporter () =
  let open Logs in
  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 () =
        Lwt_io.open_file ~flags:[Unix.O_WRONLY; Unix.O_CREAT; Unix.O_APPEND] ~perm:0o777 ~mode:Lwt_io.Output "my_file.log"
        >>= fun fd -> (
          match level with
          | Logs.App -> Lwt_io.write fd (app_flush ())
          | _ -> Lwt_io.write fd (dst_flush ())
        )
          >>= fun () ->
            Lwt_io.close fd
      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 setup () =
  Logs.set_reporter (lwt_file_reporter ());
  Logs.set_level (Some Debug);
  Lwt.return_unit

let log message i =
  Logs.app (fun m -> m "thread %d %s" i message);
  Lwt.return_unit

let threads = [
    setup ();
  (Lwt_unix.sleep 1.0
      >>= fun () ->
        log "hop a" 1
		    >>= fun () ->
		      Lwt_unix.sleep 2.0
		      >>= fun () ->
            log "hop b" 1
        );

   (Lwt_unix.sleep 2.0
		  >>= fun () ->
        log "pop a" 2
        >>= fun () ->
		      Lwt_unix.sleep 3.0
		      >>= fun () ->
            log "pop b" 2
   );
		]

let () =
  Lwt_main.run(Lwt.join threads)

when I compile and run with

~> ocamlfind ocamlc -o custom_lwt_file_reporter -package fmt,logs,lwt,lwt.unix,logs.fmt -linkpkg -g custom_lwt_file_reporter.ml 

~>  ./custom_lwt_file_reporter

I have the following output:

~> cat my_file.log 
thread 1 hop a
thread 2 pop a
thread 1 hop b

It seems that the last log is not printed. I am not sure where lies the problem, is it my reporter or the way I use the threads.

2

The issue at hand is that Lwt.join finishes before the reporter had a chance to emit the log message Logs.app is fire-and-forget, please have a look at the documentation (http://erratique.ch/software/logs/doc/Logs.html#sync).

AFAICT there are two solutions, either use Logs_lwt:

let log message i =
  Logs_lwt.app (fun m -> m "thread %d %s" i message)

(and then add logs.lwt to your call to ocamlfind).

Or, add an arbitrary amount of idling before exiting:

let () =
  Lwt_main.run(Lwt.join threads >>= fun () -> Lwt_unix.sleep 1.0)
2 Likes