diff --git a/CHANGELOG.md b/CHANGELOG.md index 5eda7b4..69973c6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +## [1.6.0] -- current + +### Added + +- Runtime `description`: where the logs are directed to. + +### Changed + +- Runtime builders take a `description` optional argument. + ## [1.5.1] -- 2024-07-07 ### Changed diff --git a/minidebug_runtime.ml b/minidebug_runtime.ml index 82c410d..b5aeca4 100644 --- a/minidebug_runtime.ml +++ b/minidebug_runtime.ml @@ -75,6 +75,7 @@ module type Shared_config = sig val global_prefix : string val split_files_after : int option val toc_entry : toc_entry_criteria + val description : string end let elapsed_default = Not_reported @@ -163,6 +164,7 @@ let shared_config ?(time_tagged = Not_tagged) ?(elapsed_times = elapsed_default) let global_prefix = if global_prefix = "" then "" else global_prefix ^ " " let split_files_after = split_files_after let toc_entry = toc_entry + let description = filename ^ (if global_prefix = "" then "" else ":") ^ global_prefix end in (module Result) @@ -201,6 +203,7 @@ module type Debug_runtime = sig val max_num_children : int option ref val global_prefix : string val snapshot : unit -> unit + val description : string end let exceeds ~value ~limit = match limit with None -> false | Some limit -> limit < value @@ -402,6 +405,7 @@ module Flushing (Log_to : Shared_config) : Debug_runtime = struct let global_prefix = global_prefix let snapshot () = () + let description = Log_to.description end let default_html_config = PrintBox_html.Config.(tree_summary true default) @@ -1319,6 +1323,7 @@ module PrintBox (Log_to : Shared_config) = struct !global_id let global_prefix = global_prefix + let description = Log_to.description end let debug_file ?(time_tagged = Not_tagged) ?(elapsed_times = elapsed_default) @@ -1364,15 +1369,23 @@ let debug_file ?(time_tagged = Not_tagged) ?(elapsed_times = elapsed_default) let debug ?debug_ch ?(time_tagged = Not_tagged) ?(elapsed_times = elapsed_default) ?(location_format = Beg_pos) ?(print_entry_ids = false) ?(verbose_entry_ids = false) - ?(global_prefix = "") ?table_of_contents_ch ?(toc_entry = And []) ?highlight_terms - ?exclude_on_path ?(prune_upto = 0) ?(truncate_children = 0) ?toc_specific_hyperlink - ?(values_first_mode = false) ?(log_level = Everything) ?snapshot_every_sec () : - (module PrintBox_runtime) = + ?description ?(global_prefix = "") ?table_of_contents_ch ?(toc_entry = And []) + ?highlight_terms ?exclude_on_path ?(prune_upto = 0) ?(truncate_children = 0) + ?toc_specific_hyperlink ?(values_first_mode = false) ?(log_level = Everything) + ?snapshot_every_sec () : (module PrintBox_runtime) = let module Debug = PrintBox (struct let refresh_ch () = false let ch = match debug_ch with None -> stdout | Some ch -> ch let current_snapshot = ref 0 + let description = + match (description, global_prefix, debug_ch) with + | Some descr, _, _ -> descr + | None, "", None -> "stdout" + | None, "", Some _ -> + invalid_arg "Minidebug_runtime.debug: provide description of the channel" + | None, _, _ -> global_prefix + let snapshot_ch () = match debug_ch with | None -> () @@ -1410,8 +1423,9 @@ let debug ?debug_ch ?(time_tagged = Not_tagged) ?(elapsed_times = elapsed_defaul let debug_flushing ?debug_ch:d_ch ?table_of_contents_ch ?filename ?(time_tagged = Not_tagged) ?(elapsed_times = elapsed_default) ?(location_format = Beg_pos) ?(print_entry_ids = false) ?(verbose_entry_ids = false) - ?(global_prefix = "") ?split_files_after ?(with_table_of_contents = false) - ?(toc_entry = And []) ?(for_append = false) () : (module Debug_runtime) = + ?description ?(global_prefix = "") ?split_files_after + ?(with_table_of_contents = false) ?(toc_entry = And []) ?(for_append = false) () : + (module Debug_runtime) = let log_to = match (filename, d_ch) with | None, _ -> @@ -1420,6 +1434,14 @@ let debug_flushing ?debug_ch:d_ch ?table_of_contents_ch ?filename let ch = match d_ch with None -> stdout | Some ch -> ch let current_snapshot = ref 0 + let description = + match (description, global_prefix, d_ch) with + | Some descr, _, _ -> descr + | None, "", None -> "stdout" + | None, "", Some _ -> + invalid_arg "Minidebug_runtime.debug: provide description of the channel" + | None, _, _ -> global_prefix + let snapshot_ch () = match d_ch with | None -> () diff --git a/minidebug_runtime.mli b/minidebug_runtime.mli index 8ce945b..9056f44 100644 --- a/minidebug_runtime.mli +++ b/minidebug_runtime.mli @@ -52,6 +52,7 @@ module type Shared_config = sig val global_prefix : string val split_files_after : int option val toc_entry : toc_entry_criteria + val description : string end val shared_config : @@ -137,6 +138,11 @@ module type Debug_runtime = sig (** For [PrintBox] runtimes, outputs the current logging stack to the logging channel. If the logging channel supports that, an output following a snapshot will rewind the channel to the state prior to the snapshot. Does nothing for the [Flushing] runtimes. *) + + val description : string + (** A description that should be sufficient to locate where the logs end up. + If not configured explicitly, it will be some combination of: + the global prefix, the file name or "stdout". *) end (** The output is flushed line-at-a-time, so no output should be lost if the traced program crashes. @@ -271,6 +277,7 @@ val debug : ?location_format:location_format -> ?print_entry_ids:bool -> ?verbose_entry_ids:bool -> + ?description:string -> ?global_prefix:string -> ?table_of_contents_ch:out_channel -> ?toc_entry:toc_entry_criteria -> @@ -299,6 +306,7 @@ val debug_flushing : ?location_format:location_format -> ?print_entry_ids:bool -> ?verbose_entry_ids:bool -> + ?description:string -> ?global_prefix:string -> ?split_files_after:int -> ?with_table_of_contents:bool ->