Shell: add Time.{Map,Set,Table}
This commit is contained in:
parent
a891e23741
commit
ad035d7679
@ -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)
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user