forked from
jonmsterling.com/ocaml-forester
ocaml
write a rudimentary datetime library
+252
-1
+11
lib/human_datetime/Forester_human_datetime.ml
+11
lib/human_datetime/Forester_human_datetime.ml
+53
lib/human_datetime/Grammar.mly
+53
lib/human_datetime/Grammar.mly
···
1
+
%{ open Types %}
2
+
3
+
%token <char> DIGIT
4
+
%token VOID COLON HYPHEN T Z PLUS EOF
5
+
6
+
%start <datetime> datetime
7
+
8
+
%%
9
+
10
+
let void :=
11
+
| VOID; { failwith "Impossible" }
12
+
13
+
let xxxx ==
14
+
| x0 = DIGIT; x1 = DIGIT; x2 = DIGIT; x3 = DIGIT; {
15
+
int_of_string @@ Format.sprintf "%c%c%c%c" x0 x1 x2 x3
16
+
}
17
+
18
+
let xx ==
19
+
| x0 = DIGIT; x1 = DIGIT; {
20
+
int_of_string @@ Format.sprintf "%c%c" x0 x1
21
+
}
22
+
23
+
let second :=
24
+
| ~ = xx; <Second>
25
+
26
+
let minute(rest) :=
27
+
| ~ = xx; ~ = option(preceded(COLON, rest)); <Minute>
28
+
29
+
let hour(rest) :=
30
+
| ~ = xx; ~ = option(preceded(COLON, rest)); <Hour>
31
+
32
+
let pm :=
33
+
| HYPHEN; {Minus}
34
+
| PLUS; {Plus}
35
+
36
+
let offset :=
37
+
| Z; {Z}
38
+
| ~ = pm; ~ = hour(minute(void)); <Offset>
39
+
40
+
let time_with_offset :=
41
+
| ~ = hour(minute(second)); ~ = offset; <>
42
+
43
+
let day :=
44
+
| ~ = xx; ~ = option(preceded(T, time_with_offset)); <Day>
45
+
46
+
let month :=
47
+
| ~ = xx; ~ = option(preceded(HYPHEN, day)); <Month>
48
+
49
+
let year :=
50
+
| ~ = xxxx; ~ = option(preceded(HYPHEN, month)); <Year>
51
+
52
+
let datetime :=
53
+
| ~ = year; EOF; <>
+16
lib/human_datetime/Lexer.mll
+16
lib/human_datetime/Lexer.mll
···
1
+
let digit = ['0'-'9']
2
+
let colon = ':'
3
+
let hyphen = '-'
4
+
let plus = '+'
5
+
let hyphen = '-'
6
+
7
+
rule token = parse
8
+
| digit as d { Grammar.DIGIT d }
9
+
| colon { Grammar.COLON }
10
+
| hyphen { Grammar.HYPHEN }
11
+
| plus { Grammar.PLUS }
12
+
| 'T' { Grammar.T }
13
+
| 'Z' { Grammar.Z }
14
+
| eof { Grammar.EOF }
15
+
16
+
| _ { failwith @@ Format.sprintf "Unexpected lexeme: %s" (Lexing.lexeme lexbuf) }
+157
lib/human_datetime/Types.ml
+157
lib/human_datetime/Types.ml
···
1
+
type void = |
2
+
3
+
type second = Second of int
4
+
type 'a minute = Minute of int * 'a option
5
+
type 'a hour = Hour of int * 'a option
6
+
7
+
type pm = Plus | Minus
8
+
type offset = Z | Offset of pm * void minute hour
9
+
10
+
type time_with_offset = second minute hour * offset
11
+
12
+
type day = Day of int * time_with_offset option
13
+
type month = Month of int * day option
14
+
type year = Year of int * month option
15
+
16
+
type datetime = year
17
+
18
+
let pp_void _fmt (x : void) =
19
+
match x with
20
+
| _ -> .
21
+
22
+
let pp_second fmt (Second s) =
23
+
Format.fprintf fmt "%02d" s
24
+
25
+
let pp_minute pp_rest fmt (Minute (m, rest_opt)) =
26
+
Format.fprintf fmt "%02d" m;
27
+
match rest_opt with
28
+
| None -> ()
29
+
| Some rest ->
30
+
Format.fprintf fmt ":%a" pp_rest rest
31
+
32
+
let pp_hour pp_rest fmt (Hour (h, rest_opt)) =
33
+
Format.fprintf fmt "%02d" h;
34
+
match rest_opt with
35
+
| None -> ()
36
+
| Some rest ->
37
+
Format.fprintf fmt ":%a" pp_rest rest
38
+
39
+
let pp_pm fmt = function
40
+
| Plus -> Format.fprintf fmt "+"
41
+
| Minus -> Format.fprintf fmt "-"
42
+
43
+
let pp_offset fmt = function
44
+
| Z -> Format.fprintf fmt "Z"
45
+
| Offset (pm, hm) ->
46
+
pp_pm fmt pm;
47
+
pp_hour (pp_minute pp_void) fmt hm
48
+
49
+
let pp_time_with_offset fmt (hms, offset) =
50
+
pp_hour (pp_minute pp_second) fmt hms;
51
+
pp_offset fmt offset
52
+
53
+
let pp_day fmt (Day (d, time_with_offset_opt)) =
54
+
Format.fprintf fmt "%02d" d;
55
+
match time_with_offset_opt with
56
+
| None -> ()
57
+
| Some time_with_offset ->
58
+
Format.fprintf fmt "T%a" pp_time_with_offset time_with_offset
59
+
60
+
let pp_month fmt (Month (m, day_opt)) =
61
+
Format.fprintf fmt "%02d" m;
62
+
match day_opt with
63
+
| None -> ()
64
+
| Some day ->
65
+
Format.fprintf fmt "-%a" pp_day day
66
+
67
+
let pp_year fmt (Year (y, month_opt)) =
68
+
Format.fprintf fmt "%04d" y;
69
+
match month_opt with
70
+
| None -> ()
71
+
| Some month ->
72
+
Format.fprintf fmt "-%a" pp_month month
73
+
74
+
let pp_datetime = pp_year
75
+
76
+
type ptime_time_state = {
77
+
mutable hour: int;
78
+
mutable minute: int;
79
+
mutable second: int
80
+
}
81
+
82
+
type ptime_date_state = {
83
+
mutable year: int;
84
+
mutable month: int;
85
+
mutable day: int
86
+
}
87
+
88
+
let ptime_time_state_to_seconds state =
89
+
state.second + 60 * (state.minute + 60 * state.hour)
90
+
91
+
type ptime_date_time_state = {
92
+
date: ptime_date_state;
93
+
time: ptime_time_state;
94
+
mutable tz_offset_s: int
95
+
}
96
+
97
+
let init_ptime_time_state () =
98
+
{ hour = 0; minute = 0; second = 0 }
99
+
100
+
let init_ptime_date_state () =
101
+
{ year = 0; month = 1; day = 1 }
102
+
103
+
let init_ptime_date_time_state () =
104
+
{
105
+
date = init_ptime_date_state ();
106
+
time = init_ptime_time_state ();
107
+
tz_offset_s = 0
108
+
}
109
+
110
+
let to_ptime datetime =
111
+
let go_void (x : void) = match x with _ -> . in
112
+
let go_second state (Second s) =
113
+
state.second <- s
114
+
in
115
+
let go_minute state rest (Minute (m, rest_opt)) =
116
+
state.minute <- m;
117
+
Option.iter rest rest_opt
118
+
in
119
+
let go_hour state rest (Hour (h, rest_opt)) =
120
+
state.hour <- h;
121
+
Option.iter rest rest_opt
122
+
in
123
+
let go_offset state = function
124
+
| Z -> state.tz_offset_s <- 0
125
+
| Offset (pm, time) ->
126
+
let time_state = init_ptime_time_state () in
127
+
go_hour time_state (go_minute time_state go_void) time;
128
+
let offset = ptime_time_state_to_seconds time_state in
129
+
let sign =
130
+
match pm with
131
+
| Plus -> 1
132
+
| Minus -> -1
133
+
in
134
+
state.tz_offset_s <- sign * offset
135
+
in
136
+
let go_time_with_offset state ((time, offset) : time_with_offset) =
137
+
go_hour state.time (go_minute state.time (go_second state.time)) time;
138
+
go_offset state offset
139
+
in
140
+
let go_day state (Day (d, time_with_offset_opt)) =
141
+
state.date.day <- d;
142
+
Option.iter (go_time_with_offset state) time_with_offset_opt
143
+
in
144
+
let go_month state (Month (m, day_opt)) =
145
+
state.date.month <- m;
146
+
Option.iter (go_day state) day_opt
147
+
in
148
+
let go_year state (Year (y, month_opt)) =
149
+
state.date.year <- y;
150
+
Option.iter (go_month state) month_opt
151
+
in
152
+
153
+
let state = init_ptime_date_time_state () in
154
+
go_year state datetime;
155
+
let date = state.date.year, state.date.month, state.date.day in
156
+
let time = ((state.time.hour, state.time.minute, state.time.second), state.tz_offset_s) in
157
+
Ptime.of_date_time (date, time)
+13
lib/human_datetime/dune
+13
lib/human_datetime/dune
+1
lib/prelude/Date.ml
+1
lib/prelude/Date.ml