let format_to buf ~fmt date =
let add_char c = Buffer.add_char buf c
and add_string s = Buffer.add_string buf s in
let fail () = invalid_arg "Parse.format_date" in
let add_digits w b n =
if n > b * 10 then fail ();
let rec aux b n =
add_char (char_of_int (48 + n / b));
if b >= 10 then aux (b / 10) (n mod b)
in
if w then
let rec aux_spaces b =
if n > b || b < 10 then aux b n
else begin add_char ' '; aux_spaces (b / 10) end
in
aux_spaces b
else aux b n
in
let wd () =
if date.week_day < 0 || date.week_day > 6 then fail (); date.week_day
in
let yd () = months_start.(date.month - 1) + date.day in
let rec do_format =
function
'a' -> add_string abbr_day_names.(date.week_day)
| 'A' -> add_string full_day_names.(date.week_day)
| 'b' | 'h' -> add_string abbr_month_names.(date.month - 1)
| 'B' -> add_string full_month_names.(date.month - 1)
| 'C' -> add_digits false 10 (date.year / 100)
| 'd' -> add_digits false 10 date.day
| 'e' -> add_digits true 10 date.day
| 'H' -> add_digits false 10 date.hour
| 'I' ->
add_digits false 10
(match date.hour mod 12 with
0 -> 12
| d -> d)
| 'j' -> add_digits false 100 (yd ())
| 'k' -> add_digits true 10 date.hour
| 'l' ->
add_digits true 10
(match date.hour mod 12 with
0 -> 12
| d -> d)
| 'm' -> add_digits false 10 date.month
| 'M' -> add_digits false 10 date.minute
| 'n' -> add_char '\n'
| 'p' -> add_string (if date.hour >= 12 then "PM" else "AM")
| 'P' -> add_string (if date.hour >= 12 then "pm" else "am")
| 'S' -> add_digits false 10 date.second
| 't' -> add_char '\t'
| 'u' ->
add_digits false 1
(match wd () with
0 -> 7
| n -> n)
| 'y' -> add_digits false 10 (date.year mod 100)
| 'Y' -> add_digits false 1000 date.year
| 'z' ->
let (s, z) =
if date.zone >= 0 then '+', date.zone else '-', - date.zone
in
add_char s;
add_digits false 10 (z / 60);
add_digits false 10 (z mod 60)
| 'U' -> add_digits false 10 ((yd () - wd () + 6) / 7)
| 'V' -> failwith "TODO"
| 'W' -> failwith "TODO"
| 'w' -> add_digits false 1 (wd ())
| '%' -> add_char '%'
| 'c' ->
do_format 'a';
add_char ' ';
do_format 'b';
add_char ' ';
do_format 'e';
add_char ' ';
do_format 'T';
add_char ' ';
do_format 'Y'
| 'D' | 'x' ->
do_format 'm';
add_char '/';
do_format 'd';
add_char '/';
do_format 'y'
| 'r' ->
do_format 'I';
add_char ':';
do_format 'M';
add_char ':';
do_format 'S';
add_char ' ';
do_format 'p'
| 'R' -> do_format 'H'; add_char ':'; do_format 'M'
| 'T' | 'X' -> do_format 'R'; add_char ':'; do_format 'S'
| _ -> fail ()
in
let rec aux i =
if i = String.length fmt then ()
else
match fmt.[i] with
'%' when i = String.length fmt - 1 -> fail ()
| '%' -> do_format fmt.[i + 1]; aux (i + 2)
| c -> add_char c; aux (i + 1)
in
try aux 0 with
_ -> fail ()