Commits

camlspotter committed 87377da

cleanup

  • Participants
  • Parent commits a7a1a18

Comments (0)

Files changed (2)

File lib/temporal.ml

   let days_of_year n = if is_leap n then 366 else 365
 end
 
+module Weekday = struct
+
+  let to_string = function
+    | 0 -> "Sun"
+    | 1 -> "Mon"
+    | 2 -> "Tue"
+    | 3 -> "Wed"
+    | 4 -> "Thu"
+    | 5 -> "Fri"
+    | 6 -> "Sat"
+    | _ -> assert false
+
+end
+
 module Date = struct
+
   type t = Temporal_lexer.date = {
     year : int;  (* 1998 *)
     month : int; (* 1-12 *)
     in
     { year; month; day }
 
+      
+  let date_1970_01_01 = { year = 1970; month = 1; day = 1 }
+  let date_2038_01_01 = { year = 2038; month = 1; day = 1 }
+
+  let rec random_2038 () =
+    let d = random () in
+    if d < date_1970_01_01 || d >= date_2038_01_01 then random_2038 ()
+    else d
+
   let make_day_shifts days_of_month =
     let a = Array.create 12 0 in
     let rec make sum = function
     | -1 -> - (diff' t2 t1)
     | _ -> assert false
 
-  let day_1970_01_01 = { year = 1970; month = 1; day = 1 }
-
   let wday t = 
     (* 1970/01/01 is Thurdsday 
        Sunday : 0
        Fri : 5
        Sat : 6
     *)
-    (diff t day_1970_01_01 + 4) mod 7
+    (diff t date_1970_01_01 + 4) mod 7
  
   TEST "to_string" =
     "2000-04-01" = to_string { year = 2000; month = 4; day = 1 }
         min = Random.int 60;
         sec = Random.int 61
       }
+
+  let seconds_of_a_day = 86400. (* 24 * 60 * 60 *)
+
+  let dsec t = 
+    let open Overload.Float in
+    float t.hour * 3600. + float t.min * 60. + float t.sec
 end
 
 module TZone = struct
     | `Minus (0,0) -> false
     | `Plus (h, m) | `Minus (h, m) -> 0 <= h && h < 24 && 0 <= m && m < 60
 
+  let in_secs = 
+    let open Overload.Float in
+    function
+      | `UTC -> 0.0
+      | `Plus (h, m) -> float h * 3600. + float m * 60.
+      | `Minus (h, m) -> float h * (-3600.) + float m * (-60.)
+
   let rec random () = 
     let r = Random.int 25 in
     if r = 24 then `UTC
       else `Minus (r, min)
 end
 
-module Datetime = struct
-  type t = {
-    date : Date.t;
-    time : Time.t;
-    zone : TZone.t
-  }
-
-  let to_string t = Printf.sprintf "%sT%s%s"
-    (Date.to_string t.date)
-    (Time.to_string t.time)
-    (TZone.to_string t.zone)
-
-  let is_valid t = 
-    Date.is_valid t.date 
-    && Time.is_valid t.time
-    && TZone.is_valid t.zone
-
-  exception Parse_error
-
-  let of_string_exn s = 
-    try 
-      let lexbuf = Lexing.from_string s in
-      let date = Temporal_lexer.parse_date lexbuf in
-      let () = Temporal_lexer.parse_t lexbuf in
-      let time = Temporal_lexer.parse_time lexbuf in
-      let zone = Temporal_lexer.parse_tzone lexbuf in
-      (* There may be some garbage in lexbuf *)
-      if String.length s <> Lexing.lexeme_end lexbuf then raise Parse_error;
-      let res = { date; time; zone } in
-      if not & is_valid res then raise Parse_error;
-      res
-    with _ -> raise Parse_error
-  
-  let of_string s = Result.catch_exn & fun () -> of_string_exn s
-
-  let random () = { date = Date.random ();
-                    time = Time.random ();
-                    zone = TZone.random () }
-
-  TEST_UNIT "parse" =
-    for _i = 0 to 100000 do
-      let t = random () in
-      let s = to_string t in
-      if of_string s <> `Ok t then begin
-        prerr_endline s;
-        assert false
-      end
-    done
-end
-
 module Unix0 = Unix
 
 module Unix = struct
     in
     f, tm', if invalid then `Invalid else `Ok
   
-  let to_tm t = Option.catch_exn (fun () -> to_tm t) 
+  let tm_of_date t = Option.catch_exn (fun () -> to_tm t) 
 
-  let of_tm tm = 
+  let date_of_tm tm = 
     { year  = tm.tm_year + 1900;
       month = tm.tm_mon + 1;
       day   = tm.tm_mday }
 
-  (* CR jfuruse: Check the standard *)      
+  (* As UTC time *)
   let string_of_tm tm = 
     Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
       (tm.tm_year + 1900)
   TEST_UNIT "Date.Unix" = 
     let open Unix in
     let t = Result.from_Ok (fun _ -> assert false) & of_string "2000-04-01" in
-    let _, tm, inv = Option.from_Some & to_tm t in
+    let _, tm, inv = Option.from_Some & tm_of_date t in
     assert ((tm.tm_year, tm.tm_mon, tm.tm_mday, inv) = (2000 - 1900, 4 - 1, 1, `Ok))
 
 end
 
