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
|
module K = Colitur_kernel
module T = Template
let str s = T.Str s
let bool b = T.Bool b
let month_names =
[| ("Ianuarius", "January"); ("Februarius", "February"); ("Martius", "March");
("Aprilis", "April"); ("Maius", "May"); ("Iunius", "June");
("Iulius", "July"); ("Augustus", "August"); ("September", "September");
("October", "October"); ("November", "November"); ("December", "December") |]
let names_value (n : K.Names.t) =
T.Obj (List.map (fun (l, s) -> (K.Lang.to_string l, str s)) (K.Names.to_list n))
let dow_int = function
| K.Date.Sun -> 0 | K.Date.Mon -> 1 | K.Date.Tue -> 2 | K.Date.Wed -> 3
| K.Date.Thu -> 4 | K.Date.Fri -> 5 | K.Date.Sat -> 6
let citation_ref cits part =
match
List.find_opt (fun (c : K.Citation.t) -> c.K.Citation.part = part) cits
with
| Some c -> c.K.Citation.reference
| None -> ""
let comm_value (c, priv) =
T.Obj
[ ("slug", str (K.Slug.to_string c.K.Celebration.slug));
("name", names_value c.K.Celebration.names);
("privileged", bool (priv = K.Precedence.Privileged)) ]
(* A padding cell: present so a grid row always has seven entries, and flagged
so a template can render it blank. Every field a real day has is present and
empty, so a template never hits a missing key on a padding cell. *)
let padding_cell dow =
T.Obj
[ ("iso", str ""); ("dom", str ""); ("dow", str (string_of_int dow));
("in_month", bool false);
("season", str ""); ("week", str ""); ("slug", str "");
("name", T.Obj []); ("rank", str "");
("colour", str "");
("is_white", bool false); ("is_red", bool false); ("is_green", bool false);
("is_violet", bool false); ("is_rose", bool false); ("is_black", bool false);
("subject", str ""); ("comms", T.List []);
("transferred_in", T.List []); ("transferred_out", T.List []);
("first", str ""); ("gospel", str ""); ("last", bool false) ]
let day_value ~vocab (d : ('s, 'r) K.Liturgical_day.t) =
let date = d.K.Liturgical_day.date in
let tmp = d.K.Liturgical_day.temporal in
let cel = d.K.Liturgical_day.observed in
let colour = cel.K.Celebration.colour in
let is c = bool (colour = c) in
T.Obj
[ ("iso", str (K.Date.to_iso8601 date));
("dom", str (string_of_int (K.Date.day date)));
("dow", str (string_of_int (dow_int (K.Date.weekday date))));
("in_month", bool true);
("season", str (vocab.K.Vocab.season_to_string tmp.K.Temporal.season));
("week", str (match tmp.K.Temporal.week with Some w -> string_of_int w | None -> ""));
("slug", str (K.Slug.to_string cel.K.Celebration.slug));
("name", names_value cel.K.Celebration.names);
(* [rank] is the kernel's own class string ("class-1"); there is
deliberately no separate localized rank label here -- the kernel
has no per-language rank names to draw one from, and a field
whose contents cannot honestly differ from [name] should not
exist just to exist. Do not re-add one until the kernel can. *)
("rank", str (vocab.K.Vocab.rank_to_string cel.K.Celebration.rank));
("colour", str (K.Colour.to_string colour));
("is_white", is K.Colour.White); ("is_red", is K.Colour.Red);
("is_green", is K.Colour.Green); ("is_violet", is K.Colour.Violet);
("is_rose", is K.Colour.Rose); ("is_black", is K.Colour.Black);
("subject", str (K.Subject.to_string cel.K.Celebration.subject));
("comms", T.List (List.map comm_value d.K.Liturgical_day.commemorations));
( "transferred_in",
T.List
(match d.K.Liturgical_day.transferred_in with
| None -> []
| Some c -> [ T.Obj [ ("slug", str (K.Slug.to_string c.K.Celebration.slug)) ] ]) );
( "transferred_out",
T.List
(List.map
(fun (c, dest) ->
T.Obj
[ ("slug", str (K.Slug.to_string c.K.Celebration.slug));
("to", str (K.Date.to_iso8601 dest)) ])
d.K.Liturgical_day.transferred_out) );
("first", str (citation_ref d.K.Liturgical_day.citations K.Citation.First));
("gospel", str (citation_ref d.K.Liturgical_day.citations K.Citation.Gospel));
(* overwritten per grid row by [set_last]; false in the flat [days] list *)
("last", bool false) ]
(* Bucket a month's day values into Sunday-started weeks of exactly seven cells,
padding both ends. This is the computation the template cannot do. *)
(* [last] is true on the seventh cell of a row. A table row needs its separator
BETWEEN cells and the engine has no "unless last" construct, so the flag is
data -- the same rule as [in_month]. Without it the LaTeX grid emits eight
columns for seven cells and pdflatex rejects the file. *)
let set_last cells =
List.mapi
(fun i c -> match c with T.Obj kvs -> T.Obj (("last", bool (i = 6)) :: List.remove_assoc "last" kvs) | v -> v)
cells
let weeks_of_month ~first_dow day_values =
let lead = List.init first_dow (fun i -> padding_cell i) in
let cells = lead @ day_values in
let rec chunk acc = function
| [] -> List.rev acc
| rest ->
let take = min 7 (List.length rest) in
let week = List.filteri (fun i _ -> i < take) rest in
let tl = List.filteri (fun i _ -> i >= take) rest in
let week =
if take = 7 then week
else week @ List.init (7 - take) (fun i -> padding_cell (take + i))
in
chunk (week :: acc) tl
in
List.mapi
(fun i w -> T.Obj [ ("num", str (string_of_int (i + 1))); ("days", T.List (set_last w)) ])
(chunk [] cells)
let of_days ~vocab ~rite ~year days =
let dvs = List.map (fun d -> (d, day_value ~vocab d)) days in
let months =
List.init 12 (fun i ->
let m = i + 1 in
let own =
List.filter (fun (d, _) -> K.Date.month d.K.Liturgical_day.date = m) dvs
in
let day_values = List.map snd own in
let first_dow =
match own with
| (d, _) :: _ -> dow_int (K.Date.weekday d.K.Liturgical_day.date)
| [] -> 0
in
let la, en = month_names.(i) in
T.Obj
[ ("num", str (string_of_int m));
("name", T.Obj [ ("la", str la); ("en", str en) ]);
("days", T.List day_values);
("weeks", T.List (weeks_of_month ~first_dow day_values)) ])
in
T.Obj
[ ("rite", str rite);
("year", str (string_of_int year));
("months", T.List months);
("days", T.List (List.map snd dvs)) ]
|
