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
|
(*
* Copyright (C) 2020 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 J = Json_encoding
let date_format = "%FT%T"
let separator = Str.regexp_string "\r\n\r\n<br />\r\n\r\n"
let group_prefixes = ["MAT-Agreg Interne "; "3EME ANNEE "; "2EME ANNEE ";
"1ERE ANNEE "; "MAG1 "; "DEUST "; "M2 "; "M1 "; "L3P ";
"L3 "; "L2 "; "L1 "]
let startswith str prefix =
String.(
let lstr = length str and
lprefix = length prefix in
lstr = lprefix && equal str prefix
|| lstr > lprefix && equal (sub str 0 lprefix) prefix)
let check_groups str =
List.fold_left
(fun res prefix ->
res || startswith str prefix) false group_prefixes
let location_and_summary str category =
let parts = Str.split separator str in
let _, location, summary =
List.fold_right
(fun str (has_groups, location, summary) ->
if not has_groups then
(check_groups str, "", "")
else if location = "" then
(true, str, "")
else if summary = "" then
(true, str, location)
else
(true, location, summary)) parts (false, "", "") in
if summary = "" then
location, category
else
location, summary ^ " (" ^ category ^ ")"
let date =
Printer.Calendar.(
J.(conv (sprint date_format) (from_fstring date_format) string))
let encoding =
J.(conv
(fun _ -> (None, None, "", "", (), (), ()),
((), (), (), (), (), (), (), (), (), ()))
(fun ((start, stop, description, category, (), (), ()),
((), (), (), (), (), (), (), (), (), ())) ->
let location, summary = location_and_summary description category in
match start, stop with
| Some start, Some stop ->
Some (Ics.Event.make start stop summary location)
| _, _ -> None)
(merge_objs
(obj7
(req "start" @@ option date)
(req "end" @@ option date)
(req "description" string)
(req "eventCategory" string)
(req "id" unit)
(req "allDay" unit)
(req "backgroundColor" unit))
(obj10
(req "textColor" unit)
(req "department" unit)
(req "faculty" unit)
(req "sites" unit)
(req "modules" unit)
(req "registerStatus" unit)
(req "studentMark" unit)
(req "custom1" unit)
(req "custom2" unit)
(req "custom3" unit))))
let decode s =
let toks =
match s with
| "" -> `O []
| s -> Ezjsonm.from_string s in
J.(destruct (list encoding) toks)
|> List.filter_map (fun (event: Ics.Event.t option) -> event)
|> Ics.make
|