improve error messages in main somewhat
This commit is contained in:
parent
e2967fabd9
commit
4cbd4421ce
12
bin/main.ml
12
bin/main.ml
|
@ -1,3 +1,5 @@
|
||||||
|
include (val Logging.sublogs Server.logger "Main")
|
||||||
|
|
||||||
let min_level =
|
let min_level =
|
||||||
match Sys.getenv_opt "LOG_LEVEL" |> Option.map String.uppercase_ascii with
|
match Sys.getenv_opt "LOG_LEVEL" |> Option.map String.uppercase_ascii with
|
||||||
| Some "TRACE" -> Logging.TRACE
|
| Some "TRACE" -> Logging.TRACE
|
||||||
|
@ -72,4 +74,14 @@ let config : Server.config = {
|
||||||
}
|
}
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
|
Printexc.register_printer
|
||||||
|
(function
|
||||||
|
| Unix.Unix_error (eno, who, _) -> Some (Fmt.str "%s: %s" who (Unix.error_message eno))
|
||||||
|
| Failure msg -> Some ("internal error: " ^ msg)
|
||||||
|
| Invalid_argument who -> Some ("internal error: invalid argumnet: " ^ who)
|
||||||
|
| _ -> None);
|
||||||
|
try
|
||||||
Lwt_main.run @@ Server.run config
|
Lwt_main.run @@ Server.run config
|
||||||
|
with exn ->
|
||||||
|
error (fun m -> m "%a" Fmt.exn exn);
|
||||||
|
exit 1
|
||||||
|
|
Loading…
Reference in New Issue