[log] Better print code.

src/logging.ml

@@ -50,35 +50,34 @@ let is_tag_enabled tag =
 let is_debug_level () =
   match Logs.level () with Some Debug -> true | _ -> false
 
+let style_of_level = function
+  | Logs.App -> Logs_fmt.app_style
+  | Logs.Error -> Logs_fmt.err_style
+  | Logs.Warning -> Logs_fmt.warn_style
+  | Logs.Info -> Logs_fmt.info_style
+  | Logs.Debug -> Logs_fmt.debug_style
+
 let pp_header ~pp_h ppf (l, h) =
+  let style = style_of_level l in
   match l with
-  | Logs.App -> (
-    match h with None -> () | h -> pp_h ppf Logs_fmt.app_style "" h)
-  | Logs.Error -> pp_h ppf Logs_fmt.err_style "ERROR" h
-  | Logs.Warning -> pp_h ppf Logs_fmt.warn_style "WARNING" h
-  | Logs.Info -> pp_h ppf Logs_fmt.info_style "INFO" h
-  | Logs.Debug -> pp_h ppf Logs_fmt.debug_style "DEBUG" h
+  | Logs.App -> ( match h with None -> () | Some h -> pp_h ppf style h)
+  | Logs.Error ->
+    pp_h ppf style Fmt.(str "ERROR%a" (option (any ":" ++ string)) h)
+  | Logs.Warning ->
+    pp_h ppf style Fmt.(str "WARNING%a" (option (any ":" ++ string)) h)
+  | Logs.Info ->
+    pp_h ppf style Fmt.(str "INFO%a" (option (any ":" ++ string)) h)
+  | Logs.Debug ->
+    pp_h ppf style Fmt.(str "DEBUG%a" (option (any ":" ++ string)) h)
 
 let pp_header ~space =
-  let pp_h ppf style default h =
-    Fmt.pf ppf "[%a%a]%s"
-      Fmt.(styled style string)
-      default
-      Fmt.(styled style (option (any ":" ++ string)))
-      h
-      (if space then " " else "")
+  let pp_h ppf style h =
+    Fmt.pf ppf "[%a]%s" Fmt.(styled style string) h (if space then " " else "")
   in
   pp_header ~pp_h
 
 let pp_header_tag ppf (l, t) =
-  let style =
-    match l with
-    | Logs.App -> Logs_fmt.app_style
-    | Logs.Error -> Logs_fmt.err_style
-    | Logs.Warning -> Logs_fmt.warn_style
-    | Logs.Info -> Logs_fmt.info_style
-    | Logs.Debug -> Logs_fmt.debug_style
-  in
+  let style = style_of_level l in
   Fmt.pf ppf "{%a}" Fmt.(styled style string) t
 
 let tag_defs_available = List.map tag_def_of_tag (tags_available ())