mte/src/timestamp.ml

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
  *)