-
Notifications
You must be signed in to change notification settings - Fork 300
/
event.ml
94 lines (88 loc) · 3.1 KB
/
event.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
open Data_intf.Event
let recurring_event_all () : recurring_event list =
Utils.yaml_sequence_file recurring_event_of_yaml "events/recurring.yml"
type metadata = {
title : string;
url : string;
textual_location : string;
location : location option;
starts : utc_datetime;
ends : utc_datetime option;
recurring_event_slug : string option;
event_type : event_type option;
}
[@@deriving
of_yaml,
stable_record ~version:t
~add:[ slug; body_md; body_html; recurring_event ]
~remove:[ recurring_event_slug ] ~set:[ event_type ],
show { with_path = false }]
let of_metadata m = metadata_to_t m ~slug:(Utils.slugify m.title)
let decode (recurring_events : recurring_event list) (fpath, (head, body_md)) =
let metadata =
metadata_of_yaml head |> Result.map_error (Utils.where fpath)
in
let body_html =
Cmarkit.Doc.of_string body_md |> Cmarkit_html.of_doc ~safe:true
in
Result.map
(fun metadata ->
let recurring_event =
Option.map
(fun recurring_event_slug ->
List.find
(fun (recurring_event : recurring_event) ->
recurring_event_slug = recurring_event.slug)
recurring_events)
metadata.recurring_event_slug
in
let recurring_event_type =
Option.map (fun (re : recurring_event) -> re.event_type) recurring_event
in
let event_type =
match (metadata.event_type, recurring_event_type) with
| None, None ->
failwith
(Printf.sprintf
"Upcoming event %s (%s) has no specified type and no linked \
recurring event"
metadata.title metadata.starts.yyyy_mm_dd)
| Some event_type, None | None, Some event_type -> event_type
| Some from_upcoming, Some from_recurring
when from_upcoming <> from_recurring ->
failwith
(Printf.sprintf
"Upcoming event %s (%s) has type %s but its linked recurring \
event %s has type %s"
metadata.title metadata.starts.yyyy_mm_dd
(show_event_type from_upcoming)
(Option.get metadata.recurring_event_slug)
(show_event_type from_recurring))
| Some _, Some from_recurring -> from_recurring
in
of_metadata ~body_md ~body_html ~recurring_event ~event_type metadata)
metadata
let all () =
Utils.map_md_files (decode (recurring_event_all ())) "events/*.md"
|> List.sort (fun (e1 : t) (e2 : t) ->
(* Sort the events by reversed start date. *)
let t1 =
e1.starts.yyyy_mm_dd ^ " "
^ Option.value ~default:"00:00" e1.starts.utc_hh_mm
in
let t2 =
e2.starts.yyyy_mm_dd ^ " "
^ Option.value ~default:"00:00" e2.starts.utc_hh_mm
in
String.compare t2 t1)
let template () =
Format.asprintf
{|
include Data_intf.Event
let recurring_event_all = %a
let all = %a
|}
(Fmt.brackets (Fmt.list pp_recurring_event ~sep:Fmt.semi))
(recurring_event_all ())
(Fmt.brackets (Fmt.list pp ~sep:Fmt.semi))
(all ())