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

This commit is contained in:
Vincent Bernardoff 2017-01-14 13:13:13 +01:00 committed by Grégoire Henry
parent a891e23741
commit ad035d7679
2 changed files with 115 additions and 88 deletions

View File

@ -10,52 +10,65 @@
open Error_monad open Error_monad
open CalendarLib 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 ())
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:%SZ" ; "%Y-%m-%d %H:%M:%SZ";
"%Y-%m-%dT%H:%M:%S%:z"; "%Y-%m-%d %H:%M:%S%:z"; ] "%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 round fc =
let f, i = modf fc in let f, i = modf fc in
Int64.(add (of_float i) Pervasives.(if f < 0.5 then 0L else 1L)) in Int64.(add (of_float i) Pervasives.(if f < 0.5 then 0L else 1L)) in
round @@ Calendar.Precise.to_unixfloat c round @@ Calendar.Precise.to_unixfloat c
let rec iter_formats s = function let rec iter_formats s = function
| [] -> None | [] -> None
| f :: fs -> | f :: fs ->
try try
Some (int64_of_calendar @@ Printer.Precise_Calendar.from_fstring f s) Some (int64_of_calendar @@ Printer.Precise_Calendar.from_fstring f s)
with _ -> iter_formats s fs with _ -> iter_formats s fs
let of_notation s = let of_notation s =
iter_formats s formats iter_formats s formats
let of_notation_exn s = let of_notation_exn s =
match of_notation s with match of_notation s with
| None -> invalid_arg "Time.of_notation: can't parse." | None -> invalid_arg "Time.of_notation: can't parse."
| Some t -> t | Some t -> t
let to_notation t = let to_notation t =
let ft = Int64.to_float t in let ft = Int64.to_float t in
if Int64.of_float ft <> t then if Int64.of_float ft <> t then
"out_of_range" "out_of_range"
@ -64,13 +77,13 @@ let to_notation t =
"%Y-%m-%dT%H:%M:%SZ" "%Y-%m-%dT%H:%M:%SZ"
(Calendar.Precise.from_unixfloat ft) (Calendar.Precise.from_unixfloat ft)
let rfc_encoding = let rfc_encoding =
let open Data_encoding in let open Data_encoding in
def def
"timestamp" @@ "timestamp" @@
describe describe
~title: ~title:
"RFC 339 formatted timestamp" "RFC 3339 formatted timestamp"
~description: ~description:
"A date in human readble form as specified in RFC 3339." @@ "A date in human readble form as specified in RFC 3339." @@
conv conv
@ -80,7 +93,7 @@ let rfc_encoding =
| None -> Data_encoding.Json.cannot_destruct "Time.of_notation") | None -> Data_encoding.Json.cannot_destruct "Time.of_notation")
string string
let encoding = let encoding =
let open Data_encoding in let open Data_encoding in
splitted splitted
~binary: int64 ~binary: int64
@ -96,20 +109,26 @@ let encoding =
(fun i -> i) ; (fun i -> i) ;
]) ])
type 'a timed_data = { type 'a timed_data = {
data: 'a ; data: 'a ;
time: t ; time: t ;
} }
let timed_encoding arg_encoding = let timed_encoding arg_encoding =
let open Data_encoding in let open Data_encoding in
conv conv
(fun {time; data} -> (time, data)) (fun {time; data} -> (time, data))
(fun (time, data) -> {time; data}) (fun (time, data) -> {time; data})
(tup2 encoding arg_encoding) (tup2 encoding arg_encoding)
let make_timed data = { let make_timed data = {
data ; time = now () ; 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)

View File

@ -9,6 +9,10 @@
type t type t
val min_value : t
val epoch : t
val max_value : t
val add : t -> int64 -> t val add : t -> int64 -> t
val diff : t -> t -> int64 val diff : t -> t -> int64
@ -46,3 +50,7 @@ type 'a timed_data = {
val make_timed : 'a -> 'a timed_data val make_timed : 'a -> 'a timed_data
val timed_encoding : 'a Data_encoding.t -> 'a timed_data Data_encoding.t 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