move Time into a proper module in the core, depopt on mtime

This commit is contained in:
Simon Cruanes 2024-03-27 16:05:12 -04:00
parent 8dd86993d7
commit b1728ff0e8
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
9 changed files with 27 additions and 11 deletions

View file

@ -4,6 +4,9 @@
(public_name tiny_httpd.core)
(private_modules parse_ common_)
(libraries threads seq hmap iostream
(select time.ml from
(mtime mtime.clock.os -> time.mtime.ml)
(unix -> time.default.ml))
(select log.ml from
(logs -> log.logs.ml)
(-> log.default.ml))))

View file

@ -1,3 +1,5 @@
let now_s = Unix.gettimeofday
let[@inline] now_us () =
let t = Unix.gettimeofday () in
t *. 1e6 |> ceil

10
src/core/time.mli Normal file
View file

@ -0,0 +1,10 @@
(** Basic time measurement.
This provides a basic clock, monotonic if [mtime] is installed,
or based on [Unix.gettimeofday] otherwise *)
val now_us : unit -> float
(** Current time in microseconds. The precision should be at least below the millisecond. *)
val now_s : unit -> float
(** Current time in seconds. The precision should be at least below the millisecond. *)

7
src/core/time.mtime.ml Normal file
View file

@ -0,0 +1,7 @@
let[@inline] now_s () =
let t = Mtime_clock.now_ns () in
Int64.(div t 1_000_000_000L |> to_float)
let[@inline] now_us () =
let t = Mtime_clock.now_ns () in
Int64.(div t 1000L |> to_float)

View file

@ -1,3 +1,4 @@
module A = Tiny_httpd_core.Atomic_
module Time = Tiny_httpd_core.Time
let spf = Printf.sprintf

View file

@ -4,10 +4,7 @@
(name tiny_httpd_prometheus)
(public_name tiny_httpd.prometheus)
(synopsis "Metrics using prometheus")
(private_modules common_p_ time_)
(private_modules common_p_)
(flags :standard -open Tiny_httpd_core)
(libraries
tiny_httpd.core unix
(select time_.ml from
(mtime mtime.clock.os -> time_.mtime.ml)
(-> time_.default.ml))))
tiny_httpd.core unix))

View file

@ -1 +0,0 @@
val now_us : unit -> float

View file

@ -1,3 +0,0 @@
let[@inline] now_us () =
let t = Mtime_clock.now_ns () in
Int64.(div t 1000L |> to_float)

View file

@ -189,12 +189,12 @@ let http_middleware (reg : Registry.t) : Server.Middleware.t =
fun h : Server.Middleware.handler ->
fun req ~resp : unit ->
let start = Time_.now_us () in
let start = Time.now_us () in
Counter.incr c_req;
h req ~resp:(fun (response : Response.t) ->
let code = response.code in
let elapsed_us = Time_.now_us () -. start in
let elapsed_us = Time.now_us () -. start in
let elapsed_s = elapsed_us /. 1e6 in
Histogram.add h_latency elapsed_s;