forked from
jonmsterling.com/ocaml-forester
ocaml
Output full HTML instead of redirecting to XML
+33
-42
+6
-19
lib/frontend/Forester.ml
+6
-19
lib/frontend/Forester.ml
···
98
98
|> (fun t -> `List t)
99
99
|> Yojson.Safe.to_string
100
100
101
-
let html_redirect uri_string =
102
-
Pure_html.to_xml
103
-
@@
104
-
let open Pure_html in
105
-
let open HTML in
106
-
html []
107
-
[
108
-
head []
109
-
[
110
-
meta [http_equiv `refresh; content "0;url=%s" uri_string];
111
-
meta [charset "utf-8"];
112
-
];
113
-
]
114
-
115
101
let outputs_for_article ~(forest : State.t) (article : _ T.article) =
116
102
match article.frontmatter.uri with
117
103
| None -> []
···
132
118
article
133
119
in
134
120
let html_content =
135
-
html_redirect @@ String.concat "/"
136
-
@@ ("" :: Legacy_xml_client.local_path_components forest.config xml_route)
121
+
Pure_html.to_string @@ Html_client.render_page ~forest article
137
122
in
138
123
let debug_route = URI.with_path_components (URI.append_path_component (URI.path_components uri) "index.tree") uri in
139
124
let debug_content = Format.asprintf "%a" Types.(pp_article pp_content) article in
···
207
192
forest.config.url
208
193
in
209
194
let home_content =
210
-
html_redirect @@ "/"
211
-
^ URI.relative_path_string ~base:bare_host_uri
212
-
(Config.home_uri forest.config)
195
+
Pure_html.to_string
196
+
@@
197
+
match State.get_article bare_host_uri forest with
198
+
| None -> Html_client.page_template ~is_root:false ~title:"" []
199
+
| Some article -> Html_client.render_page ~forest article
213
200
in
214
201
List.cons [(home_route, home_content)]
215
202
@@
+27
-23
lib/frontend/Html_client.ml
+27
-23
lib/frontend/Html_client.ml
···
88
88
let render_xml_qname qname =
89
89
match qname.prefix with
90
90
| "" -> qname.uname
91
+
(* The browser does not render elements when they are denoted like <html:p> *)
92
+
| "html" -> qname.uname
91
93
| _ -> Format.sprintf "%s:%s" qname.prefix qname.uname
92
94
93
95
let render_xml_attr ~env T.{key; value} =
···
147
149
| Results_of_datalog_query _ -> [] (* TODO: just make a list of links *)
148
150
| Datalog_script _ -> []
149
151
150
-
and render_link ~env (link : T.content T.link) : P.node list = [
151
-
P.HTML.a
152
-
[
153
-
P.HTML.href "%s" (URI.path_string link.href)
154
-
] @@
155
-
render_content ~env link.content
156
-
]
152
+
and render_link ~env (link : T.content T.link) : P.node list =
153
+
[
154
+
P.HTML.a [P.HTML.href "%s" (URI.path_string link.href)]
155
+
@@ render_content ~env link.content;
156
+
]
157
157
158
158
and render_transclusion ~env (transclusion : T.transclusion) : P.node list =
159
159
match State.get_content_of_transclusion transclusion env.forest with
160
160
| None -> Reporter.fatal (Resource_not_found transclusion.href)
161
161
| Some content -> render_content ~env content
162
162
163
-
and _render_section_for_atom_client ~env (section : T.content T.section) : P.node list =
163
+
and _render_section_for_atom_client ~env (section : T.content T.section) :
164
+
P.node list =
164
165
let env =
165
166
{
166
167
env with
···
173
174
[
174
175
begin match section.frontmatter.title with
175
176
| None -> H.null []
176
-
| Some title ->
177
-
H.header [] [hx ~env [] @@ render_content ~env title]
177
+
| Some title -> H.header [] [hx ~env [] @@ render_content ~env title]
178
178
end;
179
179
begin if
180
180
Loop_detection.have_seen_uri_opt section.frontmatter.uri env.loops
···
200
200
[
201
201
begin match section.frontmatter.title with
202
202
| None -> P.HTML.null []
203
-
| Some title ->
204
-
H.header [] [hx ~env [] @@ render_content ~env title]
203
+
| Some title -> H.header [] [hx ~env [] @@ render_content ~env title]
205
204
end;
206
205
begin if
207
206
Loop_detection.have_seen_uri_opt section.frontmatter.uri env.loops
···
251
250
@ List.map render_attribution contributors;
252
251
]
253
252
254
-
let render_article ~env (article : T.content T.article) : P.node
255
-
=
256
-
(* let@ () = Scope.run ~env:article.frontmatter.uri in *)
253
+
let render_article ~env (article : T.content T.article) : P.node =
254
+
let should_render_backmatter _ = true in
257
255
H.article []
258
256
[
259
257
H.section []
260
-
(render_content ~env:{env with loops = Loop_detection.add_seen_uri_opt article.frontmatter.uri env.loops} article.mainmatter);
258
+
(render_content
259
+
~env:
260
+
{
261
+
env with
262
+
loops =
263
+
Loop_detection.add_seen_uri_opt article.frontmatter.uri
264
+
env.loops;
265
+
}
266
+
article.mainmatter);
267
+
(if should_render_backmatter article then H.footer [] [] else H.null []);
261
268
]
262
269
263
270
let render_toc _article = H.ul [] []
···
294
301
let render_institution ~env frontmatter =
295
302
default_meta_item ~env frontmatter "institution"
296
303
297
-
let render_venue ~env frontmatter =
298
-
default_meta_item ~env frontmatter "venue"
304
+
let render_venue ~env frontmatter = default_meta_item ~env frontmatter "venue"
299
305
300
-
let render_source ~env frontmatter =
301
-
default_meta_item ~env frontmatter "source"
306
+
let render_source ~env frontmatter = default_meta_item ~env frontmatter "source"
302
307
303
308
let render_doi ~env frontmatter =
304
309
optional (get_meta frontmatter "doi") (fun c ->
···
324
329
325
330
let render_external ~env frontmatter =
326
331
optional (get_meta frontmatter "external") (fun c ->
327
-
let link = Plain_text_client.string_of_content ~forest:env.forest c in
332
+
let link = Plain_text_client.string_of_content ~forest:env.forest c in
328
333
H.li
329
334
[H.class_ "meta-item"]
330
335
[
···
347
352
[H.class_ "meta-item"]
348
353
[H.a [H.class_ "link external"; H.href "%s" link] [P.txt "Video"]])
349
354
350
-
let render_frontmatter ~env (frontmatter : _ T.frontmatter) :
351
-
P.node =
355
+
let render_frontmatter ~env (frontmatter : _ T.frontmatter) : P.node =
352
356
H.header []
353
357
[
354
358
H.h1 [] [H.span [H.class_ "taxon"] []];