add complete app example of lwt_reporter with library

Author: rbjorklin

examples/lwt_reporter/dune-project

@@ -0,0 +1,23 @@
+(lang dune 3.3)
+
+(name lwt_reporter_example)
+
+(generate_opam_files true)
+
+(license ISC)
+
+(package
+ (name lwt_reporter_example)
+ (synopsis "example")
+ (depends
+  (cmdliner
+   (= 1.1.1))
+  (conf-libev
+   (>= 4-12))
+  (dune
+   (>= 3.4.1))
+  (logs
+   (= 0.7.0))
+  (lwt
+   (>= 5.6.1))
+   ))

examples/lwt_reporter/lwt_reporter_example.opam

@@ -0,0 +1,26 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "example"
+license: "ISC"
+depends: [
+  "cmdliner" {= "1.1.1"}
+  "conf-libev" {>= "4-12"}
+  "dune" {>= "3.3" & >= "3.4.1"}
+  "logs" {= "0.7.0"}
+  "lwt" {>= "5.6.1"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]

examples/lwt_reporter/src/bin/dune

@@ -0,0 +1,16 @@
+(executables
+  (package lwt_reporter_example)
+  (names main)
+  (public_names main)
+  (libraries
+    lwt_reporter_example
+    cmdliner
+    fmt
+    fmt.cli
+    fmt.tty
+    logs
+    logs.cli
+    logs.fmt
+    logs.lwt
+    lwt.unix
+    lwt))

examples/lwt_reporter/src/bin/main.ml

@@ -0,0 +1,88 @@
+[@@@ocaml.warning "-unused-var-strict"]
+[@@@ocaml.warning "-unused-field"]
+
+open Cmdliner
+
+(* https://erratique.ch/software/logs/doc/Logs_lwt/index.html#report_ex *)
+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 report (src : Logs.Src.t) 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 () (* this is 'k' from 'report' not 'k ()' *)
+    in
+    (* Adapted from https://erratique.ch/software/logs/doc/Logs/index.html#ex1 *)
+    let with_source h k ppf fmt =
+      Format.kfprintf k ppf
+        ("%a [%s] @[" ^^ fmt ^^ "@]@.")
+        Logs_fmt.pp_header (level, h) (Logs.Src.name src)
+    in
+    match level with
+    | Logs.App -> msgf @@ fun ?header ?tags fmt -> with_source header k app fmt
+    | _ -> msgf @@ fun ?header ?tags fmt -> with_source header k dst fmt
+  in
+  { Logs.report }
+
+(* Inspired by
+   https://github.com/mjambon/cmdliner-cheatsheet/blob/main/src/Demo_arg_main.ml *)
+
+type conf = {
+  name : string;
+  log : unit;
+}
+
+let name_term =
+  let default = "John Doe" in
+  let info =
+    Arg.info
+      [ "N"; "name" ] (* '-N' and '--name' will be synonyms *)
+      ~docv:"NAME" ~doc:"User to use when connecting"
+  in
+  Arg.value (Arg.opt Arg.string default info)
+
+let setup_log style_renderer level =
+  Fmt_tty.setup_std_outputs ?style_renderer ();
+  Logs.set_level level;
+  Logs.set_reporter (lwt_reporter ());
+  ()
+
+let setup_log_term =
+  Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ())
+
+let conf_term run =
+  let combine name log =
+    let conf = { name; log } in
+    run conf
+  in
+  Term.(const combine $ name_term $ setup_log_term)
+
+let parse_command_line_and_run run =
+  let info =
+    Cmd.info "lwt-reporter-example"
+    (* program name as it will appear in --help *)
+  in
+  Cmd.v info (conf_term run) |> Cmd.eval |> Stdlib.exit
+
+let main conf =
+  Logs.info (fun m -> m "My name is: %s" conf.name);
+  Lwt_reporter_example.A_module.log_name conf.name
+
+let () = parse_command_line_and_run main

examples/lwt_reporter/src/lib/a_module.ml

@@ -0,0 +1,5 @@
+let src = Logs.Src.create "a_module" ~doc:"logs from a_module"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let log_name name = Log.warn (fun m -> m "My name is: %s" name)

examples/lwt_reporter/src/lib/dune

@@ -0,0 +1,5 @@
+(library
+ (name lwt_reporter_example)
+ (public_name lwt_reporter_example)
+  (libraries
+    logs))