Shell: add Time.{Map,Set,Table}

src/utils/time.ml

@@ -10,106 +10,125 @@
 open Error_monad
 open CalendarLib
 
-type t = int64
+module T = struct
+  include Int64
 
-let compare = Int64.compare
+  let diff a b =
-let (=) x y = compare x y = 0
+    let sign = a >= b in
-let equal = (=)
+    let res = Int64.sub a b in
-let (<>) x y = compare x y <> 0
+    let res_sign = res >= 0L in
-let (<) x y = compare x y < 0
+    if sign = res_sign then res else invalid_arg "Time.diff" ;;
-let (<=) x y = compare x y <= 0
-let (>=) x y = compare x y >= 0
-let (>) x y = compare x y > 0
-let min x y = if x <= y then x else y
-let max x y = if x <= y then y else x
 
-let add = Int64.add
+  let add a d =
-let diff = Int64.sub
+    let sign = d >= 0L in
+    let res = Int64.add a d in
+    let incr_sign = res >= a in
+    if sign = incr_sign then res else invalid_arg "Time.add" ;;
 
-let now () = Int64.of_float (Unix.gettimeofday ())
+  let hash = to_int
+  let (=) = equal
+  let (<>) x y = compare x y <> 0
+  let (<) x y = compare x y < 0
+  let (<=) x y = compare x y <= 0
+  let (>=) x y = compare x y >= 0
+  let (>) x y = compare x y > 0
+  let min x y = if x <= y then x else y
+  let max x y = if x <= y then y else x
 
-let of_seconds x = x
+  let min_value = min_int
-let to_seconds x = x
+  let epoch = 0L
+  let max_value = max_int
 
-let formats =
+  let now () = Int64.of_float (Unix.gettimeofday ())
-  [ "%Y-%m-%dT%H:%M:%SZ" ; "%Y-%m-%d %H:%M:%SZ";
-    "%Y-%m-%dT%H:%M:%S%:z"; "%Y-%m-%d %H:%M:%S%:z"; ]
 
-let int64_of_calendar c =
+  let of_seconds x = x
-  let round fc =
+  let to_seconds x = x
-    let f, i = modf fc in
-    Int64.(add (of_float i) Pervasives.(if f < 0.5 then 0L else 1L)) in
-  round @@ Calendar.Precise.to_unixfloat c
 
-let rec iter_formats s = function
+  let formats =
-  | [] -> None
+    [ "%Y-%m-%dT%H:%M:%SZ" ; "%Y-%m-%d %H:%M:%SZ";
-  | f :: fs ->
+      "%Y-%m-%dT%H:%M:%S%:z"; "%Y-%m-%d %H:%M:%S%:z"; ]
-      try
-        Some (int64_of_calendar @@ Printer.Precise_Calendar.from_fstring f s)
-      with _ -> iter_formats s fs
 
-let of_notation s =
+  let int64_of_calendar c =
-  iter_formats s formats
+    let round fc =
-let of_notation_exn s =
+      let f, i = modf fc in
-  match of_notation s with
+      Int64.(add (of_float i) Pervasives.(if f < 0.5 then 0L else 1L)) in
-  | None -> invalid_arg "Time.of_notation: can't parse."
+    round @@ Calendar.Precise.to_unixfloat c
-  | Some t -> t
 
-let to_notation t =
+  let rec iter_formats s = function
-  let ft = Int64.to_float t in
+    | [] -> None
-  if Int64.of_float ft <> t then
+    | f :: fs ->
-    "out_of_range"
+        try
-  else
+          Some (int64_of_calendar @@ Printer.Precise_Calendar.from_fstring f s)
-    Printer.Precise_Calendar.sprint
+        with _ -> iter_formats s fs
-      "%Y-%m-%dT%H:%M:%SZ"
-      (Calendar.Precise.from_unixfloat ft)
 
-let rfc_encoding =
+  let of_notation s =
-  let open Data_encoding in
+    iter_formats s formats
-  def
+  let of_notation_exn s =
-    "timestamp" @@
+    match of_notation s with
-  describe
+    | None -> invalid_arg "Time.of_notation: can't parse."
-    ~title:
+    | Some t -> t
-      "RFC 339 formatted timestamp"
-    ~description:
-      "A date in human readble form as specified in RFC 3339." @@
-  conv
-    to_notation
-    (fun s -> match of_notation s with
-       | Some s -> s
-       | None -> Data_encoding.Json.cannot_destruct "Time.of_notation")
-    string
 
-let encoding =
+  let to_notation t =
-  let open Data_encoding in
+    let ft = Int64.to_float t in
-  splitted
+    if Int64.of_float ft <> t then
-    ~binary: int64
+      "out_of_range"
-    ~json:
+    else
-      (union [
+      Printer.Precise_Calendar.sprint
-          case
+        "%Y-%m-%dT%H:%M:%SZ"
-            rfc_encoding
+        (Calendar.Precise.from_unixfloat ft)
-            (fun i -> Some i)
-            (fun i -> i) ;
-          case
-            int64
-            (fun _ -> None)
-            (fun i -> i) ;
-        ])
 
-type 'a timed_data = {
+  let rfc_encoding =
-  data: 'a ;
+    let open Data_encoding in
-  time: t ;
+    def
-}
+      "timestamp" @@
+    describe
+      ~title:
+        "RFC 3339 formatted timestamp"
+      ~description:
+        "A date in human readble form as specified in RFC 3339." @@
+    conv
+      to_notation
+      (fun s -> match of_notation s with
+         | Some s -> s
+         | None -> Data_encoding.Json.cannot_destruct "Time.of_notation")
+      string
 
-let timed_encoding arg_encoding =
+  let encoding =
-  let open Data_encoding in
+    let open Data_encoding in
-  conv
+    splitted
-    (fun {time; data} -> (time, data))
+      ~binary: int64
-    (fun (time, data) -> {time; data})
+      ~json:
-    (tup2 encoding arg_encoding)
+        (union [
+            case
+              rfc_encoding
+              (fun i -> Some i)
+              (fun i -> i) ;
+            case
+              int64
+              (fun _ -> None)
+              (fun i -> i) ;
+          ])
 
-let make_timed data = {
+  type 'a timed_data = {
-  data ; time = now () ;
+    data: 'a ;
-}
+    time: t ;
+  }
 
-let pp_hum ppf t = Format.pp_print_string ppf (to_notation t)
+  let timed_encoding arg_encoding =
+    let open Data_encoding in
+    conv
+      (fun {time; data} -> (time, data))
+      (fun (time, data) -> {time; data})
+      (tup2 encoding arg_encoding)
+
+  let make_timed data = {
+    data ; time = now () ;
+  }
+
+  let pp_hum ppf t = Format.pp_print_string ppf (to_notation t)
+end
+
+include T
+module Set = Set.Make(T)
+module Map = Map.Make(T)
+module Table = Hashtbl.Make(T)

src/utils/time.mli

@@ -9,6 +9,10 @@
 
 type t
 
+val min_value : t
+val epoch : t
+val max_value : t
+
 val add : t -> int64 -> t
 val diff : t -> t -> int64
 
@@ -46,3 +50,7 @@ type 'a timed_data = {
 val make_timed : 'a -> 'a timed_data
 
 val timed_encoding : 'a Data_encoding.t -> 'a timed_data Data_encoding.t
+
+module Set : Set.S with type elt = t
+module Map : Map.S with type key = t
+module Table : Hashtbl.S with type key = t