+ wip

src/bin_type.ml

@@ -58,28 +58,29 @@ module Bytes_64 = struct
 end
 
 (* -- Time -- *)
-module type Time_S = sig
-  type t = Timestamp.t
-
-  val bin : t Bin.t
-end
-
-module TIME : Time_S = struct
+module TimeAbsolute = struct
   type t = Timestamp.t
 
   let bin = Timestamp.bin
 end
 
-module TIME_NBO : Time_S = struct
+module TimeAbsoluteNBO = struct
   type t = Timestamp.t
 
   let bin = Timestamp.bin_nbo
 end
 
-module TimeAbsolute : Time_S = TIME
-module TimeAbsoluteNBO : Time_S = TIME_NBO
-module TimeRelative : Time_S = TIME
-module TimeRelativeNBO : Time_S = TIME_NBO
+module TimeRelative = struct
+  type t = Timestamp.span
+
+  let bin = Timestamp.Span.bin
+end
+
+module TimeRelativeNBO = struct
+  type t = Timestamp.span
+
+  let bin = Timestamp.Span.bin_nbo
+end
 
 (* -- Cryptographic primitives -- *)
 

src/timestamp.ml

@@ -1,27 +1,52 @@
-type t = Ptime.t option
-type span = Ptime.Span.t option
+type t = int64
+type span = t
 
-let now () = Ptime_clock.now () |> Option.some
+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
+
+module Span = struct
+  type t = span
+
+  let of_int64_us us =
+    let n = Int64.abs us in
+    let d = Int64.to_int @@ Int64.div n us_count_in_day in
+    let ps = Int64.(mul (rem n us_count_in_day) ps_count_in_us) in
+    let span = Ptime.Span.v (d, ps) in
+    if us < 0_L then Ptime.Span.neg span else span
+
+  let 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)
+end
+
+let of_int64_us us =
+  let span = Span.of_int64_us us in
+  Ptime.of_span span
+
+let to_int64_us t =
+  let span = Ptime.to_span t in
+  Span.to_int64_us span
+
+(* --- *)
+
+let ptime_to_int64 ptime = ptime |> Ptime.to_float_s |> Int64.of_float
+let epoch = ptime_to_int64 Ptime.epoch
+let now () = Ptime_clock.now () |> ptime_to_int64 |> Option.some
 
 let diff a b =
   match (a, b) with
   | None, _ | _, None -> None
-  | Some a, Some b -> Some (Ptime.diff a b)
+  | Some a, Some b -> Some (Int64.sub a b)
 
-let add_span_exn t span =
+let add_span t span =
   match (t, span) with
   | None, _ | _, None -> None
-  | Some t, Some span -> (
-      match Ptime.add_span t span with
-      | None -> Fmt.failwith "add_span_exn: not in the range [min;max]"
-      | Some v -> Some v)
+  | Some t, Some span -> Some (Int64.add t span)
 
-let of_span_exn = function
-  | None -> None
-  | Some span -> (
-      match Ptime.of_span span with
-      | None -> Fmt.failwith "of_span_exn: not in the range [min;max]"
-      | Some p -> Some p)
+let of_span = function None -> None | Some span -> Some (Int64.add epoch span)
 
 (* -- *)
 
@@ -50,9 +75,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 =
   match Ptime.of_float_s (Int64.to_float i) with
   | None -> Fmt.failwith "ptime_of_int64 error: `%Ld` is not a valid ptime" i

src/timestamp.mli

@@ -1,14 +1,13 @@
 (* TODO time
    uhuh!
    need to be int64 for binary/pg round trip *)
-
 type t
 type span
 
 val now : unit -> t
 val diff : t -> t -> span
-val add_span_exn : t -> span -> t
-val of_span_exn : span -> t
+val add_span : t -> span -> t
+val of_span : span -> t
 val of_int64 : int64 -> t
 val to_int64 : t -> int64
 val span_of_int64 : int64 -> span