diff options
Diffstat (limited to 'src/date.ml')
-rw-r--r-- | src/date.ml | 120 |
1 files changed, 120 insertions, 0 deletions
diff --git a/src/date.ml b/src/date.ml new file mode 100644 index 0000000..92cb9f6 --- /dev/null +++ b/src/date.ml @@ -0,0 +1,120 @@ +module type CALCULABLE = sig + + type t + + val add: t -> t -> t + + val sub: t -> t -> t + + val mult: t -> t -> t + + val div: t -> t -> t + + val floor: t -> t + + val of_int: int -> t + + val to_int: t -> int + + val to_float: t -> float + +end + + +module Make(C : CALCULABLE) = struct + + let get_julian_day year month day = begin + let y, m = + if month > 2 then + year, month + else + year - 1, month + 12 + in + let b = + if (year > 1582) || (year = 1582 && month > 10) || (year = 1582 && month = 10 && day >= 15) then + let s = y / 100 in + 2 - s + (s / 4) + else + 0 + in + 365 * y + y / 4 + + (int_of_float (30.6001 *. (float_of_int (m + 1)))) + + day + + b + + 1720995 + - 2415019 (* Shift to 30/12/1899 *) + |> C.of_int + + end + + let date_from_julian_day day = begin + + let shift_day = C.add (C.floor day) (C.of_int 2415019) in + + let z = C.to_int shift_day in + let f = + if z >= 2299161 then + (* We use the Num module here to prevent overflow *) + let product = C.mult (C.of_int 4) shift_day in + let shifted = C.add product (C.of_int 274277) in + let div = C.div shifted (C.of_int 146097) in + let day' = C.to_int @@ C.floor div in + z + 1401 + ((day' * 3) / 4) - 38 + else + z + 1401 + in + let e = (4 * f) + 3 in + let h = 5 * ((e mod 1461) / 4) + 2 in (* 1461 is 365.25 * 4 *) + let d = ((h mod 153) / 5) + 1 + and m = (((h / 153) + 2) mod 12) + 1 in + let y = (e / 1461) - 4716 + (14 - m) / 12 in (* 4716 is day 2 *) + (y, m, d) + + end + + let time_from_julian_day j = begin + + let day = C.floor j in + let time = C.sub j day in + + let h = C.floor @@ C.mult time (C.of_int 24) in + let h_24 = C.div h (C.of_int 24) in + let m = C.floor @@ C.mult (C.of_int 1440) (C.sub time h_24) in + let s = C.mult (C.of_int 86400) (C.sub (C.sub time h_24) (C.div m (C.of_int 1440))) in + (C.to_int h, C.to_int m, s) + end + + (** Compute the julian for a given date. + + Integer return number of days since November 24, 4714 BC. + Fractionnal part return the time since midnight. + *) + let from_string str = begin + let n = C.of_int in + let date_regex = Str.regexp "[0-9]+-[0-9]+-[0-9]+" + and time_regex = Str.regexp "[0-9]+-[0-9]+-[0-9]+T[0-9]+:[0-9]+:[0-9]" in + if Str.string_match time_regex str 0 then + Scanf.sscanf str "%d-%d-%dT%d:%d:%d" (fun year month day hour min sec -> + let nhour = C.div (n hour) (n 24) + and nmin = C.div (n min) (n 1440) + and nsec = C.div (n sec) (n 86400) in + C.add (C.add (C.add (get_julian_day year month day) nhour) nmin) nsec + ) else if Str.string_match date_regex str 0 then + Scanf.sscanf str "%d-%d-%d" get_julian_day + else ( + C.of_int 0 + ) + end + + let to_string date = begin + let y, m, d = date_from_julian_day date + and h, n, s = time_from_julian_day date in + + Printf.sprintf "%d-%02d-%02dT%02d:%02d:%02g" + y m d + + h n (C.to_float s) + + end + +end |