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

src/utils/time.ml

@@ -10,52 +10,65 @@
 open Error_monad
 open CalendarLib
 
-type t = int64
+module T = struct
+  include Int64
 
-let compare = Int64.compare
-let (=) x y = compare x y = 0
-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 diff a b =
+    let sign = a >= b in
+    let res = Int64.sub a b in
+    let res_sign = res >= 0L in
+    if sign = res_sign then res else invalid_arg "Time.diff" ;;
 
-let add = Int64.add
-let diff = Int64.sub
+  let add a d =
+    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 to_seconds x = x
+  let min_value = min_int
+  let epoch = 0L
+  let max_value = max_int
 
-let formats =
+  let now () = Int64.of_float (Unix.gettimeofday ())
+
+  let of_seconds x = x
+  let to_seconds x = x
+
+  let formats =
     [ "%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 int64_of_calendar c =
     let round fc =
       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 rec iter_formats s = function
     | [] -> None
     | f :: fs ->
         try
           Some (int64_of_calendar @@ Printer.Precise_Calendar.from_fstring f s)
         with _ -> iter_formats s fs
 
-let of_notation s =
+  let of_notation s =
     iter_formats s formats
-let of_notation_exn s =
+  let of_notation_exn s =
     match of_notation s with
     | None -> invalid_arg "Time.of_notation: can't parse."
     | Some t -> t
 
-let to_notation t =
+  let to_notation t =
     let ft = Int64.to_float t in
     if Int64.of_float ft <> t then
       "out_of_range"
@@ -64,13 +77,13 @@ let to_notation t =
         "%Y-%m-%dT%H:%M:%SZ"
         (Calendar.Precise.from_unixfloat ft)
 
-let rfc_encoding =
+  let rfc_encoding =
     let open Data_encoding in
     def
       "timestamp" @@
     describe
       ~title:
-      "RFC 339 formatted timestamp"
+        "RFC 3339 formatted timestamp"
       ~description:
         "A date in human readble form as specified in RFC 3339." @@
     conv
@@ -80,7 +93,7 @@ let rfc_encoding =
          | None -> Data_encoding.Json.cannot_destruct "Time.of_notation")
       string
 
-let encoding =
+  let encoding =
     let open Data_encoding in
     splitted
       ~binary: int64
@@ -96,20 +109,26 @@ let encoding =
               (fun i -> i) ;
           ])
 
-type 'a timed_data = {
+  type 'a timed_data = {
     data: 'a ;
     time: t ;
-}
+  }
 
-let timed_encoding arg_encoding =
+  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 = {
+  let make_timed data = {
     data ; time = now () ;
-}
+  }
 
-let pp_hum ppf t = Format.pp_print_string ppf (to_notation t)
+  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