Skip to content

Commit

Permalink
Allow log levels to be configured per-source (#171)
Browse files Browse the repository at this point in the history
  • Loading branch information
jsthomas authored Nov 8, 2021
1 parent b11f9f8 commit 440fa71
Show file tree
Hide file tree
Showing 2 changed files with 45 additions and 11 deletions.
11 changes: 9 additions & 2 deletions src/dream.mli
Original file line number Diff line number Diff line change
Expand Up @@ -1688,7 +1688,7 @@ type sub_log = {
}
(** Sub-logs. See {!Dream.val-sub_log} right below. *)

val sub_log : string -> sub_log
val sub_log : ?level:[< log_level] -> string -> sub_log
(** Creates a new sub-log with the given name. For example,
{[
Expand All @@ -1702,6 +1702,10 @@ val sub_log : string -> sub_log
log.error (fun log -> log ~request "Validation failed")
]}
[?level] sets the log level threshold for this sub-log only. If not
provided, falls back to the global log level set by {!Dream.initialize_log},
unless {!Dream.set_log_level} is used.
See [README] of example
{{:https://github.com/aantron/dream/tree/master/example/a-log#files}
[a-log]}. *)
Expand Down Expand Up @@ -1730,12 +1734,15 @@ val initialize_log :
[Lwt.async_exception_hook]} so as to forward all asynchronous exceptions
to the logger, and not terminate the process.
- [~level] sets the log level threshould for the entire binary. The default
- [~level] sets the log level threshold for the entire binary. The default
is [`Info].
- [~enable:false] disables Dream logging completely. This can help sanitize
output during testing. *)

val set_log_level : string -> [< log_level ] -> unit
(** Set the log level threshold of the given sub-log. *)



(** {1 Errors}
Expand Down
45 changes: 36 additions & 9 deletions src/middleware/log.ml
Original file line number Diff line number Diff line change
Expand Up @@ -197,6 +197,12 @@ let enable =
let level =
ref Logs.Info

let custom_log_levels : (string * Logs.level) list ref =
ref []

let sources : (string * Logs.src) list ref =
ref []

let set_printexc =
ref true

Expand All @@ -212,6 +218,13 @@ type log_level = [
| `Debug
]

let to_logs_level l =
match l with
| `Error -> Logs.Error
| `Warning -> Logs.Warning
| `Info -> Logs.Info
| `Debug -> Logs.Debug

exception Logs_are_not_initialized

let setup_logs =
Expand Down Expand Up @@ -244,7 +257,7 @@ type sub_log = {
debug : 'a. ('a, unit) conditional_log;
}

let sub_log name =
let sub_log ?level:level_ name =
(* This creates a wrapper, as described above. The wrapper forwards to a
logger of the Logs library, but instead of passing the formatter m to the
user's callback, it passes a formatter m', which is like m, but lacks a
Expand All @@ -268,9 +281,21 @@ let sub_log name =
log ~tags format_and_arguments))
in

let level =
List.find Option.is_some [
Option.map to_logs_level level_;
List.assoc_opt name !custom_log_levels;
Some !level
] in

(* Create the actual Logs source, and then wrap all the interesting
functions. *)
let (module Log) = Logs.src_log (Logs.Src.create name) in
let src = Logs.Src.create name in
let (module Log) = Logs.src_log src in
Logs.Src.set_level src level;
custom_log_levels :=
(name, Option.get level)::(List.remove_assoc name !custom_log_levels);
sources := (name, src) :: (List.remove_assoc name !sources);

{
error = (fun k -> forward ~destination_log:Log.err k);
Expand Down Expand Up @@ -335,19 +360,21 @@ let initialize_log
set_async_exception_hook := false;

let level_ =
match level_ with
| None -> Logs.Info
| Some `Error -> Logs.Error
| Some `Warning -> Logs.Warning
| Some `Info -> Logs.Info
| Some `Debug -> Logs.Debug
in
Option.map to_logs_level level_
|> Option.value ~default:Logs.Info in

enable := enable_;
level := level_;
let `Initialized = initialized () in
()

let set_log_level name level =
let level = to_logs_level level in
custom_log_levels :=
(name, level)::(List.remove_assoc name !custom_log_levels);
let src = List.assoc_opt name !sources in
Option.iter (fun s -> Logs.Src.set_level s (Some level)) src

module Make (Pclock : Mirage_clock.PCLOCK) =
struct
let now () =
Expand Down

0 comments on commit 440fa71

Please sign in to comment.