From 877a0da1b8fd2dbdba1b21ec09b5da4f6c7cd4d4 Mon Sep 17 00:00:00 2001
From: Michele Alberti <michele.alberti@cea.fr>
Date: Wed, 7 Jun 2023 14:36:40 +0200
Subject: [PATCH] [log] Better print code.
---
src/logging.ml | 41 ++++++++++++++++++++---------------------
1 file changed, 20 insertions(+), 21 deletions(-)
diff --git a/src/logging.ml b/src/logging.ml
index c665e86..3a258a2 100644
--- a/src/logging.ml
+++ b/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 ())
--
GitLab