Source file RenderLaTeX.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
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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
open Bwd
open Prelude
open Core
module E = RenderEff.Perform
module Printer =
struct
module P0 =
struct
type out = Format.formatter
let text = Format.dprintf "%s"
end
include PrinterKit.Kit (P0)
end
let rec add_qedhere xs =
match Bwd.of_list xs with
| Emp -> xs
| Snoc (xs', last) ->
let qedhere = Sem.Tag ("qedhere", [], []) in
match last with
| Sem.Tag ("ol", _, ys) ->
Bwd.to_list @@ Bwd.Snoc (xs', Sem.Tag ("ol", [], add_qedhere ys))
| Sem.Tag ("ul", _, ys) ->
Bwd.to_list @@ Bwd.Snoc (xs', Sem.Tag ("ul", [], add_qedhere ys))
| Sem.Tag ("li", _, ys) ->
Bwd.to_list @@ Bwd.Snoc (xs', Sem.Tag ("li", [], add_qedhere ys))
| Sem.Math (Display, ys) ->
Bwd.to_list @@ Bwd.Snoc (xs', Sem.Math (Display, add_qedhere ys))
| _ ->
Bwd.to_list @@ Bwd.Snoc (Bwd.Snoc (xs', last), qedhere)
let render_date =
Format.dprintf {|\date{%a}@.|} Date.pp_human
let rec render (nodes : Sem.t) : Printer.t =
Printer.iter render_node nodes
and render_node : Sem.node -> Printer.t =
function
| Text txt -> Printer.text txt
| Transclude (_, addr) ->
begin
match E.get_doc addr with
| None ->
failwith @@ Format.sprintf "Failed to transclude non-existent tree with address '%s'" addr
| Some doc ->
render_doc_section doc
end
| Tag (name, _, body) ->
render_tag name body
| Link {title; dest} ->
begin
match E.get_doc dest with
| None ->
Format.dprintf {|\href{%s}{%a}|} dest (Fun.flip render) title
| Some doc ->
begin
match doc.taxon with
| Some "reference" ->
Format.dprintf {|%a~\cite{%s}|} (Fun.flip render) title dest
| Some "person" ->
render title
| _ ->
Format.dprintf {|\ForesterRef{%s}{%a}|} dest (Fun.flip render) title
end
end
| Math (Inline, body) ->
Format.dprintf {|\(%a\)|} (Fun.flip RenderMathMode.render) body
| Math (Display, body) ->
Format.dprintf {|\[%a\]|} (Fun.flip RenderMathMode.render) body
| EmbedTeX {source; packages} ->
let code =
RenderMathMode.Printer.contents @@
RenderMathMode.render source
in
let hash = Digest.to_hex @@ Digest.string code in
E.enqueue_latex ~name:hash ~packages ~source:code;
let path = Format.sprintf "resources/%s-print.pdf" hash in
Format.dprintf {|\[\includegraphics{%s}\]%s|} path "\n"
| Block (title, body) ->
Printer.seq [
Format.dprintf {|\begin{proof}[{%a}]%s|} (Fun.flip render) title "\n";
render @@ add_qedhere body;
Format.dprintf {|\end{proof}%s|} "\n"
]
| Query _ ->
Printer.nil
and render_title title =
Format.dprintf {|\title{%a}%s|} (Fun.flip render) (Sem.sentence_case title) "\n"
and render_tag name body =
match name with
| "ol" ->
Printer.seq ~sep:(Printer.text "\n") [
Format.dprintf {|\begin{enumerate}|};
render body;
Format.dprintf {|\end{enumerate}|};
]
| "ul" ->
Printer.seq ~sep:(Printer.text "\n") [
Format.dprintf {|\begin{itemize}|};
render body;
Format.dprintf {|\end{itemize}|};
]
| "blockquote" ->
Printer.seq ~sep:(Printer.text "\n") [
Format.dprintf {|\begin{quotation}|};
render body;
Format.dprintf {|\end{quotation}|};
]
| _ ->
let name =
match name with
| "p" -> "par"
| "b" | "strong" -> "textbf"
| "em" -> "emph"
| "li" -> "item"
| _ -> name
in
Format.dprintf {|\%s{%a}|} name (Fun.flip render) body
and render_author author =
match E.get_doc author with
| Some bio ->
begin
match bio.title with
| Some title -> render title
| None -> Printer.text author
end
| None ->
Printer.text author
and render_authors =
function
| [], [] -> Printer.nil
| authors, contributors ->
let pp_sep fmt () = Format.fprintf fmt {| \and |} in
Format.dprintf {|\author{%a%a}%s|}
(Format.pp_print_list ~pp_sep (Fun.flip render_author))
authors
(Fun.flip render_contributors) contributors
"\n"
and render_contributors =
function
| [] -> Printer.nil
| contributors ->
let pp_sep fmt () = Format.fprintf fmt {|, |} in
Format.dprintf {|\thanks{With contributions from %a.}|}
(Format.pp_print_list ~pp_sep (Fun.flip render_author))
contributors
and strip_first_paragraph xs =
match xs with
| Sem.Tag ("p", _, body) :: rest -> body @ rest
| _ -> xs
and render_doc_section (doc : Sem.doc) : Printer.t =
let title = Sem.sentence_case @@ Option.value ~default:[] doc.title in
let taxon = Option.value ~default:"" doc.taxon in
let addr = Option.value doc.addr ~default:(string_of_int @@ Oo.id (object end)) in
Printer.seq ~sep:(Printer.text "\n") [
Printer.nil;
Format.dprintf
{|\begin{tree}{title={%a}, taxon={%s}, slug={%s}}|}
(Fun.flip render) title
taxon
addr;
render @@ strip_first_paragraph doc.body;
Format.dprintf {|\end{tree}|};
Printer.nil;
]
let render_base_url url =
Format.dprintf {|\ForesterSetup{forestSite = {%s}}|} url
let render_doc_page ~base_url (doc : Sem.doc) : Printer.t =
let contributors =
match doc.addr with
| Some addr -> E.contributors addr
| None -> []
in
Printer.seq ~sep:(Printer.text "\n") [
Format.dprintf {|\documentclass[a4paper]{article}|};
Format.dprintf {|\usepackage[final]{microtype}|};
Format.dprintf {|\usepackage{fontspec}|};
Format.dprintf {|\setmonofont{inconsolata}|};
Format.dprintf {|\usepackage{amsmath,amsthm,amssymb,stmaryrd,mathtools,biblatex,forester}|};
Format.dprintf {|\addbibresource{forest.bib}|};
base_url |> Printer.option render_base_url;
doc.title |> Printer.option render_title;
doc.date |> Printer.option render_date;
render_authors (doc.authors, contributors);
Format.dprintf {|\begin{document}|};
Format.dprintf {|\maketitle|};
render doc.body;
Format.dprintf {|\printbibliography|};
Format.dprintf {|\end{document}|}
]