Commits

camlspotter committed 28ad893

added String.{find_with_pos_opt,split1}

  • Participants
  • Parent commits 24e3d36
  • Branches release-2.4.0

Comments (0)

Files changed (5)

-2.4.0 (not yet)
+2.4.1
+---------------
+
+* Temporal.Date.yday now returns 0--365, not 1--366!
+
+2.4.0
 ---------------
 
 - Added Option.iter

File lib/temporal.ml

   end)
 
   let to_string t = Printf.sprintf "%04d-%02d-%02d" t.year t.month t.day
+
+  TEST "to_string" =
+    "2000-04-01" = to_string { year = 2000; month = 4; day = 1 }
   
   exception Parse_error
   
   
   let of_string s = Result.catch_exn & fun () -> of_string_exn s
   
+  TEST "of_string" =
+    of_string "2000-04-01" = `Ok { year = 2000; month = 4; day = 1 }
+  
+  TEST "of_string" =
+    match of_string "2000-04-01-" with
+    | `Ok _ -> false
+    | `Error _ -> true
+
   let random_with_invalid () =
     { year = Random.int 200 + 1900;
       month = Random.int 12 + 1;
     else days_of_month_in_non_leap_year
 
   let is_valid t = 
-    if t.year < 1900 || t.year > 2100 then false
+    if t.year < 1583 || t.year > 2100 then false
     else if t.month < 1 || t.month > 12 then false
     else
       let dom =(days_of_month t.year).(t.month-1) in
     else d
 
   let make_day_shifts days_of_month =
-    let a = Array.create 12 0 in
-    let rec make sum = function
+    let a = Array.create 13 0 in (* it also has the shift of the next January *)
+    let rec make sum n = 
+      a.(n) <- sum;
+      match n with
       | 12 -> ()
-      | n -> 
-          a.(n) <- sum;
-          make (sum + days_of_month.(n)) (n+1)
+      | n -> make (sum + days_of_month.(n)) (n+1)
     in
     make 0 0;
     a
   let day_shifts_in_non_leap_year = make_day_shifts days_of_month_in_non_leap_year
   let day_shifts_in_leap_year = make_day_shifts days_of_month_in_leap_year
 
-  (* day of the year 1--365 or 366. Named from tm_yday *)
+  let day_shifts_of_year year = 
+    if Year.is_leap year then day_shifts_in_leap_year
+    else day_shifts_in_non_leap_year
+
+  (* day of the year 0--364 or 365. Named from tm_yday *)
   let yday t =
-    let day_shifts = 
-      if Year.is_leap t.year then day_shifts_in_leap_year
-      else day_shifts_in_non_leap_year
+    let day_shifts = day_shifts_of_year t.year in
+    day_shifts.(t.month-1) + t.day - 1
+
+  TEST "yday" = 
+        let x = yday (of_string_exn "2013-01-01") in
+        if x <> 0 then Exn.failwithf "yday 2013-01-01 = %d" x;
+        true
+
+  TEST "yday" = 
+        yday (of_string_exn "2013-12-31") = 364
+
+  let of_yday ~year yday =
+    if yday < 0 || yday >= Year.days_of_year year then invalid_arg "of_day: yday out of range"; 
+    let day_shifts = day_shifts_of_year year in
+    (* rough guess of month *)
+    let m0 = min (yday / 30 + 1) 12 (* dec *) in
+    let rec loop m =
+      let m' = m - 1 in
+      if yday < day_shifts.(m') then loop (m-1) 
+      else if day_shifts.(m'+1) <= yday then loop (m+1)
+      else { year; month=m; day= yday - day_shifts.(m') + 1 }
     in
-    day_shifts.(t.month-1) + t.day
+    loop m0
+
+  TEST "of_yday" = 
+        of_yday ~year:1984 224 = (Result.from_Ok & of_string "1984-08-12") 
+
+  let add t days =
+    let y = t.year in
+    let days = yday t + days in
+    let rec normalize y days =
+      if y < 1583 then invalid_arg "add: y < 1583"; (* We should not return dates before the introduction of Calendario gregoriano *)
+      let ydays = Year.days_of_year y in
+      if days < 0 then normalize (y-1) (days + Year.days_of_year (y-1))
+      else if ydays <= days then normalize (y+1) (days - ydays)
+      else (y, days)
+    in
+    let y, ydays = normalize y days in
+    of_yday ~year:y ydays
 
   let diff t1 t2 =
     let diff' tgt tlt =
     | -1 -> - (diff' t2 t1)
     | _ -> assert false
 
+  TEST "diff" = 
+    diff 
+      (Result.from_Ok & of_string "2036-01-01")
+      (Result.from_Ok & of_string "2036-04-01") 
+    = -91
+
+  TEST "diff" = 
+    diff 
+      (Result.from_Ok & of_string "2013-01-01")
+      (Result.from_Ok & of_string "2012-01-01") 
+    = 366
+
+  TEST "diff" = 
+    diff 
+      (Result.from_Ok & of_string "2013-06-01")
+      (Result.from_Ok & of_string "2012-01-31") 
+    = 366 - 31 + 31 + 28 + 31 + 30 + 31 + 1
+
+  TEST "diff+add" =
+    (* add and diff are implemented independenly, so good to test together *)
+    let test_diff_add date1 date2 = 
+      let d = diff date2 date1 in
+      let date2' = add date1 d in
+      let res = date2 = date2' in
+      if not res then Exn.failwithf "test_diff_add fails for %s and %s. (diff=%d, date2'=%s)" (to_string date1) (to_string date2) d (to_string date2')
+    in
+    for _i = 0 to 10000 do
+      let date1 = random_2038 () in
+      let date2 = random_2038 () in
+      test_diff_add date1 date2
+    done;
+    true
+
   let wday t = 
     (* 1970/01/01 is Thurdsday 
        Sunday : 0
     *)
     (diff t date_1970_01_01 + 4) mod 7
  
-  TEST "to_string" =
-    "2000-04-01" = to_string { year = 2000; month = 4; day = 1 }
-  
-  TEST "of_string" =
-    of_string "2000-04-01" = `Ok { year = 2000; month = 4; day = 1 }
-  
-  TEST "of_string" =
-    match of_string "2000-04-01-" with
-    | `Ok _ -> false
-    | `Error _ -> true
-
-  TEST "diff" = 
-    diff 
-      (Result.from_Ok & of_string "2013-06-01")
-      (Result.from_Ok & of_string "2012-01-31") 
-    = 366 - 31 + 31 + 28 + 31 + 30 + 31 + 1
 end
 
 module Time = struct

