summaryrefslogtreecommitdiff
path: root/lib/render/emit_xml.ml
blob: 4e4b51a45fa65e9612f2c75edfa69702d7ee1991 (plain) (blame)
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
(* emit_xml.ml *)
module T = Template

let escape s = Escape.apply Escape.Xml s

let get v k = match v with T.Obj kvs -> List.assoc_opt k kvs | _ -> None
let s v k = match get v k with Some (T.Str x) -> x | _ -> ""
let el b name value =
  Buffer.add_string b ("      <" ^ name ^ ">" ^ escape value ^ "</" ^ name ^ ">\n")

let day b d =
  Buffer.add_string b ("    <day date=\"" ^ escape (s d "iso") ^ "\">\n");
  el b "season" (s d "season");
  el b "week" (s d "week");
  el b "slug" (s d "slug");
  el b "rank" (s d "rank");
  el b "colour" (s d "colour");
  el b "subject" (s d "subject");
  (match get d "name" with
   | Some (T.Obj kvs) ->
       List.iter
         (fun (lang, v) ->
           match v with
           | T.Str x -> Buffer.add_string b ("      <name lang=\"" ^ escape lang ^ "\">" ^ escape x ^ "</name>\n")
           | _ -> ())
         kvs
   | _ -> ());
  (match get d "comms" with
   | Some (T.List l) ->
       List.iter (fun c -> Buffer.add_string b ("      <commemoration>" ^ escape (s c "slug") ^ "</commemoration>\n")) l
   | _ -> ());
  let cite name value =
    if value <> "" then
      Buffer.add_string b ("      <citation part=\"" ^ name ^ "\">" ^ escape value ^ "</citation>\n")
  in
  cite "first" (s d "first");
  cite "gospel" (s d "gospel");
  Buffer.add_string b "    </day>\n"

let year v =
  let b = Buffer.create (128 * 1024) in
  Buffer.add_string b "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
  Buffer.add_string b
    ("<calendar rite=\"" ^ escape (s v "rite") ^ "\" year=\"" ^ escape (s v "year") ^ "\">\n");
  Buffer.add_string b "  <days>\n";
  (match get v "days" with Some (T.List l) -> List.iter (day b) l | _ -> ());
  Buffer.add_string b "  </days>\n</calendar>\n";
  Buffer.contents b