1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
module Lexer = ISO8601_lexer
module Permissive = struct
let date_lex lexbuf = Lexer.date lexbuf
let time_tz_lex lexbuf =
let t = Lexer.time lexbuf in
let tz = Lexer.timezone lexbuf in
let t = match tz with None -> t | Some o -> t -. o in
(t, tz)
let datetime_tz_lex ?(reqtime=true) lexbuf =
let d = date_lex lexbuf in
match Lexer.delim lexbuf with
| None -> if reqtime then assert false else (d, None)
| Some _ -> let (t, tz) = time_tz_lex lexbuf in
(d +. t, tz)
let time_lex lexbuf =
fst (time_tz_lex lexbuf)
let datetime_lex ?(reqtime=true) lexbuf =
fst (datetime_tz_lex ~reqtime:reqtime lexbuf)
let date s = date_lex (Lexing.from_string s)
let time s = time_lex (Lexing.from_string s)
let time_tz s = time_tz_lex (Lexing.from_string s)
let datetime_tz ?(reqtime=true) s =
datetime_tz_lex ~reqtime:reqtime (Lexing.from_string s)
let datetime ?(reqtime=true) s =
datetime_lex ~reqtime:reqtime (Lexing.from_string s)
(* FIXME: possible loss of precision. *)
let pp_format fmt format x tz =
let open Unix in
let open Format in
(* Be careful, do not forget to print timezone if there is one,
* or information printed will be wrong. *)
let x = gmtime (x -. tz) in
let conversion =
let pad2 = fprintf fmt "%02d" in
let pad4 = fprintf fmt "%04d" in
function
(* Date *)
| 'Y' -> pad4 (x.tm_year + 1900)
| 'M' -> pad2 (x.tm_mon + 1)
| 'D' -> pad2 x.tm_mday
(* Time *)
| 'h' -> pad2 x.tm_hour
| 'm' -> pad2 x.tm_min
| 's' -> pad2 x.tm_sec
(* Timezone *)
| 'Z' -> fprintf fmt "%0+3.0f" (tz /. 3600.) (* Hours *)
| 'z' -> fprintf fmt "%02.0f" (mod_float (abs_float (tz /. 60.)) 60.0) (* Minutes *)
| '%' -> pp_print_char fmt '%'
| c -> failwith ("Bad format: %" ^ String.make 1 c)
in
let len = String.length format in
let rec parse_format i =
if i = len then ()
else match String.get format i with
| '%' -> conversion (String.get format (i + 1)) ;
parse_format (i + 2)
| c -> pp_print_char fmt c ;
parse_format (i + 1) in
parse_format 0
let pp_date fmt x = pp_format fmt "%Y-%M-%D" x 0.
let pp_time fmt x = pp_format fmt "%h:%m:%s" x 0.
let pp_datetime fmt x = pp_format fmt "%Y-%M-%DT%h:%m:%s" x 0.
let pp_datetimezone fmt (x, tz) =
pp_format fmt "%Y-%M-%DT%h:%m:%s%Z:%z" x tz
let pp_date_basic fmt x = pp_format fmt "%Y%M%D" x 0.
let pp_time_basic fmt x = pp_format fmt "%h%m%s" x 0.
let pp_datetime_basic fmt x = pp_format fmt "%Y%M%DT%h%m%s" x 0.
let pp_datetimezone_basic fmt (x, tz) =
pp_format fmt "%Y%M%DT%h%m%s%Z%z" x tz
let string_of_aux printer x =
ignore (Format.flush_str_formatter ()) ;
printer Format.str_formatter x ;
Format.flush_str_formatter ()
let string_of_date = string_of_aux pp_date
let string_of_time = string_of_aux pp_time
let string_of_datetime = string_of_aux pp_datetime
let string_of_datetimezone = string_of_aux pp_datetimezone
let string_of_date_basic = string_of_aux pp_date_basic
let string_of_time_basic = string_of_aux pp_time_basic
let string_of_datetime_basic = string_of_aux pp_datetime_basic
let string_of_datetimezone_basic = string_of_aux pp_datetimezone_basic
end