let parse str =
let tokens = tokens_of_string str in
let hour = ref None
and minute = ref None
and second = ref None
and zone = ref None
and week_day = ref None
and day = ref None
and month = ref None
and year = ref None in
let add_data ?h ?m ?s ?mdn ?tz ?dst ?wd ?md ?mo ?y () =
let may_store r =
function
None -> ()
| v when !r = None -> r := v
| _ -> invalid_arg "Parse.date"
in
let tz =
match tz, dst with
Some tz, Some true -> Some (tz - 100)
| _ -> tz
in
let tz =
match tz with
None -> None
| Some x -> Some (x mod 100 + 60 * (x / 100))
in
let h =
match h with
None -> None
| Some h ->
match mdn with
None when h >= 0 && h <= 23 -> Some h
| Some false when h > 0 && h <= 11 -> Some h
| Some false when h = 12 -> Some 0
| Some true when h > 0 && h <= 11 -> Some (h + 12)
| Some true when h = 12 -> Some 12
in
let y =
match y with
None -> None
| Some y when y >= 100 -> Some y
| Some y when y < 69 -> Some (2000 + y)
| Some y -> Some (1900 + y)
in
may_store hour h;
may_store minute m;
may_store second s;
may_store zone tz;
may_store week_day wd;
may_store day md;
may_store month mo;
may_store year y
in
let rec scan_gen (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some (Number n) -> Stream.junk strm__; scan_number n strm__
| Some (Zone tz) ->
Stream.junk strm__;
let dst =
try scan_dst strm__ with
Stream.Failure -> raise (Stream.Error "")
in
let rest = strm__ in add_data ~tz ?dst (); scan_gen rest
| Some (Day wd) ->
Stream.junk strm__;
let _ =
try scan_opt_coma strm__ with
Stream.Failure -> raise (Stream.Error "")
in
let rest = strm__ in add_data ~wd (); scan_gen rest
| Some (Month mo) ->
Stream.junk strm__;
begin match Stream.peek strm__ with
Some (Number md) -> Stream.junk strm__; scan_date_m mo md strm__
| _ -> raise (Stream.Error "")
end
| Some _ -> Stream.junk strm__; invalid_arg "Parse.date"
| _ -> ()
and scan_number n (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some (Meridian mdn) ->
Stream.junk strm__;
let rest = strm__ in add_data ~h:n ~mdn (); scan_gen rest
| Some Colon ->
Stream.junk strm__;
begin match Stream.peek strm__ with
Some (Number m) -> Stream.junk strm__; scan_hour n m strm__
| _ -> raise (Stream.Error "")
end
| Some Slash ->
Stream.junk strm__;
begin match Stream.peek strm__ with
Some (Number m) -> Stream.junk strm__; scan_date_s n m strm__
| _ -> raise (Stream.Error "")
end
| Some Minus -> Stream.junk strm__; scan_date_d n strm__
| Some (Month mo) ->
Stream.junk strm__;
let rest = strm__ in add_data ~md:n ~mo (); scan_gen rest
| _ -> let rest = strm__ in add_data ~y:n (); scan_gen rest
and scan_hour h m (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some Colon ->
Stream.junk strm__;
begin match Stream.peek strm__ with
Some (Number s) -> Stream.junk strm__; scan_hour_second h m s strm__
| _ -> raise (Stream.Error "")
end
| _ ->
match
try Some (scan_tz strm__) with
Stream.Failure -> None
with
Some tz -> let rest = strm__ in add_data ~h ~m ~tz (); scan_gen rest
| _ ->
let mdn = scan_opt_meridian strm__ in
let rest = strm__ in add_data ~h ~m ?mdn (); scan_gen rest
and scan_tz (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some Plus ->
Stream.junk strm__;
begin match Stream.peek strm__ with
Some (Number tz) -> Stream.junk strm__; tz
| _ -> raise (Stream.Error "")
end
| Some Minus ->
Stream.junk strm__;
begin match Stream.peek strm__ with
Some (Number tz) -> Stream.junk strm__; - tz
| _ -> raise (Stream.Error "")
end
| _ -> raise Stream.Failure
and scan_hour_second h m s (strm__ : _ Stream.t) =
match
try Some (scan_tz strm__) with
Stream.Failure -> None
with
Some tz -> let rest = strm__ in add_data ~h ~m ~s ~tz (); scan_gen rest
| _ ->
let mdn = scan_opt_meridian strm__ in
let rest = strm__ in add_data ~h ~m ~s ?mdn (); scan_gen rest
and scan_date_s n m (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some Slash ->
Stream.junk strm__;
begin match Stream.peek strm__ with
Some (Number p) ->
Stream.junk strm__;
let rest = strm__ in
if n >= 1000 then add_data ~y:n ~mo:m ~md:p ()
else add_data ~y:p ~mo:n ~md:m ();
scan_gen rest
| _ -> raise (Stream.Error "")
end
| _ -> let rest = strm__ in add_data ~mo:n ~md:n (); scan_gen rest
and scan_date_d n (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some (Number mo) ->
Stream.junk strm__;
begin match Stream.peek strm__ with
Some Minus ->
Stream.junk strm__;
begin match Stream.peek strm__ with
Some (Number md) ->
Stream.junk strm__;
let rest = strm__ in add_data ~y:n ~mo ~md (); scan_gen rest
| _ -> raise (Stream.Error "")
end
| _ -> raise (Stream.Error "")
end
| Some (Month mo) ->
Stream.junk strm__;
begin match Stream.peek strm__ with
Some Minus ->
Stream.junk strm__;
begin match Stream.peek strm__ with
Some (Number y) ->
Stream.junk strm__;
let rest = strm__ in add_data ~y ~mo ~md:n (); scan_gen rest
| _ -> raise (Stream.Error "")
end
| _ -> raise (Stream.Error "")
end
| _ -> raise Stream.Failure
and scan_date_m mo md (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some Comma ->
Stream.junk strm__;
begin match Stream.peek strm__ with
Some (Number y) ->
Stream.junk strm__;
let rest = strm__ in add_data ~y ~mo ~md (); scan_gen rest
| _ -> raise (Stream.Error "")
end
| _ -> let rest = strm__ in add_data ~mo ~md (); scan_gen rest
and scan_dst (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some Dst -> Stream.junk strm__; Some true
| _ -> None
and scan_opt_coma (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some Comma -> Stream.junk strm__; ()
| _ -> ()
and scan_opt_meridian (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some (Meridian mdn) -> Stream.junk strm__; Some mdn
| _ -> None
in
begin try scan_gen tokens with
Stream.Error _ -> invalid_arg "Parse.date"
end;
let may_get r =
match !r with
None -> invalid_arg "Parse.date"
| Some r -> r
in
let get_default d r =
match !r with
None -> d
| Some r -> r
in
let month = may_get month in
if month < 1 || month > 12 then invalid_arg "Parse.date";
{year = may_get year; month = month; day = may_get day;
hour = get_default 0 hour; minute = get_default 0 minute;
second = get_default 0 second; zone = get_default 0 zone;
week_day = get_default (-1) week_day}