This commit is contained in:
parent
fadfc8bbbe
commit
c614f359d5
2 changed files with 44 additions and 55 deletions
|
|
@ -1,55 +1,63 @@
|
||||||
type t = int64
|
|
||||||
type span = t
|
|
||||||
|
|
||||||
let us_count_in_day = 86_400_000_000_L
|
let us_count_in_day = 86_400_000_000_L
|
||||||
let ps_count_in_us = 1_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 ps_count_in_day = 86_400_000_000_000_000_L
|
||||||
|
|
||||||
module Span = struct
|
let span_of_int64_us us =
|
||||||
type t = span
|
let is_neg = us < 0_L in
|
||||||
|
let us = Int64.abs us in
|
||||||
let of_int64_us us =
|
let d = Int64.to_int @@ Int64.div us us_count_in_day in
|
||||||
let n = Int64.abs us in
|
let ps = Int64.(mul (rem us us_count_in_day) ps_count_in_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
|
let span = Ptime.Span.v (d, ps) in
|
||||||
if us < 0_L then Ptime.Span.neg span else span
|
if is_neg then Ptime.Span.neg span else span
|
||||||
|
|
||||||
let to_int64_us span =
|
let span_to_int64_us span =
|
||||||
let d, ps = Ptime.Span.to_d_ps span in
|
let d, ps = Ptime.Span.to_d_ps span in
|
||||||
Int64.add
|
Int64.add
|
||||||
(Int64.mul (Int64.of_int d) us_count_in_day)
|
(Int64.mul (Int64.of_int d) us_count_in_day)
|
||||||
(Int64.div ps ps_count_in_us)
|
(Int64.div ps ps_count_in_us)
|
||||||
end
|
|
||||||
|
|
||||||
let of_int64_us us =
|
let ptime_to_int64_us t =
|
||||||
let span = Span.of_int64_us us in
|
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
|
Ptime.of_span span
|
||||||
|
|
||||||
let to_int64_us t =
|
type t = int64
|
||||||
let span = Ptime.to_span t in
|
type span = t
|
||||||
Span.to_int64_us span
|
|
||||||
|
|
||||||
(* --- *)
|
module Span = struct
|
||||||
|
type t = span
|
||||||
|
|
||||||
let ptime_to_int64 ptime = ptime |> Ptime.to_float_s |> Int64.of_float
|
let to_int_s t =
|
||||||
let epoch = ptime_to_int64 Ptime.epoch
|
let n = Int64.div t 1_000_000_L in
|
||||||
let now () = Ptime_clock.now () |> ptime_to_int64 |> Option.some
|
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 diff a b =
|
||||||
|
let a = ptime_of_int64_us a in
|
||||||
|
let b = ptime_of_int64_us b in
|
||||||
match (a, b) with
|
match (a, b) with
|
||||||
| None, _ | _, None -> None
|
| None, _ | _, None -> None
|
||||||
| Some a, Some b -> Some (Int64.sub a b)
|
| Some a, Some b ->
|
||||||
|
let span = Ptime.diff a b in
|
||||||
|
Some span
|
||||||
|
|
||||||
let add_span t span =
|
let add_span t span =
|
||||||
match (t, span) with
|
let t = ptime_of_int64_us t in
|
||||||
| None, _ | _, None -> None
|
match t with
|
||||||
| Some t, Some span -> Some (Int64.add t span)
|
| None -> None
|
||||||
|
| Some t ->
|
||||||
let of_span = function None -> None | Some span -> Some (Int64.add epoch span)
|
let span = span_of_int64_us span in
|
||||||
|
Ptime.add_span t span
|
||||||
(* -- *)
|
|
||||||
|
|
||||||
|
(*
|
||||||
(* microseconds since the UNIX Epoch, or "never" if None *)
|
(* microseconds since the UNIX Epoch, or "never" if None *)
|
||||||
let jsont =
|
let jsont =
|
||||||
let number_or_never_jsont =
|
let number_or_never_jsont =
|
||||||
|
|
@ -113,3 +121,4 @@ let caqti : Ptime.t option Caqti_type.t =
|
||||||
let encode v = Ok (encode_int64 v) in
|
let encode v = Ok (encode_int64 v) in
|
||||||
let decode v = Ok (decode_int64 v) in
|
let decode v = Ok (decode_int64 v) in
|
||||||
Caqti_type.custom ~encode ~decode Caqti_type.int64
|
Caqti_type.custom ~encode ~decode Caqti_type.int64
|
||||||
|
*)
|
||||||
|
|
|
||||||
|
|
@ -1,20 +0,0 @@
|
||||||
(* 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 : t -> span -> t
|
|
||||||
val of_span : span -> t
|
|
||||||
val of_int64 : int64 -> t
|
|
||||||
val to_int64 : t -> int64
|
|
||||||
val span_of_int64 : int64 -> span
|
|
||||||
val span_to_int64 : span -> int64
|
|
||||||
|
|
||||||
(* - *)
|
|
||||||
val jsont : t Jsont.t
|
|
||||||
val bin : t Bin.t
|
|
||||||
val bin_nbo : t Bin.t
|
|
||||||
val caqti : t Caqti_type.t
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue