better relative time

src/timestamp.ml

@@ -48,7 +48,6 @@ let jsont =
   |> Jsont.Object.mem "t_s" number_or_never_jsont ~enc:Fun.id
   |> Jsont.Object.finish
 
-(* TODO exn *)
 let ptime_to_int64 ptime = ptime |> Ptime.to_float_s |> Int64.of_float
 
 let ptime_of_int64 i =
@@ -77,3 +76,62 @@ let compare a b =
       let b = ptime_to_int64 b in
       let c = Int64.compare a b in
       Some c
+
+module Span = struct
+  type t = span
+
+  let to_int64 ptime = ptime |> Ptime.Span.to_float_s |> Int64.of_float
+
+  let of_int64 i =
+    match Ptime.Span.of_float_s (Int64.to_float i) with
+    | None ->
+        Fmt.failwith
+          "ptime_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 -> to_int64 p
+  let decode_int64 i = if i = Int64.max_int then None else Some (of_int64 i)
+
+  (* UINT64_MAX represents "forever" *)
+  let bin = Bin.map Bin.neint64 decode_int64 encode_int64
+  let bin_nbo = Bin.map Bin.beint64 decode_int64 encode_int64
+
+  let caqti : t 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
+
+  let jsont =
+    let number_or_forever_jsont =
+      let forever =
+        let dec s =
+          match s with
+          | "forever" -> None
+          | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
+        in
+        let enc = function None -> "forever" | _ -> assert false in
+        Jsont.map ~dec ~enc Jsont.string
+      in
+      let number =
+        let dec n =
+          (* relative time is in us *)
+          let n = n /. 1_000_000. in
+          Ptime.Span.of_float_s n
+        in
+        let enc = function
+          | Some span ->
+              let n = Ptime.Span.to_float_s span in
+              n *. 1_000_000.
+          | _ -> assert false
+        in
+        Jsont.map ~dec ~enc Jsont.number
+      in
+      let enc = function None -> forever | Some _ -> number in
+      Jsont.any ~dec_string:forever ~dec_number:number ~enc ()
+    in
+
+    let make t_s = t_s in
+    Jsont.Object.map ~kind:"RelativeTime" make
+    |> Jsont.Object.mem "t_s" number_or_forever_jsont ~enc:Fun.id
+    |> Jsont.Object.finish
+end