1 files changed, 101 insertions, 0 deletions
diff --git a/date.ml b/date.ml
new file mode 100644
index 0000000..9b24afe
--- /dev/null
+++ b/date.ml
@@ -0,0 +1,101 @@
+type t = Num.num
+
+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 *)
+  |> Num.num_of_int
+
+end
+
+let date_from_julian_day day = begin
+
+  let shift_day = Num.floor_num day
+    |> Num.add_num (Num.num_of_int 2415019) in
+
+  let z = Num.int_of_num shift_day in
+  let f =
+    if z >= 2299161 then
+      (* We use the Num module here to prevent overflow *)
+      let day' = Num.(((num_of_int 4) */ shift_day +/ (num_of_int 274277)) // (num_of_int 146097))
+              |> Num.floor_num
+              |> Num.int_of_num 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 Num.(
+  let day = floor_num j in
+  let time = j -/ day in
+
+  let h = floor_num @@ time */ (num_of_int 24) in
+  let h_24 = (h // (num_of_int 24)) in
+  let m = floor_num @@ (num_of_int 1440) */ (time -/ h_24 ) in
+  let s = (num_of_int 86400) */ (time -/ h_24 -/ (m // (num_of_int 1440))) in
+  (h, 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 = Num.num_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 ->
+    Num.(
+      let nhour = n hour // (n 24)
+      and nmin  = n min // (n 1440)
+      and nsec  = n sec // (n 86400) in
+      (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 (
+    Num.num_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
+    (Num.int_of_num h)
+    (Num.int_of_num n)
+    (Num.float_of_num s)
+
+end
+
+