This commit is contained in:
swrup 2025-12-07 12:41:50 +01:00
parent ebe8824e9c
commit 94ce2c0178

View file

@ -1,62 +1,36 @@
let us_count_in_day = 86_400_000_000_L
let ps_count_in_us = 1_000_000_L
let ps_count_in_day = 86_400_000_000_000_000_L
type t = Ptime.t
type span = Ptime.span
let span_of_int_s = Ptime.Span.of_int_s
let span_of_int64_us us =
let is_neg = us < 0_L in
let us = Int64.abs us in
let d = Int64.to_int @@ Int64.div us us_count_in_day in
let ps = Int64.(mul (rem us us_count_in_day) ps_count_in_us) in
let span = Ptime.Span.v (d, ps) in
if is_neg then Ptime.Span.neg span else span
let s = Int64.(to_int (div us 1_000_000_L)) in
span_of_int_s s
let span_to_int_s = Ptime.Span.to_int_s
let span_to_int64_us span =
let d, ps = Ptime.Span.to_d_ps span in
Int64.add
(Int64.mul (Int64.of_int d) us_count_in_day)
(Int64.div ps ps_count_in_us)
let ptime_to_int64_us t =
let span = Ptime.to_span t in
span_to_int64_us span
let ptime_of_int64_us us =
let span = span_of_int64_us us in
Ptime.of_span span
type t = int64
type span = t
module Span = struct
type t = span
let to_int_s t =
let n = Int64.div t 1_000_000_L in
Int64.to_int n
let of_int_s n = Int64.of_int @@ (n * 1_000_000)
end
let of_span span = ptime_of_int64_us span
let now () = Ptime_clock.now () |> ptime_to_int64_us
let diff a b =
let a = ptime_of_int64_us a in
let b = ptime_of_int64_us b in
match (a, b) with
| None, _ | _, None -> None
| Some a, Some b ->
let span = Ptime.diff a b in
Some span
let add_span t span =
let t = ptime_of_int64_us t in
match t with
match span_to_int_s span with
| None -> None
| Some t ->
let span = span_of_int64_us span in
Ptime.add_span t span
| Some s ->
let us = Int64.(mul (of_int s) 1_000_000_L) in
Some us
let of_int_s s = Ptime.of_span @@ span_of_int_s s
let of_int64_us us = Ptime.of_span @@ span_of_int64_us us
let to_int_s t = Ptime.Span.to_int_s (Ptime.to_span t)
let to_int64_us span =
match to_int_s span with
| None -> None
| Some s ->
let us = Int64.(mul (of_int s) 1_000_000_L) in
Some us
let now () = Ptime_clock.now ()
let add_span t span = Ptime.add_span t span
let sub_span t span = Ptime.sub_span t span
let diff a b = Ptime.diff a b
(*
(* microseconds since the UNIX Epoch, or "never" if None *)
let jsont =
@ -83,36 +57,6 @@ let jsont =
|> Jsont.Object.mem "t_s" number_or_never_jsont ~enc:Fun.id
|> Jsont.Object.finish
let ptime_of_int64 i =
match Ptime.of_float_s (Int64.to_float i) with
| None -> Fmt.failwith "ptime_of_int64 error: `%Ld` is not a valid ptime" i
| Some ts -> ts
let ptime_span_to_int64 span = span |> Ptime.Span.to_float_s |> Int64.of_float
let ptime_span_of_int64 i =
match Ptime.Span.of_float_s (Int64.to_float i) with
| None ->
Fmt.failwith "span_of_int64 error: `%Ld` is not a valid ptime span" i
| Some ts -> ts
(* - *)
let encode_int64 = function None -> Int64.max_int | Some p -> ptime_to_int64 p
let decode_int64 i = if i = Int64.max_int then None else Some (ptime_of_int64 i)
let encode_span_int64 = function
| None -> Int64.max_int
| Some p -> ptime_span_to_int64 p
let decode_span_int64 i =
if i = Int64.max_int then None else Some (ptime_span_of_int64 i)
let to_int64 = encode_int64
let of_int64 = decode_int64
let span_to_int64 = encode_span_int64
let span_of_int64 = decode_span_int64
(* UINT64_MAX represents "never". *)
let bin = Bin.map Bin.neint64 decode_int64 encode_int64
let bin_nbo = Bin.map Bin.beint64 decode_int64 encode_int64