diff --git a/src/logging.ml b/src/logging.ml index 8767bc0a3686595637600e0834b99793984255a4..ebe3f2dd672423f106bdba3c88cfddae78025f21 100644 --- a/src/logging.ml +++ b/src/logging.ml @@ -55,12 +55,12 @@ let pp_header = let specification_enabled = ref false -let setup_log level category = +let setup_log level categories = Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty (); Logs.set_level level; let () = - match category with - | Some Category.Specification -> specification_enabled := true + match categories with + | Some [ Category.Specification ] -> specification_enabled := true | _ -> () in Logs.set_reporter (Logs_fmt.reporter ~pp_header ()) diff --git a/src/logging.mli b/src/logging.mli index 208bf4d6f9f37b30a8a3cd95d60283c5a0c946a6..04be9381f876e9e472d97626629fecf117a292c1 100644 --- a/src/logging.mli +++ b/src/logging.mli @@ -30,4 +30,4 @@ end val specification_enabled : bool ref val spec_tag : unit -> Logs.Tag.set -val setup_log : Logs.level option -> Category.t option -> unit +val setup_log : Logs.level option -> Category.t list option -> unit diff --git a/src/main.ml b/src/main.ml index e523d83b7c65eaa73f53f2978bf79a12f88d1f5b..e82a636db6edfdbd1f8d720542d904d55a77a002 100644 --- a/src/main.ml +++ b/src/main.ml @@ -36,24 +36,24 @@ let () = (* -- Logs. *) -let log_category = +let log_categories = let all_categories = Logging.Category.list_available () in let doc = Fmt.str "Logging categories. Available are $(docv)s: %a." (Fmt.list ~sep:Fmt.comma Fmt.string) (List.map ~f:Logging.Category.to_string all_categories) in - let log_categories = + let enum_log_categories = Arg.enum (List.map ~f:(fun c -> (Logging.Category.to_string c, c)) all_categories) in Arg.( value - & opt (some log_categories) None + & opt (some (list enum_log_categories)) None & info [ "c"; "log-category" ] ~doc ~docv:"LOGTAG") let setup_logs = - Term.(const Logging.setup_log $ Logs_cli.level () $ log_category) + Term.(const Logging.setup_log $ Logs_cli.level () $ log_categories) let log_level_is_debug () = match Logs.level () with Some Debug -> true | _ -> false