···11+Permission to use, copy, modify, and/or distribute this software for
22+any purpose with or without fee is hereby granted.
33+44+THE SOFTWARE IS PROVIDED “AS IS” AND THE AUTHOR DISCLAIMS ALL
55+WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES
66+OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE
77+FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY
88+DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
99+AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
1010+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
···2525 let resources = Forest.create 1000 in
2626 let diagnostics = Diagnostic_store.create 100 in
2727 let units = Expand.Env.empty in
2828-let search_index = State.Search_index.empty in
2828+ let search_index = State.Search_index.empty in
2929 {
3030 env;
3131 dev;
+515-122
lib/frontend/Htmx_client.ml
···1010open Forester_compiler
11111212module T = Types
1313-module P = Pure_html
1414-module H = P.HTML
1313+open Pure_html
1414+open HTML
15151616type query = {
1717 query: (string, T.content T.vertex) Forester_core.Datalog_expr.query;
···3333 |> Seq.filter_map (fun iri -> Forest.get_article iri forest.resources)
3434 |> List.of_seq
3535 |> List.sort C.compare_article
3636+3737+let home_iri ~(config : Config.t) =
3838+ (* let config = State.get_config forest in *)
3939+ let@ root = Option.bind config.home in
4040+ let base = Iri_scheme.base_iri ~host: config.host in
4141+ try
4242+ Option.some @@ Iri.resolve ~base @@ Iri.of_string root
4343+ with
4444+ | _ -> None
4545+4646+let iri_is_home ~config iri =
4747+ match home_iri ~config with
4848+ | Some home_iri ->
4949+ (* By this point, any IRI should be in normal form. *)
5050+ Iri.equal ~normalize: false home_iri iri
5151+ | None -> false
36523753let route forest addr =
3854 let config = State.config forest in
···4157 else
4258 Format.asprintf "%s" (Iri.path_string addr)
43596060+let title_flags_to_http_header (flags : T.title_flags) =
6161+ match flags with
6262+ | {empty_when_untitled} ->
6363+ `Assoc ([("Empty-When-Untitled", `String (Bool.to_string empty_when_untitled))])
6464+6565+(* I am encoding these headers to JSON because that is what HTMX
6666+ requires, but it would be more beautiful if we could directly use the
6767+ header type*)
6868+let section_flags_to_http_header (flags : T.section_flags) =
6969+ match flags with
7070+ | {hidden_when_empty;
7171+ included_in_toc;
7272+ header_shown;
7373+ metadata_shown;
7474+ numbered;
7575+ expanded
7676+ } ->
7777+ let to_header l t =
7878+ match t with
7979+ | Some v -> Some (l, `String (Bool.to_string v))
8080+ | None -> None
8181+ in
8282+ let a = to_header "Hidden-When-Empty" hidden_when_empty in
8383+ let b = to_header "Included-In-Toc" included_in_toc in
8484+ let c = to_header "Header-Shown" header_shown in
8585+ let d = to_header "Metadata-Shown" metadata_shown in
8686+ let e = to_header "Numbered" numbered in
8787+ let f = to_header "Expanded" expanded in
8888+ `Assoc (List.filter_map Fun.id [a; b; c; d; e; f])
8989+9090+let content_target_to_http_header (target : T.content_target) =
9191+ match target with
9292+ | T.Full flags ->
9393+ let `Assoc flags = section_flags_to_http_header flags in
9494+ `Assoc (("Full", `String "true") :: flags)
9595+ | T.Mainmatter ->
9696+ `Assoc ["Mainmatter", `String "true"]
9797+ | T.Title flags ->
9898+ let `Assoc flags = title_flags_to_http_header flags in
9999+ `Assoc (("Title", `String "true") :: flags)
100100+ | T.Taxon ->
101101+ `Assoc ["Taxon", `String "true"]
102102+44103let render_xml_qname = function
45104 | {prefix = ""; uname; _} -> uname
46105 | {prefix; uname; _} -> Format.sprintf "%s:%s" prefix uname
···48107let render_xml_attr
49108 : T.content T.xml_attr -> _
50109= fun T.{key; value = _} ->
5151- P.string_attr (render_xml_qname key) "todo"
110110+ string_attr (render_xml_qname key) "todo"
52111(* "%a" render_content value *)
531125454-let tag_of_prim_node : Prim.t -> P.attr list -> P.node list -> P.node = function
5555- | `P -> H.p
5656- | `Em -> H.em
5757- | `Strong -> H.strong
5858- | `Figure -> H.figure
5959- | `Figcaption -> H.figcaption
6060- | `Ul -> H.ul
6161- | `Ol -> H.ol
6262- | `Li -> H.li
6363- | `Blockquote -> H.blockquote
6464- | `Code -> H.code
6565- | `Pre -> H.pre
113113+let tag_of_prim_node : Prim.t -> attr list -> node list -> node = function
114114+ | `P -> p
115115+ | `Em -> em
116116+ | `Strong -> strong
117117+ | `Figure -> figure
118118+ | `Figcaption -> figcaption
119119+ | `Ul -> ul
120120+ | `Ol -> ol
121121+ | `Li -> li
122122+ | `Blockquote -> blockquote
123123+ | `Code -> code
124124+ | `Pre -> pre
6612567126let render_prim_node p =
68127 tag_of_prim_node p []
6912870129let render_img = function
71130 | T.Inline {format; base64} ->
7272- H.img [H.src "data:image/%s;base64,%s" format base64]
131131+ img [src "data:image/%s;base64,%s" format base64]
73132 | T.Remote url ->
7474- H.img [H.src "%s" url]
133133+ img [src "%s" url]
7513476135let render_xmlns_prefix Xmlns.{prefix; xmlns} =
7777- P.string_attr ("xmlns:" ^ prefix) "%s" xmlns
136136+ string_attr ("xmlns:" ^ prefix) "%s" xmlns
781377979-let rec render_article (forest : State.t) (article : T.content T.article) : P.node =
138138+let render_date (date : Human_datetime.t) =
139139+ let year = txt "%i" (Human_datetime.year date) in
140140+ let month =
141141+ match Human_datetime.month date with
142142+ | None -> None
143143+ | Some i ->
144144+ match i with
145145+ | 1 -> Some (txt "January")
146146+ | 2 -> Some (txt "February")
147147+ | 3 -> Some (txt "March")
148148+ | 4 -> Some (txt "April")
149149+ | 5 -> Some (txt "May")
150150+ | 6 -> Some (txt "June")
151151+ | 7 -> Some (txt "July")
152152+ | 8 -> Some (txt "August")
153153+ | 9 -> Some (txt "September")
154154+ | 10 -> Some (txt "October")
155155+ | 11 -> Some (txt "November")
156156+ | 12 -> Some (txt "December")
157157+ | _ -> assert false
158158+ in
159159+ let day =
160160+ match Human_datetime.day date with
161161+ | None -> null []
162162+ | Some i -> txt "%i" i
163163+ in
164164+ li
165165+ [class_ "meta-item"]
166166+ [
167167+ a
168168+ [class_ "link local"]
169169+ [
170170+ Option.value ~default: (null []) month;
171171+ if Option.is_some month then txt " " else null [];
172172+ day;
173173+ if Option.is_some month then txt ", " else null [];
174174+ year
175175+ ]
176176+ ]
177177+178178+let rec render_article (forest : State.t) (article : T.content T.article) : node =
80179 (* FIXME: What should reserved be here? *)
81180 let@ () = Xmlns.run ~reserved: [] in
8282- H.article
8383- []
181181+ HTML.article
182182+ [id "tree-container";]
183183+ [
184184+ (* FIXME: Should be reusing render_section *)
185185+ HTML.section
186186+ [class_ "block"]
187187+ [
188188+ details
189189+ [
190190+ (* TODO: check if expanded*)
191191+ open_
192192+ ]
193193+ (
194194+ summary
195195+ []
196196+ [
197197+ render_frontmatter forest article.frontmatter;
198198+ ] :: render_content forest article.mainmatter;
199199+ );
200200+ ];
201201+ match Option.map (iri_is_home ~config: forest.config) article.frontmatter.iri with
202202+ | None ->
203203+ footer
204204+ []
205205+ (render_backmatter forest article.backmatter)
206206+ | Some false ->
207207+ footer
208208+ []
209209+ (render_backmatter forest article.backmatter)
210210+ | Some true ->
211211+ null []
212212+ ]
213213+214214+and render_section (forest : State.t) (section : T.content T.section) : node =
215215+ match section with
216216+ | {frontmatter;
217217+ mainmatter;
218218+ flags = {header_shown;
219219+ metadata_shown;
220220+ expanded;
221221+ numbered = _;
222222+ included_in_toc = _;
223223+ hidden_when_empty = _;
224224+ }
225225+ } ->
226226+ let test k = function
227227+ | Some true -> true
228228+ | Some false -> false
229229+ | None -> k
230230+ in
231231+ let class_ =
232232+ if test false metadata_shown then class_ "block"
233233+ else
234234+ class_ "block hide-metadata"
235235+ in
236236+ let data_taxon =
237237+ match frontmatter.taxon with
238238+ | None -> null_
239239+ | Some _c ->
240240+ (* string_attr "data-taxon" () *)
241241+ null_
242242+ in
243243+ HTML.section
244244+ [
245245+ class_;
246246+ data_taxon;
247247+ ]
248248+ [
249249+ if test true header_shown then
250250+ details
251251+ [if test true expanded then open_ else null_]
252252+ [
253253+ summary
254254+ []
255255+ [
256256+ render_frontmatter forest frontmatter;
257257+ ];
258258+ null @@ render_content forest mainmatter;
259259+ ]
260260+ else null @@ render_content forest mainmatter;
261261+ (* render_frontmatter forest frontmatter; *)
262262+ (* null @@ render_content forest mainmatter; *)
263263+ ]
264264+265265+(* Same as render_section, but adds the backmatter-section class *)
266266+and render_backmatter (forest : State.t) backmatter =
267267+ List.map
268268+ (fun node ->
269269+ let attrs = Format.asprintf "%s backmatter-section" node.@["class"] in
270270+ node +@ class_ "%s" attrs
271271+ )
272272+ (render_content forest backmatter)
273273+274274+and render_attributions forest (attributions : T.content T.attribution list) =
275275+ let render_attribution attribution =
276276+ match attribution with
277277+ | T.{vertex; _} ->
278278+ match vertex with
279279+ | T.Iri_vertex href ->
280280+ let content = T.Content [T.Transclude {href; target = Title {empty_when_untitled = false}; modifier = Identity}] in
281281+ null @@ render_link forest T.{href; content}
282282+ | T.Content_vertex content ->
283283+ null @@ render_content forest content
284284+ in
285285+ let authors, contributors =
286286+ List.partition_map
287287+ (fun a ->
288288+ match T.(a.role) with
289289+ | T.Author -> Left a
290290+ | Contributor -> Right a
291291+ )
292292+ attributions
293293+ in
294294+ li
295295+ [class_ "meta-item"]
84296 [
8585- render_frontmatter forest article.frontmatter;
8686- H.null @@ render_content forest article.mainmatter;
8787- H.section [H.class_ "backmatter"] @@ render_content forest article.backmatter
297297+ address
298298+ [class_ "author"] @@
299299+ (List.map render_attribution authors) @
300300+ (
301301+ if List.length contributors > 0 then
302302+ [txt "with contributions from "]
303303+ else []
304304+ ) @
305305+ List.map render_attribution contributors
88306 ]
893079090-and render_section (forest : State.t) (section : T.content T.section) : P.node =
9191- H.section
308308+and render_frontmatter (forest : State.t) (frontmatter : T.content T.frontmatter) : node =
309309+ let taxon =
310310+ Option.value ~default: [] @@
311311+ Option.map
312312+ (fun c ->
313313+ (
314314+ render_content forest @@
315315+ T.apply_modifier_to_content T.Sentence_case c
316316+ ) @
317317+ [txt "."]
318318+ )
319319+ frontmatter.taxon
320320+ in
321321+ let title =
322322+ Option.value ~default: [] @@
323323+ Option.map
324324+ (fun c ->
325325+ render_content forest @@
326326+ T.apply_modifier_to_content
327327+ T.Sentence_case
328328+ c
329329+ )
330330+ frontmatter.title
331331+ in
332332+ let iri =
333333+ match frontmatter.iri with
334334+ | None -> null []
335335+ | Some iri ->
336336+ let iri_str =
337337+ if Iri.host iri = Some forest.config.host then
338338+ Scanf.(sscanf (Iri.path_string iri) "/%s") Fun.id
339339+ else
340340+ Format.asprintf "%a" pp_iri iri
341341+ in
342342+ a
343343+ [
344344+ class_ "slug";
345345+ href "%s" iri_str;
346346+ ]
347347+ [txt "[%s]" iri_str]
348348+ in
349349+ let source_path =
350350+ match frontmatter.source_path with
351351+ | Some path ->
352352+ [
353353+ a
354354+ [
355355+ class_ "edit-button";
356356+ href "vscode://file%s" path
357357+ ]
358358+ [txt "[edit]"]
359359+ ]
360360+ | None -> []
361361+ in
362362+ let find_meta key =
363363+ List.find_map
364364+ (fun (str, content) ->
365365+ if str = key then Some content
366366+ else None
367367+ )
368368+ frontmatter.metas
369369+ in
370370+ let render_meta key f =
371371+ Option.value
372372+ ~default: (null [])
373373+ (Option.map f (find_meta key))
374374+ in
375375+ let default_meta_item content =
376376+ li
377377+ [class_ "meta-item"]
378378+ (render_content forest content)
379379+ in
380380+ let labelled_external_link ~href ~label =
381381+ li
382382+ [class_ "meta-item"]
383383+ [a [class_ "link external"; href] [txt "%s" label]]
384384+ in
385385+ let to_string =
386386+ Plain_text_client.string_of_content
387387+ ~forest: forest.resources
388388+ ~router: (Legacy_xml_client.route forest)
389389+ in
390390+ let position = render_meta "position" default_meta_item in
391391+ let institution = render_meta "institution" default_meta_item in
392392+ let venue = render_meta "venue" default_meta_item in
393393+ let source = render_meta "source" default_meta_item in
394394+ let doi = render_meta "doi" default_meta_item in
395395+ let orcid =
396396+ render_meta "orcid" (fun c ->
397397+ let content = to_string c in
398398+ li
399399+ [class_ "meta-item"]
400400+ [
401401+ a
402402+ [
403403+ class_ "doi link";
404404+ href "https://www.doi.org/%s" content;
405405+ ]
406406+ [txt "%s" content]
407407+ ]
408408+ )
409409+ in
410410+ let external_ =
411411+ render_meta "external" (fun c ->
412412+ let content = to_string c in
413413+ li
414414+ [class_ "meta-item"]
415415+ [
416416+ a
417417+ [
418418+ class_ "link external";
419419+ href "%s" content;
420420+ ]
421421+ [txt "%s" content]
422422+ ]
423423+ )
424424+ in
425425+ let slides =
426426+ render_meta "slides" (fun c ->
427427+ labelled_external_link ~href: (href "%s" (to_string c)) ~label: "Slides"
428428+ )
429429+ in
430430+ let video =
431431+ render_meta "video" (fun c ->
432432+ labelled_external_link ~href: (href "%s" (to_string c)) ~label: "Video"
433433+ )
434434+ in
435435+ header
92436 []
93437 [
9494- render_frontmatter forest section.frontmatter;
9595- H.null @@ render_content forest section.mainmatter
438438+ (
439439+ h1
440440+ []
441441+ (
442442+ [
443443+ span
444444+ [class_ "taxon"]
445445+ taxon
446446+ ] @
447447+ title @
448448+ [txt " "] @
449449+ [iri] @
450450+ source_path
451451+ )
452452+ );
453453+ div
454454+ [class_ "metadata"]
455455+ [
456456+ ul
457457+ []
458458+ (
459459+ (List.map render_date frontmatter.dates) @
460460+ [
461461+ render_attributions forest frontmatter.attributions;
462462+ position;
463463+ institution;
464464+ venue;
465465+ source;
466466+ doi;
467467+ orcid;
468468+ external_;
469469+ slides;
470470+ video;
471471+ ]
472472+ )
473473+ ];
96474 ]
974759898-and render_frontmatter (forest : State.t) (frontmatter : T.content T.frontmatter) : P.node =
9999- H.header
100100- []
476476+and render_transclusion transclusion =
477477+ match transclusion with
478478+ | T.{href; target; modifier = _} ->
479479+ let headers = Yojson.Safe.to_string @@ content_target_to_http_header target in
101480 [
102102- H.h1 [] @@
103103- List.concat @@
104104- Option.to_list @@
105105- Option.map
106106- (render_content forest)
107107- frontmatter.title
481481+ span
482482+ [
483483+ Hx.trigger "load";
484484+ Hx.get "/trees%s" (Iri.path_string href);
485485+ Hx.target "this";
486486+ Hx.swap "outerHTML";
487487+ (* TODO: Update dream-html: https://github.com/yawaramin/dream-html/commit/2f358cc25ef34a590937b1f1e2740141ad06efa9 *)
488488+ attr (Format.asprintf "data-hx-headers='%s'" headers)
489489+ ]
490490+ [txt "transclusion: %s" (Format.asprintf "%a" pp_iri href)]
108491 ]
109492110110-and render_content (forest : State.t) (Content content: T.content) : P.node list =
493493+and render_content (forest : State.t) (Content content: T.content) : node list =
111494 List.concat_map (render_content_node forest) content
112495113496and render_content_node
114114- : State.t -> 'a T.content_node -> P.node list
497497+ : State.t -> 'a T.content_node -> node list
115498= fun forest node ->
116116- let open P in
117117- (* let open H in *)
118499 match node with
119500 | Text str ->
120120- [P.txt "%s" str]
501501+ [txt "%s" str]
121502 | CDATA str ->
122122- [P.txt ~raw: true "<![CDATA[%s]]>" str]
503503+ [txt ~raw: true "<![CDATA[%s]]>" str]
123504 | Xml_elt elt ->
124505 let prefixes_to_add, (name, attrs, content) =
125506 let@ () = Xmlns.within_scope in
···131512 let xmlns_attrs = List.map render_xmlns_prefix prefixes_to_add in
132513 attrs @ xmlns_attrs
133514 in
134134- [P.std_tag name attrs content]
515515+ [std_tag name attrs content]
135516 | Prim (p, content) ->
136517 [render_prim_node p @@ render_content forest content]
137518 | Transclude transclusion ->
138138- render_transclusion forest transclusion
519519+ render_transclusion transclusion
139520 | Contextual_number addr ->
140521 let custom_number =
141522 let@ article = Option.bind @@ Forest.get_article addr forest.resources in
···146527 | None -> Format.asprintf "[%a]" Iri.pp addr
147528 | Some num -> num
148529 in
149149- [P.txt "%s" num]
530530+ [txt "%s" num]
150531 | Link link ->
151532 render_link forest link
152533 | Results_of_query q ->
···158539 | Section section ->
159540 [render_section forest section]
160541 | KaTeX (mode, content) ->
161161- let l, r =
162162- match mode with
163163- | Display -> {|\[|}, {|\]|}
164164- | Inline -> {|\(|}, {|\)|}
165165- in
166542 let body = Plain_text_client.string_of_content ~forest: forest.resources ~router: Iri.to_uri content in
167167- [P.txt ~raw: true "%s%s%s" l body r]
543543+ (* [txt ~raw: true "%s%s%s" l body r] *)
544544+ begin
545545+ match mode with
546546+ | Inline ->
547547+ [span [class_ "math"] [txt ~raw: true "%s" body]]
548548+ | Display ->
549549+ [div [class_ "math"] [txt ~raw: true "%s" body]]
550550+ end
168551 | TeX_cs cs ->
169169- [P.txt ~raw: true "\\%s" (TeX_cs.show cs)]
552552+ [txt ~raw: true "\\%s" (TeX_cs.show cs)]
170553 | Img img ->
171554 [render_img img]
172172- | T.Results_of_datalog_query q ->
555555+ | Results_of_datalog_query q ->
173556 (* We could just evaluate the query immediately. This is just experimental*)
174557 [
175175- H.div
176176- []
558558+ span
177559 [
178178- H.div
179179- [
180180- Hx.get "/query";
181181- Hx.trigger "load";
182182- (* Hx.headers {|{"Content-Type": "application/json"}|}; *)
183183- (* Hx.ext "json-enc"; *)
184184- Hx.vals
185185- "%s"
186186- Repr.(
187187- to_json_string
188188- ~minify: true
189189- (* Datalog_expr.(query_t Repr.string (T.vertex_t T.content_t)) *)
190190- query_t
191191- {query = q}
192192- )
193193- ]
194194- []
560560+ Hx.get "/query";
561561+ Hx.trigger "load";
562562+ Hx.swap "outerHTML";
563563+ Hx.target "this";
564564+ Hx.vals
565565+ "%s"
566566+ Repr.(
567567+ to_json_string
568568+ ~minify: true
569569+ query_t
570570+ {query = q}
571571+ )
195572 ]
573573+ []
196574 ]
197575 | T.Datalog_script _ -> []
198576 | T.Artefact _
199577 | T.Iri _
200578 | T.Route_of_iri _ ->
201201- [P.txt "todo"]
202202-203203-and _render_resource resource =
204204- render_content resource.contents
205205-206206-and render_transclusion (forest : State.t) (transclusion : T.transclusion) : P.node list =
207207- List.concat @@
208208- Option.to_list @@
209209- Option.map (render_content forest) @@
210210- Forest.get_content_of_transclusion transclusion forest.resources
579579+ [txt "todo"]
211580212581(* TODO: links need to be flattened in order to produce valid HTML. *)
213213-and render_link (forest : State.t) (link : T.content T.link) : P.node list =
214214- let article_opt = Forest.get_article link.href forest.resources in
582582+and render_link (forest : State.t) (link : T.content T.link) : node list =
215583 let attrs =
216216- match article_opt with
584584+ match Forest.get_article link.href forest.resources with
217585 | None ->
218218- [H.href "%s" (Format.asprintf "%a" Iri.pp link.href)]
219219- | Some article ->
586586+ (* TODO: rendering of hrefs is suboptimal... *)
220587 [
221221- begin
222222- match article.frontmatter.iri with
223223- | Some iri -> H.href "%s" @@ route forest iri
224224- | None -> P.HTML.null_
225225- end;
226226- (* H.title_ "%s" @@ PT.string_of_content article.frontmatter.title *)
588588+ href "%s" (Format.asprintf "%a" Iri.pp link.href);
227589 ]
590590+ | Some article ->
591591+ begin
592592+ match article.frontmatter.iri with
593593+ | Some _iri ->
594594+ [
595595+ title_ "%s" @@
596596+ Option.value ~default: "" @@
597597+ Option.map
598598+ (
599599+ Plain_text_client.string_of_content
600600+ ~forest: forest.resources
601601+ ~router: (Legacy_xml_client.route forest)
602602+ )
603603+ article.frontmatter.title;
604604+ href "/trees%s" (Format.asprintf "%s" (Iri.path_string link.href));
605605+ Hx.target "#tree-container";
606606+ Hx.swap "innerHTML";
607607+ ]
608608+ | None -> [HTML.null_]
609609+ end;
228610 in
229229- [H.a attrs @@ render_content forest link.content]
611611+ [
612612+ span
613613+ [class_ "link local"]
614614+ [a attrs (render_content forest link.content)]
615615+ ]
230616231231-let render_query_result (forest : State.t) vs =
232232- let render_vertex = function
233233- | T.Iri_vertex iri ->
234234- begin
235235- match Forest.find_opt forest.resources iri with
236236- | None ->
237237- H.li
238238- []
239239- [
240240- H.a
241241- [H.href "%s" (Format.asprintf "%a" pp_iri iri)]
242242- [P.txt "%s" (Format.asprintf "%a" pp_iri iri)]
243243- ]
244244- | Some (T.Article a) ->
245245- H.li
246246- []
247247- [
248248- render_frontmatter forest a.frontmatter;
249249- H.div [] @@ render_content forest a.mainmatter
250250- ]
251251- | Some (T.Asset _) ->
252252- P.txt "todo: render asset"
253253- end
254254- | T.Content_vertex c -> H.div [] (render_content forest c)
255255- in
617617+let render_query_result (forest : State.t) (vs : Vertex_set.t) =
618618+ let module C = Types.Comparators(struct
619619+ let string_of_content =
620620+ Plain_text_client.string_of_content
621621+ ~forest: forest.resources
622622+ ~router: (route forest)
623623+ end) in
256624 vs
257257- |> Vertex_set.to_list (* TODO: Needs to be sorted *)
258258- |> List.map render_vertex
625625+ |> Vertex_set.to_seq
626626+ |> Seq.filter_map Vertex.iri_of_vertex
627627+ |> Seq.filter_map (fun iri -> Forest.get_article iri forest.resources)
628628+ |> List.of_seq
629629+ |> List.sort C.compare_article
630630+ |> List.map
631631+ (
632632+ T.article_to_section
633633+ ~flags: {T.default_section_flags with
634634+ expanded = Some false;
635635+ numbered = Some false;
636636+ included_in_toc = Some false;
637637+ metadata_shown = Some true
638638+ }
639639+ )
640640+ |> List.map (render_section forest) |> fun nodes ->
641641+ if List.length nodes = 0 then None
642642+ else Some (div [class_ "tree-content"] nodes)
643643+644644+let render_toc _article =
645645+ nav
646646+ [id "toc"; Hx.swap_oob "true"]
647647+ [
648648+ div
649649+ [class_ "block"]
650650+ [h1 [] [txt "Table of contents"]]
651651+ ]
···1818 | Nil
1919 | Home
2020 | Query
2121+ | Htmx
21222223let routes : route router =
2324 one_of
···3334 route (s "nil" /? nil) Nil;
3435 route (s "home" /? nil) Home;
3536 route (s "query" /? nil) Query;
3737+ route (s "htmx.js" /? nil) Htmx;
3638 ]
+98-27
lib/server/Server.ml
···15151616type theme = {
1717 stylesheet: string;
1818- index: string;
1818+ htmx: string;
1919 js_bundle: string;
2020 font_dir: string;
2121 favicon: string;
···2626 let base_dir = List.hd theme_location in
2727 let theme_dir = EP.(env#fs / base_dir / "theme") in
2828 let stylesheet = EP.(load (theme_dir / "style.css")) in
2929- let index = EP.(load (theme_dir / "index.html")) in
2929+ let htmx = EP.(load (theme_dir / "htmx.js")) in
3030 let js_bundle = EP.(load (env#fs / base_dir / "min.js")) in
3131 let favicon = EP.(load (theme_dir / "favicon.ico")) in
3232 let font_dir = EP.(native_exn @@ theme_dir / "fonts") in
3333- {stylesheet; index; js_bundle; font_dir; favicon;}
3333+ {stylesheet; htmx; js_bundle; font_dir; favicon;}
34343535let lookup_font ~env theme font =
3636 Eio.Path.(load (env#fs / theme.font_dir / font))
···3838let handler
3939 : env: < fs: [> Eio.Fs.dir_ty] Eio.Path.t; .. > ->
4040 theme: theme ->
4141- forest: _ ->
4242- 'a ->
4141+ forest: State.t ->
4242+ Cohttp_eio.Server.conn ->
4343 Http.Request.t ->
4444 Cohttp_eio.Body.t ->
4545 Cohttp_eio.Server.response
···7373 in
7474 Cohttp_eio.Server.respond_string ~headers ~status: `OK ~body ()
7575 | Stylesheet ->
7676- let headers = Http.Header.of_list ["Content-Type", "text/css"] in
7676+ let headers = Http.Header.of_list ["Content-Type", "text/css"; "charset", "utf-8"] in
7777 Cohttp_eio.Server.respond_string ~headers ~status: `OK ~body: theme.stylesheet ()
7878 | Js_bundle ->
7979 let headers = Http.Header.of_list ["Content-Type", "application/javascript"] in
8080 Cohttp_eio.Server.respond_string ~headers ~status: `OK ~body: theme.js_bundle ()
8181 | Index ->
8282- Cohttp_eio.Server.respond_string ~status: `OK ~body: theme.index ()
8282+ Cohttp_eio.Server.respond_string ~status: `OK ~body: (Pure_html.to_string (Index.v ())) ()
8383 | Favicon ->
8484 let headers = Http.Header.of_list ["Content-Type", "image/x-icon"] in
8585 Cohttp_eio.Server.respond_string ~headers ~status: `OK ~body: theme.favicon ()
8686 | Tree s ->
8787- let iri = Iri_scheme.user_iri ~host: State.(forest.config.host) s in
8787+ let href = Iri_scheme.user_iri ~host: State.(forest.config.host) s in
8888+ let request_headers = Http.Request.headers request in
8989+ let is_htmx = Option.is_some @@ Http.Header.get request_headers "Hx-Request" in
8890 begin
8989- match Forest.get_article iri forest.resources with
9090- | None -> Cohttp_eio.Server.respond_string ~status: `Not_found ~body: "" ()
9191- | Some article ->
9292- let content = Pure_html.to_string @@ Htmx_client.render_article forest article in
9393- Cohttp_eio.Server.respond_string ~status: `OK ~body: content ()
9191+ if is_htmx then
9292+ (* If it is an HTMX request, we just send a fragment. *)
9393+ begin
9494+ match Headers.parse_content_target request_headers with
9595+ | None ->
9696+ begin
9797+ match Forest.get_article href forest.resources with
9898+ | None -> Cohttp_eio.Server.respond_string ~status: `Not_found ~body: "" ()
9999+ | Some content ->
100100+ let response =
101101+ Pure_html.(
102102+ to_string @@
103103+ (Htmx_client.render_article forest content)
104104+ )
105105+ in
106106+ Cohttp_eio.Server.respond_string ~status: `OK ~body: response ()
107107+ end
108108+ | Some target ->
109109+ let modifier = Option.value ~default: T.Identity (Headers.parse_modifier request_headers) in
110110+ match Forest.get_content_of_transclusion
111111+ {target; href; modifier;}
112112+ forest.resources with
113113+ | None -> Cohttp_eio.Server.respond_string ~status: `Not_found ~body: "" ()
114114+ | Some content ->
115115+ let response =
116116+ Pure_html.(
117117+ to_string @@
118118+ HTML.span [] (Htmx_client.render_content forest content)
119119+ )
120120+ in
121121+ Cohttp_eio.Server.respond_string ~status: `OK ~body: response ()
122122+ end
123123+ else
124124+ (* If it is not an HTMX request, we need to send the whole page. *)
125125+ match Forest.get_article href forest.resources with
126126+ | Some article ->
127127+ let content =
128128+ Pure_html.to_string @@
129129+ Index.v
130130+ ~c: (Htmx_client.render_article forest article)
131131+ ()
132132+ in
133133+ let headers = Http.Header.of_list ["Content-Type", "text/html"] in
134134+ Cohttp_eio.Server.respond_string ~headers ~status: `OK ~body: content ()
135135+ | None -> Cohttp_eio.Server.respond_string ~status: `Not_found ~body: "" ()
94136 end
95137 | Search ->
96138 if request.meth = `POST then
···133175 Cohttp_eio.Server.respond_string ~status: `OK ~body: "" ()
134176 | Some home_tree ->
135177 let content = Pure_html.to_string @@ Htmx_client.render_article forest home_tree in
136136- Cohttp_eio.Server.respond_string ~status: `OK ~body: content ()
178178+ let headers = Http.Header.of_list ["Content-Type", "text/html"] in
179179+ Cohttp_eio.Server.respond_string ~headers ~status: `OK ~body: content ()
137180 end
138181 | Query ->
139182 let q = Uri.get_query_param resource "query" in
···148191 let (_, _, result) = State_machine.update (Query q) forest in
149192 begin
150193 match result with
151151- | Vertex_set vs ->
152152- Htmx_client.render_query_result forest vs
194194+ | Vertex_set vs -> Htmx_client.render_query_result forest vs
153195 | Got _
154196 | Error _
155197 | Nothing ->
156156- [Pure_html.txt "failed to run"]
198198+ None
199199+ (* Pure_html.txt "failed to run" *)
157200 end
158201 | Error (`Msg str) ->
159159- [Pure_html.txt "failed to parse: %s" str]
202202+ Logs.app (fun m -> m "failed to parse: %s" str);
203203+ (* Pure_html.txt "failed to parse: %s" str *)
204204+ None
160205 in
161161- Cohttp_eio.Server.respond_string
162162- ~status: `OK
163163- ~body: (
164164- Format.asprintf
165165- "%a"
166166- Pure_html.pp
167167- (Pure_html.HTML.ul [] response)
168168- )
169169- ()
206206+ begin
207207+ match response with
208208+ | Some nodes ->
209209+ Cohttp_eio.Server.respond_string
210210+ ~status: `OK
211211+ ~body: (Format.asprintf "%a" Pure_html.pp nodes)
212212+ ()
213213+ | None ->
214214+ (* If result is empty, use
215215+ [hx-retarget](https://htmx.org/reference/#response_headers) to
216216+ hide the entire section. Right now I am just trying to get the
217217+ backmatter to render correctly, I don't know if this is
218218+ compatible with the other use cases of queries. I can think of
219219+ multiple ways to work around this. We could use a separate
220220+ endpoint to get the backmatter, or we could do some more
221221+ HTMXing. I guess the question boils down to which approach is
222222+ more in line with our overarching goal of making forester a
223223+ genuine hypermedia format
224224+ *)
225225+ let headers =
226226+ Http.Header.of_list
227227+ [
228228+ "Hx-Retarget", "closest section.backmatter-section";
229229+ "Hx-Swap", "delete"
230230+ ]
231231+ in
232232+ Cohttp_eio.Server.respond_string
233233+ ~headers
234234+ ~status: `OK
235235+ ~body: ""
236236+ ()
237237+ end
238238+ | Htmx ->
239239+ let headers = Http.Header.of_list ["Content-Type", "application/javascript"] in
240240+ Cohttp_eio.Server.respond_string ~headers ~status: `OK ~body: theme.htmx ()
170241 end
171242 | Routes.NoMatch ->
172243 Cohttp_eio.Server.respond_string ~status: `Not_found ~body: "" ()