~~~

src/timestamp.ml

@@ -1,6 +1,8 @@
 type t = Ptime.t option
 type span = Ptime.Span.t option
 
+let epoch = Some Ptime.epoch
+
 let diff a b =
   match (a, b) with
   | None, _ | _, None -> None
@@ -23,6 +25,23 @@ let of_span_exn = function
 
 (* -- *)
 
+(* TODO
+   this doesn't handle "never" value, and truncate time *)
+let of_string s =
+  match Float.of_string_opt s with
+  | None -> Error "Timestamp.of_string failure: not a float"
+  | Some v -> (
+      match Ptime.of_float_s v with
+      | None -> Error "Timestamp.of_string failure"
+      | Some v -> Ok (Some v))
+
+let pp fmt t =
+  match t with
+  | None -> Fmt.pf fmt {|"never"|}
+  | Some v ->
+      let v = Ptime.to_float_s v in
+      Fmt.pf fmt {|%f|} v
+
 (* microseconds since the UNIX Epoch, or "never" if None *)
 let jsont =
   let number_or_never_jsont =
@@ -48,7 +67,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 =
@@ -63,7 +81,93 @@ let decode_int64 i = if i = Int64.max_int then None else Some (ptime_of_int64 i)
 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 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 compare a b =
+  match (a, b) with
+  | None, None -> Some 0
+  | None, _ | _, None -> None
+  | Some a, Some b ->
+      let a = ptime_to_int64 a in
+      let b = ptime_to_int64 b in
+      let c = Int64.compare a b in
+      Some c
+
+module Span = struct
+  type t = span
+
+  (* TODO
+   this doesn't handle "never" value, and truncate time *)
+  let of_string s =
+    match Float.of_string_opt s with
+    | None -> Error "Timestamp.Span.of_string failure: not a float"
+    | Some v -> (
+        match Ptime.Span.of_float_s v with
+        | None -> Error "Timestamp.Span.of_string failure"
+        | Some v -> Ok (Some v))
+
+  let pp fmt t =
+    match t with
+    | None -> Fmt.pf fmt {|"forever"|}
+    | Some v ->
+        let v = Ptime.Span.to_float_s v in
+        Fmt.pf fmt {|%f|} v
+
+  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