+module Datetime = struct
+  type t = {
+    date : Date.t;
+    time : Time.t;
+    zone : TZone.t
+  }
+
+  let to_string t = Printf.sprintf "%sT%s%s"
+    (Date.to_string t.date)
+    (Time.to_string t.time)
+    (TZone.to_string t.zone)
+
+  let is_valid t = 
+    Date.is_valid t.date 
+    && Time.is_valid t.time
+    && TZone.is_valid t.zone
+
+  let random () = { date = Date.random ();
+                    time = Time.random ();
+                    zone = TZone.random () }
+
+  let random_2038 () = { date = Date.random_2038 ();
+                         time = Time.random ();
+                         zone = TZone.random () }
+
+  exception Parse_error
+
+  let of_string_exn s = 
+    try 
+      let lexbuf = Lexing.from_string s in
+      let date = Temporal_lexer.parse_date lexbuf in
+      let () = Temporal_lexer.parse_t lexbuf in
+      let time = Temporal_lexer.parse_time lexbuf in
+      let zone = Temporal_lexer.parse_tzone lexbuf in
+      (* There may be some garbage in lexbuf *)
+      if String.length s <> Lexing.lexeme_end lexbuf then raise Parse_error;
+      let res = { date; time; zone } in
+      if not & is_valid res then raise Parse_error;
+      res
+    with _ -> raise Parse_error
+  
+  let of_string s = Result.catch_exn & fun () -> of_string_exn s
+
+  TEST_UNIT "parse" =
+    for _i = 0 to 100000 do
+      let t = random () in
+      let s = to_string t in
+      if of_string s <> `Ok t then begin
+        prerr_endline s;
+        assert false
+      end
+    done
+
+  let epoch t =
+    (* Seconds from 1970-01-01T00:00:00Z
+       No leap second need to be counted.
+    *)
+    let open Overload.Float in
+    let diff_days = float & Date.diff t.date Date.date_1970_01_01 in
+    diff_days * Time.seconds_of_a_day
+    + Time.dsec t.time
+    + TZone.in_secs t.zone
+
+  TEST_UNIT "epoch GMT" =
+    for _i = 0 to 100000 do
+      let dt = 
+        let rec random () = 
+          let dt = random_2038 () in
+          (* Avoid EOD, since its is computed back to D+1:00:00:00 *)
+          if dt.time = { Time.hour = 24; min = 0; sec = 0 } then random ()
+          (* Avoid leap second, since its is computed back to +1min *)
+          else if dt.time.Time.sec = 60 then random ()
+          else dt
+        in
+        random ()
+      in
+      let dt = { dt with zone = `UTC } in
+      let secs = epoch dt in
+      let tm = Unix0.gmtime secs in
+      let dt' = { date = Unix.date_of_tm tm;
+                  time = { Time.hour = tm.Unix0.tm_hour;
+                           min  = tm.Unix0.tm_min;
+                           sec  = tm.Unix0.tm_sec };
+                  zone = `UTC } 
+      in
+      if dt <> dt' then begin
+        Format.eprintf "%s <> %s@." (to_string dt) (to_string dt');
+        assert false
+      end
+    done
+end
+
 module Fat = struct
 
   let int64_of_float f = 
       t.epoch
       (Unix.string_of_tm t.tm)
 
-  let create date = 
-    match Unix.to_tm date with
+  let _create date = 
+    match Unix.tm_of_date date with
     | None -> `Error (`Invalid_date date)
     | Some (epoch, tm, mal) ->
         match mal with
 
   let rec random () = 
     let d = Date.random_with_invalid () in
-    match Unix.to_tm d with
+    match Unix.tm_of_date d with
     | Some (f, tm, `Ok) -> { date = d; epoch = f; tm }
     | Some (_, _, `Invalid) -> random ()
     | None -> random ()

File lib/temporal.mli

   val days_of_year : int -> int 
 end
 
+module Weekday : sig
+  val to_string : int -> string
+  (* 0:Sun, 1:Mon, ... *)
+end
+
 module Date : sig
 
   type t = {
     month : int; (* 1-12 *)
     day   : int
   }
-  
+  (** Comparison should work correctly between valid dates *)
+   
   val to_string : t -> string
   (** Prints [t] in ISO8601's YYYY-MM-DD format *)
   
   (** Random value generator which may contain invalids like 2000/02/31 *)
   
   val random : unit -> t
-  (** Random value generator with valid dates from 1900/01/01 to 2100/12/31.
+  (** Random value generator with valid dates from 1900-01-01 to 2099-12-31.
       For checking more boudnary conditions, 1,28,29,30 and 31 are chosen
       more frequently as days than the others. 
    *)
+
+  val random_2038 : unit -> t
+  (** Same as [random] but culled so that the values are between
+      1970-01-01 and 2037-12-31 
+  *)
 end
 
 module Time : sig
+
   type t = {
     hour : int; (* 00-24, 24 is only for 24:00:00 *)
     min  : int; (* 00-59 *)
     sec  : int; (* 00-60, 60 is for leap second *)
   }
+  (** Time. Comparison should work for valid values. *)
 
   val to_string : t -> string
   val is_valid : t -> bool
   exception Parse_error
   val of_string_exn : string -> t
   val of_string : string -> [> (t, exn) Result.t ]
+    
+  val seconds_of_a_day : float (* 86400 = 24 * 60 * 60 *)
+
+  val dsec : t -> float
+  (** Seconds from the 00:00:00 of the same day.
+      Named from tm_wday tm_yday *)
 
   val random : unit -> t
   (** it may return 24:00:00 or hh:mm:60, in addition to the normal times *)
 end
 
 module TZone : sig
-  type t = [ `Minus of int * int | `Plus of int * int | `UTC ]
+  type t = [ `Minus of int * int  (* hour, min *)
+           | `Plus of int * int   (* hour, min *)
+           | `UTC ]
+  (** [`UTC] and [`Plus (0,0)] are the same.
+      [`Minus (0,0)] is invalid. 
+  *)
+
   val to_string : [< t ] -> string
   val is_valid : t -> bool
 
 
 module Datetime : sig
   type t = { date : Date.t; time : Time.t; zone : TZone.t; }
