prefix log lines with timestamp

This commit is contained in:
User Builder 2021-05-26 12:36:38 +00:00 committed by Robur
parent bc7a2006e3
commit f7eafc56c5
2 changed files with 28 additions and 17 deletions

View file

@ -1,12 +1,29 @@
open Opium open Opium
let timestamp_reporter () =
let report src level ~over k msgf =
let k _ = over (); k () in
msgf @@ fun ?header ?tags:_ fmt ->
let posix_time = Ptime_clock.now () in
let src_name = Logs.Src.name src in
Format.kfprintf k Format.std_formatter
("%a [%s] %a @[" ^^ fmt ^^ "@]@.")
(Ptime.pp_rfc3339 ()) posix_time src_name
Logs.pp_header (level, header)
in
{ Logs.report }
let setup_log style_renderer level =
Fmt_tty.setup_std_outputs ?style_renderer ();
Logs.set_level level;
Logs.set_reporter (timestamp_reporter ()) (* (Logs_fmt.reporter ~dst:Format.std_formatter ()) *)
let app t = let app t =
App.empty App.empty
|> App.cmd_name "Builder Web" |> App.cmd_name "Builder Web"
|> Builder_web.add_routes t |> Builder_web.add_routes t
let setup_app port host _debug _verbose datadir = let setup_app () port host datadir =
let dbpath = Printf.sprintf "%s/builder.sqlite3" datadir in let dbpath = Printf.sprintf "%s/builder.sqlite3" datadir in
let datadir = Fpath.v datadir in let datadir = Fpath.v datadir in
match Builder_web.init dbpath datadir with match Builder_web.init dbpath datadir with
@ -20,10 +37,14 @@ let setup_app port host _debug _verbose datadir =
app t app t
|> App.port port |> App.port port
|> App.host host |> App.host host
|> (match Logs.level () with Some Debug -> (fun x -> x |> App.debug true |> App.verbose true) | Some Info -> App.verbose true | _ -> (fun x -> x))
|> App.start |> App.start
open Cmdliner open Cmdliner
let setup_log =
Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ())
let datadir = let datadir =
let doc = "data directory" in let doc = "data directory" in
Arg.(value & opt dir "/var/db/builder-web/" & info [ "d"; "datadir" ] ~doc) Arg.(value & opt dir "/var/db/builder-web/" & info [ "d"; "datadir" ] ~doc)
@ -36,25 +57,15 @@ let host =
let doc = "host" in let doc = "host" in
Arg.(value & opt string "0.0.0.0" & info [ "h"; "host" ] ~doc) Arg.(value & opt string "0.0.0.0" & info [ "h"; "host" ] ~doc)
let debug =
let doc = "enable debug information" in
Arg.(value & flag & info [ "d"; "debug" ] ~doc)
let verbose =
let doc = "enable verbose mode" in
Arg.(value & flag & info [ "v"; "verbose" ] ~doc)
let () = let () =
let () = Mirage_crypto_rng_unix.initialize () in let () = Mirage_crypto_rng_unix.initialize () in
let term = Term.(pure setup_app $ port $ host $ pure false $ pure false $ datadir) in let term = Term.(pure setup_app $ setup_log $ port $ host $ datadir) in
let info = Term.info "Builder web" ~doc:"Builder web" ~man:[] in let info = Term.info "Builder web" ~doc:"Builder web" ~man:[] in
match Term.eval (term, info) with match Term.eval (term, info) with
| `Ok s -> | `Ok s ->
Lwt_main.run (Lwt.async (fun () -> Printexc.record_backtrace true;
Lwt.bind s (fun _ -> Lwt.return_unit)); let () = Lwt.async (fun () -> Lwt.bind s (fun _ -> Lwt.return_unit)) in
let forever, _ = Lwt.wait () in let forever, _ = Lwt.wait () in
forever) Lwt_main.run forever
| `Error _ -> exit 1 | `Error _ -> exit 1
| _ -> exit 0 | _ -> exit 0

View file

@ -2,7 +2,7 @@
(public_name builder-web) (public_name builder-web)
(name builder_web_app) (name builder_web_app)
(modules builder_web_app) (modules builder_web_app)
(libraries builder_web mirage-crypto-rng.unix cmdliner)) (libraries builder_web mirage-crypto-rng.unix cmdliner logs.cli fmt.cli fmt.tty ptime.clock.os))
(executable (executable
(public_name builder-db) (public_name builder-db)