blob: 4840590b82d228d9b9dea0b94f9e7deb13f92ce5 (
plain)
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
|
(*
* Copyright (C) 2020 -- 2022 Alban Gruin
*
* ucs is free software: you can redistribute it and/or modify
* it under the terms of the GNU Affero General Public License as published
* by the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* ucs is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Affero General Public License for more details.
*
* You should have received a copy of the GNU Affero General Public License
* along with ucs. If not, see <http://www.gnu.org/licenses/>.
*)
open CalendarLib
module StringSet = Set.Make (String)
let rng_bound = int_of_float (2. ** 30.) - 1
let to_date = Printer.Calendar.sprint "%Y%m%dT%H%M%S"
let current_date () = to_date @@ Calendar.now ()
let ics_split_line =
let max_line_length = 73 in
let rec aux accu str =
String.(
let l = length str in
if l > max_line_length then
let b = sub str 0 max_line_length and
e = sub str max_line_length (l - max_line_length) in
aux (accu ^ b ^ "\r\n ") e
else
accu ^ str) in
aux ""
module Event = struct
type t = {
start: Calendar.t;
stop: Calendar.t;
summary: string;
location: string option;
groups: string list;
}
let make start stop summary location groups =
{start; stop; summary; location; groups}
let to_string date event id =
let summary, location = match event.location with
| None -> "[PAS DE SALLE] " ^ event.summary, ""
| Some location -> event.summary, location in
let attendees =
List.map (fun group -> "ATTENDEE:" ^ group) event.groups
|> String.concat "\r\n" in
["BEGIN:VEVENT";
"UID:" ^ date ^ "." ^ (string_of_int id) ^ "@ucs.pa1ch.fr";
"DTSTART:" ^ to_date event.start;
"DTEND:" ^ to_date event.stop;
"DTSTAMP:" ^ date;
"SUMMARY:" ^ summary;
attendees;
"LOCATION:" ^ location;
"END:VEVENT\r\n"]
|> List.map ics_split_line
|> String.concat "\r\n"
let format_fields fn event =
fn event.summary event.groups event.start event.stop
let has_groups groups event =
List.fold_left (fun found group ->
found || List.exists ((=) group) groups) false event.groups
let get_groups event = event.groups
let has_no_locations event =
event.location = None
end
type t = Event.t list
let filter_empty_locations =
List.filter (Event.has_no_locations)
let filter_groups groups =
List.filter (Event.has_groups groups)
let gen_vtimezone tz =
if tz <> "" then
["BEGIN:VTIMEZONE";
"TZID:" ^ tz;
"END:VTIMEZONE\r\n"]
|> List.map ics_split_line
|> String.concat "\r\n"
else
""
let get_all_groups events =
let add_groups_to_set set event =
List.fold_left (fun set elt -> StringSet.add elt set) set @@ Event.get_groups event in
List.fold_left add_groups_to_set StringSet.empty events
|> StringSet.to_seq
let to_string tz events =
let date = current_date () in
let vtimezone = gen_vtimezone tz in
let rec gen_events id str = function
| [] -> str
| event :: l ->
gen_events (id + 1) (str ^ Event.to_string date event id) l in
"BEGIN:VCALENDAR\r\n\
VERSION:2.0\r\n\
PRODID:-//ucs//\r\n"
^ vtimezone
^ gen_events (Random.int rng_bound) "" events
^ "END:VCALENDAR\r\n"
|
