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 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 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 | None -> None | Some t -> let span = span_of_int64_us span in Ptime.add_span t span (* (* microseconds since the UNIX Epoch, or "never" if None *) let jsont = let number_or_never_jsont = let never = let dec s = match s with | "never" -> None | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" in let enc = function None -> "never" | _ -> assert false in Jsont.map ~dec ~enc Jsont.string in let number = let dec n = Ptime.of_float_s n in let enc = function Some n -> Ptime.to_float_s n | _ -> assert false in Jsont.map ~dec ~enc Jsont.number in let enc = function None -> never | Some _ -> number in Jsont.any ~dec_string:never ~dec_number:number ~enc () in let make t = t in Jsont.Object.map ~kind:"Timestamp" make |> 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 let caqti : Ptime.t option Caqti_type.t = let encode v = Ok (encode_int64 v) in let decode v = Ok (decode_int64 v) in Caqti_type.custom ~encode ~decode Caqti_type.int64 *)