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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
let date_p : (Date.t, unit) MParser.t =
let open MParser in
let open Parser_components in
nat_zero
>>= fun year ->
char '-'
>> max_two_digit_nat_zero
>>= fun month ->
char '-'
>> max_two_digit_nat_zero
>>= fun day ->
match Date.Ymd_date.make ~year ~month ~day with
| Ok x -> return x
| Error e ->
fail
(Printf.sprintf "Invalid date: %s"
(Date_time.Ymd_date_time.string_of_error
(e :> Date_time.Ymd_date_time.error)))
let hm_p : (int * int, unit) MParser.t =
let open MParser in
let open Parser_components in
choice
[
attempt
(two_digit_nat_zero
>>= fun hour ->
optional (char ':')
>> two_digit_nat_zero
>>= fun minute -> return (hour, minute));
(two_digit_nat_zero >>= fun hour -> return (hour, 0));
]
let time_p : (Time.t, unit) MParser.t =
let open MParser in
let open Parser_components in
let hms_p =
choice
[
attempt
(two_digit_nat_zero
>>= fun hour ->
optional (char ':')
>> two_digit_nat_zero
>>= fun minute ->
optional (char ':')
>> two_digit_nat_zero
>>= fun second ->
choice [ char '.'; char ',' ]
>> num_string
>>= fun s ->
let s = if String.length s > 9 then String.sub s 0 9 else s in
let len = String.length s in
if len = 9 then return (hour, minute, second, int_of_string s)
else
let diff = 9 - len in
let ns =
int_of_float
@@ CCFloat.round
@@ (float_of_int (int_of_string s) *. (10. ** float_of_int diff))
in
return (hour, minute, second, ns));
attempt
(two_digit_nat_zero
>>= fun hour ->
optional (char ':')
>> two_digit_nat_zero
>>= fun minute ->
optional (char ':')
>> two_digit_nat_zero
>>= fun second -> return (hour, minute, second, 0));
(hm_p |>> fun (hour, minute) -> (hour, minute, 0, 0));
]
in
hms_p
>>= fun (hour, minute, second, ns) ->
match Time.make ~hour ~minute ~second ~ns () with
| Ok x -> return x
| Error e ->
fail
(Printf.sprintf "Invalid time: %s"
(Date_time.Ymd_date_time.string_of_error
(e :> Date_time.Ymd_date_time.error)))
let offset_p : (Span.t, unit) MParser.t =
let open MParser in
char 'Z'
>>$ Span.zero
<|> (char '+'
>>$ `Pos
<|> (char '-' >>$ `Neg)
>>= fun sign ->
hm_p
|>> fun (hour, minute) ->
Span.For_human'.make_exn ~sign ~hours:hour ~minutes:minute ())
type maybe_zoneless =
[ `Zoned of Date_time.t
| `Zoneless of Date_time.Zoneless'.zoneless
]
let to_maybe_zoneless s : (maybe_zoneless, string) result =
let open MParser in
let open Parser_components in
let p =
date_p
>>= fun date ->
any_char
>> time_p
>>= fun time ->
attempt (offset_p << spaces << eof)
>>= (fun offset ->
match
Date_time.Zoneless'.to_zoned_unambiguous ~offset_from_utc:offset
(Date_time.Zoneless'.make date time)
with
| Error e ->
fail
(Printf.sprintf "Invalid date time: %s"
(Date_time.Ymd_date_time.string_of_error
(e :> Date_time.Ymd_date_time.error)))
| Ok x -> return (`Zoned x))
<|> (spaces
>> eof
>> return (`Zoneless (Date_time.Zoneless'.make date time)))
in
parse_string p s () |> result_of_mparser_result
let to_zoneless s : (Date_time.Zoneless'.zoneless, string) result =
match to_maybe_zoneless s with
| Ok (`Zoneless x) -> Ok x
| Ok (`Zoned _) -> Error "Extraneous offset from utc"
| Error msg -> Error msg
let to_date_time s : (Date_time.t, string) result =
match to_maybe_zoneless s with
| Ok (`Zoneless _) -> Error "Missing offset from utc"
| Ok (`Zoned x) -> Ok x
| Error msg -> Error msg
let to_timestamp s =
match to_date_time s with
| Ok dt -> Ok (Date_time.to_timestamp_single dt)
| Error msg -> Error msg