let uint64_max = Int64.minus_one module TimeRelative = struct type t = Int64.t let forever = uint64_max let zero = 0L let compare = Int64.unsigned_compare let min a b = if compare a b < 0 then a else b let max a b = if compare a b > 0 then a else b (* forever if either argument is forever or on overflow; otherwise a + b *) let add a b = if a = forever || b = forever then forever else let v = Int64.add a b in if compare v a < 0 then forever else v (* zero if a <= b, or forever if a is forever; otherwise a - b *) let sub a b = if compare a b <= 0 then zero else if a = forever then forever else Int64.sub a b let of_s s = let v = Int64.mul s 1_000_000L in if Int64.unsigned_div v 1_000_000L <> s then forever else v let bin = Bin.beint64 let caqti = let encode v = Ok v in let decode v = Ok v in Caqti_type.custom ~encode ~decode Caqti_type.int64 (* TODO reject negative / non-integer values cap value at 2^53 - 1 inclusive *) let jsont = let jsont = let forever_jsont = let dec s = match s with | "forever" -> forever | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" in let enc _t = "forever" in Jsont.map ~dec ~enc Jsont.string in let num_jsont = Jsont.int64 in let enc t = if t = forever then forever_jsont else num_jsont in Jsont.any ~dec_string:forever_jsont ~dec_number:num_jsont ~enc () in Jsont.Object.map ~kind:"RelativeTime" Fun.id |> Jsont.Object.mem "d_us" jsont ~enc:Fun.id |> Jsont.Object.finish let pp ppf t = if t = forever then Fmt.pf ppf "forever" else Fmt.pf ppf "%Lu" t end module TimeAbsolute = struct type t = Int64.t let never = uint64_max let zero = 0L let compare = Int64.unsigned_compare let min a b = if compare a b < 0 then a else b let max a b = if compare a b > 0 then a else b (* zero if a >= b; never if b=never; otherwise b - a *) let diff a b = if compare a b >= 0 then zero else if b = never then never else Int64.sub b a (* never if either argument is never/forever or on overflow; otherwise t + d *) let add t d = if t = never || d = never then never else let v = Int64.add t d in if compare v t < 0 then never else v (* zero if t <= d, or never if t is never; otherwise t - d *) let sub t d = if compare t d <= 0 then zero else if t = never then never else Int64.sub t d let of_s s = let v = Int64.mul s 1_000_000L in if Int64.unsigned_div v 1_000_000L <> s then never else v let of_ptime v = v |> Ptime.to_float_s |> Int64.of_float |> of_s let bin = Bin.beint64 let pp ppf t = if t = never then Fmt.pf ppf "never" else Fmt.pf ppf "%Lu" t end module Timestamp = struct type t = Int64.t let never = uint64_max let zero = 0L let compare = Int64.unsigned_compare let equal a b = compare a b = 0 let min a b = if compare a b < 0 then a else b let max a b = if compare a b > 0 then a else b (* zero if a >= b; never if b=never; otherwise b - a *) let diff a b = if compare a b >= 0 then zero else if b = never then never else Int64.sub b a let of_s s = let v = Int64.mul s 1_000_000L in if Int64.unsigned_div v 1_000_000L <> s then never else v let to_s t = if t = never then None else Some (Int64.unsigned_div t 1_000_000L) let of_absolute a = if a = never then never else Int64.sub a (Int64.unsigned_rem a 1_000_000L) let of_ptime v = v |> TimeAbsolute.of_ptime |> of_absolute let bin = Bin.beint64 let caqti = let encode v = Ok v in let decode v = Ok v in Caqti_type.custom ~encode ~decode Caqti_type.int64 let jsont = let jsont = let never_jsont = let dec s = match s with | "never" -> never | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" in let enc _t = "never" in Jsont.map ~dec ~enc Jsont.string in let num_jsont = Jsont.map ~dec:(fun n -> of_s n) ~enc:(fun t -> match to_s t with None -> assert false | Some s -> s) Jsont.int64 in let enc t = if t = never then never_jsont else num_jsont in Jsont.any ~dec_string:never_jsont ~dec_number:num_jsont ~enc () in Jsont.Object.map ~kind:"Timestamp" Fun.id |> Jsont.Object.mem "t_s" jsont ~enc:Fun.id |> Jsont.Object.finish let pp ppf t = if t = never then Fmt.pf ppf "never" else Fmt.pf ppf "%Lu" t end