Source file search_param.ml
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
145
146
147
148
149
150
151
152
153
154
type start =
[ `Unix_second of int64
| `Date_time of Time.Date_time.t
]
type typ =
| Time_slots of Time_slot.t list
| Years_ahead of {
start : start;
years_ahead : int;
}
type t = {
search_using_tz_offset_s : Time.tz_offset_s option;
typ : typ;
}
type error =
| Invalid_start
| Invalid_time_slots
| Invalid_search_years_ahead
| Too_far_into_future
let push_search_param_to_later_start ~(start : int64) (search_param : t) :
(t, unit) result =
match search_param.typ with
| Time_slots time_slots -> (
match Time_slots.Bound.min_start_and_max_end_exc_list time_slots with
| None -> Ok search_param
| Some (start', end_exc') ->
let start = max start' start in
let time_slots =
time_slots
|> List.to_seq
|> Time_slots.inter (Seq.return (start, end_exc'))
|> List.of_seq
in
Ok { search_param with typ = Time_slots time_slots } )
| Years_ahead { years_ahead; start = start' } -> (
match start' with
| `Unix_second start' ->
let start = max start' start in
Ok
{
search_param with
typ = Years_ahead { years_ahead; start = `Unix_second start };
}
| `Date_time start' -> (
match Time.Date_time.to_unix_second start' with
| Error () -> Error ()
| Ok start' ->
let start = max start' start in
Time.Date_time.of_unix_second
~tz_offset_s_of_date_time:search_param.search_using_tz_offset_s
start
|> Result.map (fun start ->
{
search_param with
typ =
Years_ahead { years_ahead; start = `Date_time start };
}) ) )
let start_date_time_and_search_years_ahead_of_search_param (search_param : t) :
(Time.Date_time.t * int) option =
match search_param.typ with
| Time_slots time_slots -> (
match Time_slots.Bound.min_start_and_max_end_exc_list time_slots with
| None -> None
| Some (start, end_exc) ->
let start =
Time.Date_time.of_unix_second
~tz_offset_s_of_date_time:search_param.search_using_tz_offset_s
start
|> Result.get_ok
in
let end_exc =
Time.Date_time.of_unix_second
~tz_offset_s_of_date_time:search_param.search_using_tz_offset_s
end_exc
|> Result.get_ok
in
let search_years_ahead = end_exc.year - start.year + 1 in
Some (start, search_years_ahead) )
| Years_ahead { years_ahead; start } -> (
match start with
| `Unix_second start ->
let start =
Time.Date_time.of_unix_second
~tz_offset_s_of_date_time:search_param.search_using_tz_offset_s
start
|> Result.get_ok
in
Some (start, years_ahead)
| `Date_time start -> Some (start, years_ahead) )
module Check = struct
let check_search_param (x : t) : (unit, error) result =
match x.typ with
| Time_slots time_slots ->
if
List.for_all
(fun (x, y) ->
Time_slot.Check.is_valid (x, y)
&& Time.Date_time.of_unix_second ~tz_offset_s_of_date_time:None x
|> Result.is_ok
&& Time.Date_time.of_unix_second ~tz_offset_s_of_date_time:None y
|> Result.is_ok)
time_slots
then Ok ()
else Error Invalid_time_slots
| Years_ahead { years_ahead; start } -> (
match start with
| `Unix_second start -> (
match
Time.Date_time.of_unix_second
~tz_offset_s_of_date_time:x.search_using_tz_offset_s start
with
| Error () -> Error Invalid_start
| Ok start ->
if years_ahead <= 0 then Error Invalid_search_years_ahead
else if start.year + years_ahead > Time.Date_time.max.year then
Error Too_far_into_future
else Ok () )
| `Date_time start ->
if Time.Check.date_time_is_valid start then
if years_ahead <= 0 then Error Invalid_search_years_ahead
else if start.year + years_ahead > Time.Date_time.max.year then
Error Too_far_into_future
else Ok ()
else Error Invalid_start )
end
let make_using_time_slots ?search_using_tz_offset_s
(time_slots : Time_slot.t list) : (t, error) result =
let t = { search_using_tz_offset_s; typ = Time_slots time_slots } in
match Check.check_search_param t with Ok () -> Ok t | Error e -> Error e
let make_using_years_ahead ?search_using_tz_offset_s ?(start : start option)
years_ahead : (t, error) result =
let t =
{
search_using_tz_offset_s;
typ =
Years_ahead
{
start =
Option.value
~default:(`Unix_second (Time.Current.cur_unix_second ()))
start;
years_ahead;
};
}
in
match Check.check_search_param t with Ok () -> Ok t | Error e -> Error e