(P : LOGGER_CONFIGURATION) :
LOGGER with type ('a, 'b) result = ('a, 'b) P.result = struct
include Metadoc
type ('a, 'b) result = ('a, 'b) P.result
let print log_kind t =
let convert_to_string formatted =
SmartPrint.to_string P.line_width P.indent formatted in
let display formatted = convert_to_string formatted |> P.print_string in
let using_colors = P.with_color () in
let no_color t = t in
let normal_color = if using_colors then bold_green else no_color in
let error_color = if using_colors then bold_red else no_color in
let warning_color = if using_colors then bold_yellow else no_color in
let debug_color = if using_colors then greyish else no_color in
let format_log ?(color_h=no_color) ?(color_t=no_color) head t =
let colorless = head % t in
let has_newline =
String.find_index (convert_to_string colorless) ~char:'\n' <> None in
display (
color_h (brakets head)
% string " "
% (if has_newline
then color_t (n % indent t)
else color_t t)
% newline
) in
match log_kind with
| `Normal ->
format_log ~color_h:normal_color (string P.name) t
| `Error ->
format_log ~color_h:error_color (s P.name % s ": ERROR") t
| `Warning ->
format_log ~color_h:warning_color (s P.name % s ": Warning") t
| `Debug level when P.debug_level () >= level ->
format_log ~color_h:debug_color (s P.name %s ": debug")
~color_t:debug_color t
| `Debug _ -> P.do_nothing ()
let (@) t kind = print kind t
let normal = `Normal
let error = `Error
let warning = `Warning
let verbose = `Debug 1
let very_verbose = `Debug 2
end