File lib/temporal.mli

 module Date : sig
 
   type t = {
-    year  : int;  (* 1998 *)
-    month : int; (* 1-12 *)
-    day   : int
+    year  : int;  (** 1998 *)
+    month : int;  (** 1-12 *)
+    day   : int   (** 1-31 *)
   }
   (** Comparison should work correctly between valid dates *)
 
 
   val to_string : t -> string
   (** Prints [t] in ISO8601's YYYY-MM-DD format *)
-  
+
   exception Parse_error
   
   val of_string_exn : string -> t
   val of_string : string -> [> (t, exn) Result.t ]
   (** Parses string of ISO8601's YYYY-MM-DD format *)
   
+  val date_1970_01_01 : t
+  (** The first day of Unix time *)
+
   val yday : t -> int
-  (** 1--365 or 366 *)
-  
+  (** 0--364 or 365 *)
+
+  val of_yday : year:int -> int -> t
+
   val wday : t -> int
-  (** 0--6, 0 is Sunday *)
+  (** 0--6, 0 is Sunday. This uses [diff t date_1970_01_01], so can be slow. *)
   
   val diff : t -> t -> int
-  
+
+  val add : t -> int -> t
+  (** [add t days]. [days] can be negative. Error if the result is a date before year 1583. *)
+
   val random_with_invalid : unit -> t
   (** Random value generator which may contain invalids like 2000/02/31 *)
   

File lib/xstring.ml

 TEST "split" = 
         split (function ' ' -> true | _ -> false) " hello  world " = ["hello"; "world"]
 
+let find_with_pos_opt ?(from=0) f str =
+  let len = length str in
+  let rec loop pos =
+    if pos >= len then None
+    else 
+      let c = unsafe_get str pos in
+      if f c then Some (c, pos)
+      else loop (pos+1)
+  in
+  loop from
+
+let split1 ?from f str =
+  match find_with_pos_opt ?from f str with
+  | None -> None
+  | Some (_,pos) -> Some (sub str 0 pos, sub str (pos+1) (length str - pos - 1))
+
+TEST "Xstring.split1" = 
+    split1 (function ' ' -> true | _ -> false) "hello world yeah" = Some ("hello", "world yeah")
+;;
+
 let make1 = String.make 1
 
 module Set = Xset.Make(struct type t = string let compare (x:string) y = compare x y end)

File lib/xstring.mli

 val is_space_or_tab : char -> bool
 val is_newline_or_return : char -> bool
 
+val find_with_pos_opt : ?from: int -> (char -> bool) -> string -> (char * int) option
+(** [find_with_pos_opt ~from p s] finds the first char from the position [from]
+    which fulfill the predicate [p] *)
+ 
+val split1 : ?from:int -> (char -> bool) -> string -> (string * string) option
+(** [split1 ~from p s] splits [s] at the first char from the position [from]
+    which fulfill the predicate [p]. The found character is not contained
+    in the result. If there is no such char found, the function returns [None].
+    
+    [split1 (function ' ' -> true | _ -> false) "hello world year" = Some ("hello", "world year")]
+*)
+
 val make1 : char -> string
 (** [make1 = String.make 1] *)