Merge pull request #25 from hannesm/main

Avoid a global buffer, reuse Logs_fmt.pp_header for color support on some terminals (i.e. when executing a unix application)

mirage-logs.opam

@@ -8,12 +8,13 @@ bug-reports: "https://github.com/mirage/mirage-logs/issues"
 doc: "https://mirage.github.io/mirage-logs/"
 tags: ["org:mirage"]
 depends: [
-  "ocaml" { >= "4.06.0"}
+  "ocaml" { >= "4.08.0" }
   "dune" {>= "3.0"}
   "logs" { >= "0.5.0" }
+  "fmt" { >= "0.9.0" }
   "ptime" { >= "0.8.1" }
-  "mirage-clock" { >= "3.0.0"}
-  "cmdliner" {>= "1.1.0"}
+  "mirage-clock" { >= "3.0.0" }
+  "cmdliner" { >= "1.1.0" }
   "lwt" {with-test}
   "alcotest" {with-test}
 ]

src/dune

@@ -2,7 +2,7 @@
  (name mirage_logs)
  (public_name mirage-logs)
  (modules mirage_logs)
- (libraries logs mirage-clock ptime))
+ (libraries logs mirage-clock ptime logs.fmt fmt))
 
 (library
  (name mirage_logs_cli)

src/mirage_logs.ml

@@ -1,9 +1,6 @@
 (* Copyright (C) 2016, Thomas Leonard <thomas.leonard@unikernel.com>
    See the README file for details. *)
 
-let buf = Buffer.create 200
-let log_fmt = Format.formatter_of_buffer buf
-
 module Make (C : Mirage_clock.PCLOCK) = struct
   let pp_tags f tags =
     let pp tag () =
@@ -17,26 +14,18 @@ module Make (C : Mirage_clock.PCLOCK) = struct
     let report src level ~over k msgf =
       let tz_offset_s = C.current_tz_offset_s () in
       let posix_time = Ptime.v @@ C.now_d_ps () in
-      msgf @@ fun ?header ?(tags = Logs.Tag.empty) fmt ->
+      let src = Logs.Src.name src in
+      msgf @@ fun ?header ?tags fmt ->
       let k _ =
-        if not (Logs.Tag.is_empty tags) then
-          Format.fprintf log_fmt ":%a" pp_tags tags;
-        Format.pp_print_flush log_fmt ();
-        let msg = Buffer.contents buf in
-        Buffer.clear buf;
-        Format.fprintf ch "%a: %s\n%!"
-          (Ptime.pp_rfc3339 ?tz_offset_s ())
-          posix_time msg;
         over ();
         k ()
       in
-      let src = Logs.Src.name src in
-      match header with
-      | None ->
-          Format.kfprintf k log_fmt ("%a [%s] " ^^ fmt) Logs.pp_level level src
-      | Some h ->
-          Format.kfprintf k log_fmt ("%a [%s:%s] " ^^ fmt) Logs.pp_level level
-            src h
+      Format.kfprintf k ch
+        ("%a:%a %a [%s] @[" ^^ fmt ^^ "@]@.")
+        (Ptime.pp_rfc3339 ?tz_offset_s ())
+        posix_time
+        Fmt.(option ~none:(any "") pp_tags)
+        tags Logs_fmt.pp_header (level, header) src
     in
     { Logs.report }
 end

test/test.ml

@@ -37,13 +37,13 @@ let with_pipe fn =
 let test_console r =
   Log.info (fun f -> f "Simple test");
   Alcotest.(check string)
-    "Simple" "1970-01-01T00:00:00Z: INFO [test] Simple test" (input_line r);
+    "Simple" "1970-01-01T00:00:00Z: [INFO] [test] Simple test" (input_line r);
   Log.warn (fun f ->
       f ~tags:(tags ~src:"localhost" ~port:7000) "Packet rejected");
   Alcotest.(check string)
     "Tags"
-    "1970-01-01T00:00:00Z: WARNING [test] Packet rejected: src=localhost \
-     port=7000"
+    "1970-01-01T00:00:00Z: src=localhost port=7000 [WARNING] [test] Packet \
+     rejected"
     (input_line r);
   Log.debug (fun f -> f "Not shown")