+
   val to_string : t -> string
   exception Parse_error
   val of_string_exn : string -> t
   val of_string : string -> [> (t, exn) Result.t ]
   val is_valid : t -> bool
+
+  val random : unit -> t
+
+  val epoch : t -> float
+  (** Seconds from 1970-01-01T00:00:00Z. No leap seconds included.
+
+      Note that the epoch of EOD and the epoch of D+1T00:00:00 are the same,
+      but they are different [t]s.
+ *)
 end
 
-(* CR jfuruse: currently not very useful. Only used internal testing *)
 module Unix : sig
-  val to_tm : Date.t -> (float * Unix.tm * [> `Invalid | `Ok ]) option
-  (** Performs Unix sys call, and normalize the date.
-      So it is a bit costy.
-
-      The last component indicates whether the input is invalid
-      (normalization was necessary) or not.
-      Since it uses Unix time, Year is only acceptable between 1970-2037.
-
-      Epoch is computed from the localtime. Be careful. 
-      For example, Singapore has very complex history of timezone.
-  *)
-  
-  val of_tm : Unix.tm -> Date.t 
-
-  val string_of_tm : Unix.tm -> string
-  (** Prints time in ISO8601's YYYY-MM-DDThh:mm:ssZ format. The zone is fixed to UTC *)    
+  val date_of_tm : Unix.tm -> Date.t
 end
-
-(* CR jfuruse: currently not very useful. Only used internal testing *)
-module Fat : sig
-  type t (** combination of [Date.t] and [Unix.tm]. *)
-  val create : Date.t -> [> (t,  [> `Invalid_date of Date.t ]) Result.t ]
-  val random : unit -> t
-end
-