ocaml
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

Progress on Html_client

+432 -186
+3 -3
lib/frontend/Atom_client.ml
··· 76 76 let render_dates dates = try render_dates_exn dates with _ -> A.null [] 77 77 let string_of_content forest = Plain_text_client.string_of_content ~forest 78 78 79 - let render_attribution forest (attribution : _ T.attribution) = 79 + let render_attribution ~forest (attribution : _ T.attribution) = 80 80 let tag = 81 81 match attribution.role with 82 82 | T.Author -> A.author ··· 100 100 101 101 let render_attributions (forest : State.t) uri_opt attributions : P.node = 102 102 A.null 103 - @@ List.map (render_attribution forest) 103 + @@ List.map (render_attribution ~forest) 104 104 @@ Forest_util.collect_attributions forest uri_opt attributions 105 105 106 106 let get_embedded_articles (forest : State.t) (article : _ T.article) = ··· 142 142 end; 143 143 A.content 144 144 [A.type_ "xhtml"] 145 - [Html_client.render_article_as_div ~heading_level:1 forest article]; 145 + [Html_client.render_article_as_div ~heading_level:1 ~forest article]; 146 146 ] 147 147 148 148 let render_feed (forest : State.t) ~(source_uri : URI.t) ~(feed_uri : URI.t) :
+2
lib/frontend/Forester_frontend.ml
··· 9 9 module Config_parser = Config_parser 10 10 module Forester = Forester 11 11 module DSL = DSL 12 + module Loop_detection = Loop_detection 13 + module Html_client = Html_client 12 14 module Htmx_client = Htmx_client 13 15 module Plain_text_client = Plain_text_client 14 16 module Legacy_xml_client = Legacy_xml_client
+272 -43
lib/frontend/Html_client.ml
··· 14 14 module T = Types 15 15 module P = Pure_html 16 16 module X = Xml_forester 17 + module H = P.HTML 17 18 end 18 19 19 20 type env = { ··· 27 28 let hx ~env attrs children = 28 29 P.std_tag (Format.sprintf "h%i" @@ min 6 env.section_depth) attrs children 29 30 31 + let optional opt kont = match opt with None -> H.null [] | Some v -> kont v 32 + 33 + (* test if the Home navbar be rendered*) 34 + let is_root config uri = 35 + match uri with 36 + | None -> false 37 + | Some uri -> URI.equal (Config.home_uri config) uri 38 + 39 + let should_render_toc _article = false 40 + 30 41 let route uri = URI.to_string uri 31 42 32 - let get_expanded_title ~env frontmatter forest = 43 + let _get_expanded_title ~env frontmatter forest = 33 44 State.get_expanded_title ?scope:env.scope 34 45 ~flags:T.{empty_when_untitled = true} 35 46 frontmatter forest 36 47 48 + let render_date (date : Human_datetime.t) = 49 + let year = P.txt "%i" (Human_datetime.year date) in 50 + let month = 51 + match Human_datetime.month date with 52 + | None -> None 53 + | Some i -> ( 54 + match i with 55 + | 1 -> Some (P.txt "January") 56 + | 2 -> Some (P.txt "February") 57 + | 3 -> Some (P.txt "March") 58 + | 4 -> Some (P.txt "April") 59 + | 5 -> Some (P.txt "May") 60 + | 6 -> Some (P.txt "June") 61 + | 7 -> Some (P.txt "July") 62 + | 8 -> Some (P.txt "August") 63 + | 9 -> Some (P.txt "September") 64 + | 10 -> Some (P.txt "October") 65 + | 11 -> Some (P.txt "November") 66 + | 12 -> Some (P.txt "December") 67 + | _ -> assert false) 68 + in 69 + let day = 70 + match Human_datetime.day date with 71 + | None -> H.null [] 72 + | Some i -> P.txt "%i" i 73 + in 74 + H.li 75 + [H.class_ "meta-item"] 76 + [ 77 + H.a 78 + [H.class_ "link local"] 79 + [ 80 + Option.value ~default:(H.null []) month; 81 + (if Option.is_some month then P.txt " " else H.null []); 82 + day; 83 + (if Option.is_some month then P.txt ", " else H.null []); 84 + year; 85 + ]; 86 + ] 87 + 37 88 let render_xml_qname qname = 38 89 match qname.prefix with 39 90 | "" -> qname.uname ··· 96 147 | Results_of_datalog_query _ -> [] (* TODO: just make a list of links *) 97 148 | Datalog_script _ -> [] 98 149 99 - and render_link (forest : State.t) (link : T.content T.link) : P.node list = [ 150 + and render_link ~env (link : T.content T.link) : P.node list = [ 100 151 P.HTML.a 101 152 [ 102 153 P.HTML.href "%s" (URI.path_string link.href) 103 154 ] @@ 104 - render_content forest link.content 155 + render_content ~env link.content 105 156 ] 106 157 107 158 and render_transclusion ~env (transclusion : T.transclusion) : P.node list = ··· 109 160 | None -> Reporter.fatal (Resource_not_found transclusion.href) 110 161 | Some content -> render_content ~env content 111 162 112 - and render_section ~env (section : T.content T.section) : P.node list = 163 + and _render_section_for_atom_client ~env (section : T.content T.section) : P.node list = 113 164 let env = 114 165 { 115 166 env with ··· 118 169 } 119 170 in 120 171 [ 121 - P.HTML.section [] 172 + H.section [] 173 + [ 174 + begin match section.frontmatter.title with 175 + | None -> H.null [] 176 + | Some title -> 177 + H.header [] [hx ~env [] @@ render_content ~env title] 178 + end; 179 + begin if 180 + Loop_detection.have_seen_uri_opt section.frontmatter.uri env.loops 181 + then P.txt "Transclusion loop detected, rendering stopped." 182 + else 183 + H.null 184 + @@ render_content 185 + ~env: 186 + { 187 + env with 188 + loops = 189 + Loop_detection.add_seen_uri_opt section.frontmatter.uri 190 + env.loops; 191 + } 192 + section.mainmatter 193 + end; 194 + ]; 195 + ] 196 + 197 + and render_section ~env (section : T.content T.section) : P.node list = 198 + [ 199 + H.section [] 122 200 [ 123 201 begin match section.frontmatter.title with 124 202 | None -> P.HTML.null [] 125 203 | Some title -> 126 - P.HTML.header [] [hx ~env [] @@ render_content ~env title] 204 + H.header [] [hx ~env [] @@ render_content ~env title] 127 205 end; 128 206 begin if 129 207 Loop_detection.have_seen_uri_opt section.frontmatter.uri env.loops 130 208 then P.txt "Transclusion loop detected, rendering stopped." 131 209 else 132 - P.HTML.null 210 + H.null 133 211 @@ render_content 134 212 ~env: 135 213 { ··· 143 221 ]; 144 222 ] 145 223 146 - let render_article_as_div ?(heading_level = 0) (forest : State.t) 224 + let render_attributions ~env (attributions : T.content T.attribution list) = 225 + let render_attribution attribution = 226 + match attribution with 227 + | T.{vertex; _} -> ( 228 + match vertex with 229 + | T.Uri_vertex href -> 230 + let content = 231 + T.Content 232 + [T.Transclude {href; target = Title {empty_when_untitled = false}}] 233 + in 234 + H.null @@ render_link ~env T.{href; content} 235 + | T.Content_vertex content -> H.null @@ render_content ~env content) 236 + in 237 + let authors, contributors = 238 + attributions 239 + |> List.partition_map @@ fun a -> 240 + match T.(a.role) with T.Author -> Left a | Contributor -> Right a 241 + in 242 + H.li 243 + [H.class_ "meta-item"] 244 + [ 245 + H.address [H.class_ "author"] 246 + @@ List.map render_attribution authors 247 + @ begin if List.length contributors > 0 then 248 + [P.txt "with contributions from "] 249 + else [] 250 + end 251 + @ List.map render_attribution contributors; 252 + ] 253 + 254 + let render_article ~env (article : T.content T.article) : P.node 255 + = 256 + (* let@ () = Scope.run ~env:article.frontmatter.uri in *) 257 + H.article [] 258 + [ 259 + H.section [] 260 + (render_content ~env:{env with loops = Loop_detection.add_seen_uri_opt article.frontmatter.uri env.loops} article.mainmatter); 261 + ] 262 + 263 + let render_toc _article = H.ul [] [] 264 + 265 + (* Just used by the atom client *) 266 + let render_article_as_div ?(heading_level = 0) ~(forest : State.t) 147 267 (article : T.content T.article) : P.node = 148 268 let reserved = [{prefix = ""; xmlns = "http://www.w3.org/1999/xhtml"}] in 149 269 let env = ··· 155 275 xmlns = Xmlns.init ~reserved; 156 276 } 157 277 in 158 - P.HTML.div 278 + H.div 159 279 (List.map render_xmlns_prefix reserved) 280 + [H.null @@ render_content ~env article.mainmatter] 281 + 282 + let get_meta (frontmatter : T.content T.frontmatter) meta = 283 + List.find_map 284 + (fun (m, v) -> if m = meta then Some v else None) 285 + frontmatter.metas 286 + 287 + let default_meta_item ~env frontmatter meta = 288 + optional (get_meta frontmatter meta) (fun content -> 289 + H.li [H.class_ "meta-item"] (render_content ~env content)) 290 + 291 + let render_position ~env frontmatter = 292 + default_meta_item ~env frontmatter "position" 293 + 294 + let render_institution ~env frontmatter = 295 + default_meta_item ~env frontmatter "institution" 296 + 297 + let render_venue ~env frontmatter = 298 + default_meta_item ~env frontmatter "venue" 299 + 300 + let render_source ~env frontmatter = 301 + default_meta_item ~env frontmatter "source" 302 + 303 + let render_doi ~env frontmatter = 304 + optional (get_meta frontmatter "doi") (fun c -> 305 + let doi = Plain_text_client.string_of_content ~forest:env.forest c in 306 + H.li 307 + [H.class_ "meta-item"] 308 + [ 309 + H.a 310 + [H.class_ "doi"; H.href "https://www.doi.org/%s" doi] 311 + (render_content ~env c); 312 + ]) 313 + 314 + let render_orcid ~env frontmatter = 315 + optional (get_meta frontmatter "orcid") (fun c -> 316 + let orcid = Plain_text_client.string_of_content ~forest:env.forest c in 317 + H.li 318 + [H.class_ "meta-item"] 319 + [ 320 + H.a 321 + [H.class_ "orcid"; H.href "https://orcid.org/%s" orcid] 322 + (render_content ~env c); 323 + ]) 324 + 325 + let render_external ~env frontmatter = 326 + optional (get_meta frontmatter "external") (fun c -> 327 + let link = Plain_text_client.string_of_content ~forest:env.forest c in 328 + H.li 329 + [H.class_ "meta-item"] 330 + [ 331 + H.a 332 + [H.class_ "link external"; H.href "%s" link] 333 + (render_content ~env c); 334 + ]) 335 + 336 + let render_slides ~env frontmatter = 337 + optional (get_meta frontmatter "slides") (fun c -> 338 + let link = Plain_text_client.string_of_content ~forest:env.forest c in 339 + H.li 340 + [H.class_ "meta-item"] 341 + [H.a [H.class_ "link external"; H.href "%s" link] [P.txt "Slides"]]) 342 + 343 + let render_video ~env frontmatter = 344 + optional (get_meta frontmatter "video") (fun c -> 345 + let link = Plain_text_client.string_of_content ~forest:env.forest c in 346 + H.li 347 + [H.class_ "meta-item"] 348 + [H.a [H.class_ "link external"; H.href "%s" link] [P.txt "Video"]]) 349 + 350 + let render_frontmatter ~env (frontmatter : _ T.frontmatter) : 351 + P.node = 352 + H.header [] 160 353 [ 161 - P.HTML.null 162 - @@ render_content 163 - ~env: 164 - { 165 - env with 166 - loops = 167 - Loop_detection.add_seen_uri_opt article.frontmatter.uri 168 - env.loops; 169 - } 170 - article.mainmatter; 354 + H.h1 [] [H.span [H.class_ "taxon"] []]; 355 + H.div 356 + [H.class_ "metadata"] 357 + [ 358 + H.ul [] 359 + [ 360 + render_position ~env frontmatter; 361 + render_institution ~env frontmatter; 362 + render_venue ~env frontmatter; 363 + render_source ~env frontmatter; 364 + render_doi ~env frontmatter; 365 + render_orcid ~env frontmatter; 366 + render_external ~env frontmatter; 367 + render_slides ~env frontmatter; 368 + render_video ~env frontmatter; 369 + ]; 370 + ]; 171 371 ] 172 372 173 - let render_page (forest : State.t) (tree : _ T.article) : P.node = 174 - let@ () = Scope.run ~env: tree.frontmatter.uri in 373 + let render_page ~forest (tree : _ T.article) : P.node = 374 + let reserved = [{prefix = ""; xmlns = "http://www.w3.org/1999/xhtml"}] in 375 + let env = 376 + { 377 + forest; 378 + section_depth = 0; 379 + scope = tree.frontmatter.uri; 380 + loops = Loop_detection.empty; 381 + xmlns = Xmlns.init ~reserved; 382 + } 383 + in 175 384 let ttl = 176 385 match tree.frontmatter.title with 177 - | None -> P.HTML.null [] 386 + | None -> H.null [] 178 387 | Some _ -> 179 - let title = State.get_expanded_title ?scope: (Scope.read ()) tree.frontmatter forest in 180 - P.HTML.title [] "%s" @@ Plain_text_client.string_of_content ~forest title 388 + let title = 389 + State.get_expanded_title ?scope:env.scope tree.frontmatter env.forest 390 + in 391 + H.title [] "%s" @@ Plain_text_client.string_of_content ~forest:env.forest title 181 392 in 182 - let open P.HTML in 183 - html 184 - [] 393 + let open H in 394 + html [] 185 395 [ 186 - head 187 - [] 396 + head [] 188 397 [ 189 398 meta [http_equiv `content_type; content "text/html"; charset "UTF-8"]; 190 399 meta 191 - [ 192 - name "viewport"; 193 - content "width=device-width, initial-scale=1.0" 194 - ]; 195 - link 196 - [ 197 - rel "stylesheet"; 198 - href "/style.css" 199 - ]; 400 + [name "viewport"; content "width=device-width, initial-scale=1.0"]; 401 + link [rel "stylesheet"; href "/style.css"]; 200 402 link [rel "stylesheet"; href "/katex.min.css"]; 201 403 script [type_ "module"; src "/forester.js"] ""; 202 404 ttl; 203 405 ]; 204 - body 205 - [] 406 + body [] 206 407 [ 207 - P.std_tag "ninja-keys" [placeholder "Start typing a note title or ID"][]; 208 - render_article_as_div forest tree 209 - ] 408 + P.std_tag "ninja-keys" 409 + [placeholder "Start typing a note title or ID"] 410 + []; 411 + (if is_root env.forest.config tree.frontmatter.uri then null [] 412 + else 413 + header 414 + [class_ "header"] 415 + [ 416 + nav 417 + [class_ "nav"] 418 + [ 419 + div 420 + [class_ "logo"] 421 + [a [href "index.html"; title_ "home"] [P.txt "« Home"]]; 422 + ]; 423 + ]); 424 + div 425 + [id "grid-wrapper"] 426 + [ 427 + render_article ~env tree; 428 + (if should_render_toc article then 429 + nav 430 + [id "toc"] 431 + [ 432 + div 433 + [class_ "block"] 434 + [h1 [] [P.txt "Table of Contents"]; render_toc article]; 435 + ] 436 + else null []); 437 + ]; 438 + ]; 210 439 ]
+72 -121
lib/frontend/Htmx_client.ml
··· 5 5 *) 6 6 7 7 open Forester_prelude 8 - open Forester_xml_names 9 8 open Forester_core 10 9 open Forester_compiler 10 + open Forester_xml_names 11 11 12 12 open struct 13 13 module T = Types 14 + module P = Pure_html 15 + let render_date = Html_client.render_date 16 + let render_attributions = Html_client.render_attributions 14 17 end 15 18 16 19 open Pure_html ··· 20 23 query: (string, T.content T.vertex) Forester_core.Datalog_expr.query; 21 24 } 22 25 [@@deriving repr] 23 - 24 - module Xmlns = Xmlns_effect.Make () 25 26 26 27 let local_path_components (uri : URI.t) = 27 28 let host = ··· 95 96 let attr = match prefix with "" -> "xmlns" | _ -> "xmlns:" ^ prefix in 96 97 string_attr attr "%s" xmlns 97 98 98 - let render_date (date : Human_datetime.t) = 99 - let year = txt "%i" (Human_datetime.year date) in 100 - let month = 101 - match Human_datetime.month date with 102 - | None -> None 103 - | Some i -> ( 104 - match i with 105 - | 1 -> Some (txt "January") 106 - | 2 -> Some (txt "February") 107 - | 3 -> Some (txt "March") 108 - | 4 -> Some (txt "April") 109 - | 5 -> Some (txt "May") 110 - | 6 -> Some (txt "June") 111 - | 7 -> Some (txt "July") 112 - | 8 -> Some (txt "August") 113 - | 9 -> Some (txt "September") 114 - | 10 -> Some (txt "October") 115 - | 11 -> Some (txt "November") 116 - | 12 -> Some (txt "December") 117 - | _ -> assert false) 118 - in 119 - let day = 120 - match Human_datetime.day date with None -> null [] | Some i -> txt "%i" i 121 - in 122 - li 123 - [class_ "meta-item"] 124 - [ 125 - a 126 - [class_ "link local"] 127 - [ 128 - Option.value ~default:(null []) month; 129 - (if Option.is_some month then txt " " else null []); 130 - day; 131 - (if Option.is_some month then txt ", " else null []); 132 - year; 133 - ]; 134 - ] 135 - 136 99 (*This type is just temporary until I figure out the logic *) 137 100 type toc_config = { 138 101 suffix: string; ··· 158 121 implicitly_unnumbered = false; 159 122 } 160 123 161 - let rec render_article (forest : State.t) (article : T.content T.article) : node 124 + let rec render_article ~(forest : State.t) (article : T.content T.article) : node 162 125 = 163 126 (* FIXME: What should reserved be here? *) 164 - let@ () = Xmlns.run ~reserved:[] in 127 + 128 + let reserved = [{prefix = ""; xmlns = "http://www.w3.org/1999/xhtml"}] in 129 + let env : Html_client.env = 130 + { 131 + forest; 132 + section_depth = 0; 133 + scope = article.frontmatter.uri; 134 + loops = Loop_detection.empty; 135 + xmlns = Xmlns.init ~reserved; 136 + } 137 + in 165 138 HTML.article 166 139 [id "tree-container"] 167 140 [ ··· 170 143 [class_ "block"] 171 144 [ 172 145 details [(* TODO: check if expanded*) open_] 173 - @@ summary [] [render_frontmatter forest article.frontmatter] 174 - :: render_content forest article.mainmatter; 146 + @@ summary [] [render_frontmatter ~env article.frontmatter] 147 + :: render_content ~env article.mainmatter; 175 148 ]; 176 149 (match article.frontmatter.uri with 177 - | None -> footer [] @@ render_backmatter forest article.backmatter 150 + | None -> footer [] @@ render_backmatter ~env article.backmatter 178 151 | Some uri -> 179 - if URI.equal (Config.home_uri forest.config) uri then null [] 180 - else footer [] @@ render_backmatter forest article.backmatter); 152 + if URI.equal (Config.home_uri env.forest.config) uri then null [] 153 + else footer [] @@ render_backmatter ~env article.backmatter); 181 154 ] 182 155 183 - and render_section (forest : State.t) (section : T.content T.section) : node = 156 + and render_section ~env (section : T.content T.section) : node = 184 157 match section with 185 158 | {frontmatter; mainmatter; flags} -> 186 159 let test k = function ··· 205 178 details 206 179 [(if test true flags.expanded then open_ else null_)] 207 180 [ 208 - summary [] [render_frontmatter forest frontmatter]; 209 - null @@ render_content forest mainmatter; 181 + summary [] [render_frontmatter ~env frontmatter]; 182 + null @@ render_content ~env mainmatter; 210 183 ] 211 - else null @@ render_content forest mainmatter); 184 + else null @@ render_content ~env mainmatter); 212 185 (* render_frontmatter forest frontmatter; *) 213 186 (* null @@ render_content forest mainmatter; *) 214 187 ] 215 188 216 189 (* Same as render_section, but adds the backmatter-section class *) 217 - and render_backmatter (forest : State.t) backmatter = 218 - let@ node = List.map @~ render_content forest backmatter in 190 + and render_backmatter ~env backmatter = 191 + let@ node = List.map @~ render_content ~env backmatter in 219 192 let attrs = Format.asprintf "%s backmatter-section" node.@["class"] in 220 193 node +@ class_ "%s" attrs 221 194 222 - and render_attributions forest (attributions : T.content T.attribution list) = 223 - let render_attribution attribution = 224 - match attribution with 225 - | T.{vertex; _} -> ( 226 - match vertex with 227 - | T.Uri_vertex href -> 228 - let content = 229 - T.Content 230 - [T.Transclude {href; target = Title {empty_when_untitled = false}}] 231 - in 232 - null @@ render_link forest T.{href; content} 233 - | T.Content_vertex content -> null @@ render_content forest content) 234 - in 235 - let authors, contributors = 236 - attributions 237 - |> List.partition_map @@ fun a -> 238 - match T.(a.role) with T.Author -> Left a | Contributor -> Right a 239 - in 240 - li 241 - [class_ "meta-item"] 242 - [ 243 - address [class_ "author"] 244 - @@ List.map render_attribution authors 245 - @ begin if List.length contributors > 0 then 246 - [txt "with contributions from "] 247 - else [] 248 - end 249 - @ List.map render_attribution contributors; 250 - ] 251 - 252 - and render_frontmatter (forest : State.t) 195 + and render_frontmatter ~env 253 196 (frontmatter : T.content T.frontmatter) : node = 254 197 let taxon = 255 198 Option.value ~default:[] 256 199 @@ 257 200 let@ c = Option.map @~ frontmatter.taxon in 258 - render_content forest c @ [txt ". "] 201 + render_content ~env c @ [txt ". "] 259 202 in 260 203 let title = 261 204 Option.value ~default:[] 262 205 @@ 263 206 let@ c = Option.map @~ frontmatter.title in 264 - render_content forest c 207 + render_content ~env c 265 208 in 266 209 let uri = 267 210 match frontmatter.uri with ··· 269 212 | Some uri -> 270 213 let uri_str = 271 214 (* TODO: replace with proper routing from legacy xml client *) 272 - Format.asprintf "%a" URI.pp (route forest uri) 215 + Format.asprintf "%a" URI.pp (route env.forest uri) 273 216 in 274 217 a [class_ "slug"; href "%s" uri_str] [txt "[%s]" uri_str] 275 218 in ··· 287 230 Option.value ~default:(null []) (Option.map f (find_meta key)) 288 231 in 289 232 let default_meta_item content = 290 - li [class_ "meta-item"] (render_content forest content) 233 + li [class_ "meta-item"] (render_content ~env content) 291 234 in 292 235 let labelled_external_link ~href ~label = 293 236 li [class_ "meta-item"] [a [class_ "link external"; href] [txt "%s" label]] 294 237 in 295 238 let to_string = 296 - Plain_text_client.string_of_content ~forest 297 - ~router:(Legacy_xml_client.route forest) 239 + Plain_text_client.string_of_content ~forest:env.forest 240 + ~router:(Legacy_xml_client.route env.forest) 298 241 in 299 242 let position = render_meta "position" default_meta_item in 300 243 let institution = render_meta "institution" default_meta_item in ··· 340 283 ul [] 341 284 @@ List.map render_date frontmatter.dates 342 285 @ [ 343 - render_attributions forest frontmatter.attributions; 286 + render_attributions ~env frontmatter.attributions; 344 287 position; 345 288 institution; 346 289 venue; ··· 372 315 [txt "transclusion: %s" (Format.asprintf "%a" URI.pp href)]; 373 316 ] 374 317 375 - and render_content (forest : State.t) (Content content : T.content) : node list 318 + and render_content ~env (Content content : T.content) : node list 376 319 = 377 - List.concat_map (render_content_node forest) content 320 + List.concat_map (render_content_node ~env) content 378 321 379 - and render_content_node (forest : State.t) (node : 'a T.content_node) : 322 + and render_content_node ~env (node : 'a T.content_node) : 380 323 node list = 381 324 match node with 382 325 | Text str -> [txt "%s" str] 383 326 | CDATA str -> [txt ~raw:true "<![CDATA[%s]]>" str] 384 327 | Xml_elt elt -> 385 - let prefixes_to_add, (name, attrs, content) = 386 - let@ () = Xmlns.within_scope in 387 - ( render_xml_qname elt.name, 388 - List.map render_xml_attr elt.attrs, 389 - render_content forest elt.content ) 390 - in 391 - let attrs = 392 - let xmlns_attrs = List.map render_xmlns_prefix prefixes_to_add in 393 - attrs @ xmlns_attrs 394 - in 395 - [std_tag name attrs content] 328 + let name = render_xml_qname elt.name in 329 + let xmlns_attrs = Xmlns.xmlns_attrs_for_elt elt env.xmlns in 330 + let env = {env with xmlns = Xmlns.extend xmlns_attrs env.xmlns} in 331 + let content = render_content ~env elt.content in 332 + [ 333 + P.std_tag name 334 + (List.map render_xmlns_prefix xmlns_attrs 335 + @ List.map render_xml_attr elt.attrs) 336 + content; 337 + ] 396 338 | Transclude transclusion -> render_transclusion transclusion 397 339 | Contextual_number addr -> begin 398 - match (State.get_article addr) forest with 340 + match (State.get_article addr) env.forest with 399 341 | Some a -> 400 342 [contextual_number (T.article_to_section a) (default_toc_config ())] 401 343 | None -> [] ··· 409 351 (* | Some num -> num *) 410 352 (* in *) 411 353 (* [txt "%s" num] *) 412 - | Link link -> render_link forest link 413 - | Section section -> [render_section forest section] 354 + | Link link -> render_link ~env link 355 + | Section section -> [render_section ~env section] 414 356 | KaTeX (mode, content) -> 415 - let body = Plain_text_client.string_of_content ~forest content in 357 + let body = Plain_text_client.string_of_content ~forest:env.forest content in 416 358 (* [txt ~raw: true "%s%s%s" l body r] *) 417 359 begin match mode with 418 360 | Inline -> [span [class_ "math"] [txt ~raw:true "%s" body]] ··· 435 377 | T.Artefact _ | T.Uri _ | T.Route_of_uri _ -> [txt "todo"] 436 378 437 379 (* TODO: links need to be flattened in order to produce valid HTML. *) 438 - and render_link (forest : State.t) (link : T.content T.link) : node list = 380 + and render_link ~env (link : T.content T.link) : node list = 439 381 let attrs = 440 - match State.get_article link.href forest with 382 + match State.get_article link.href env.forest with 441 383 | None -> 442 384 (* TODO: rendering of hrefs is suboptimal... *) 443 385 [href "%s" (Format.asprintf "%a" URI.pp link.href)] ··· 447 389 [ 448 390 title_ "%s" @@ Option.value ~default:"" 449 391 @@ Option.map 450 - (Plain_text_client.string_of_content ~forest 451 - ~router:(Legacy_xml_client.route forest)) 392 + (Plain_text_client.string_of_content ~forest:env.forest 393 + ~router:(Legacy_xml_client.route env.forest)) 452 394 article.frontmatter.title; 453 395 href "/trees%s" (Format.asprintf "%s" (URI.path_string link.href)); 454 396 Hx.target "#tree-container"; ··· 457 399 | None -> [HTML.null_] 458 400 end 459 401 in 460 - [span [class_ "link local"] [a attrs (render_content forest link.content)]] 402 + [span [class_ "link local"] [a attrs (render_content ~env link.content)]] 461 403 462 404 and contextual_number (_tree : T.content T.section) (cfg : toc_config) = 463 405 let should_number = ··· 496 438 (*TODO: Implement.*) 497 439 contextual_number _tree cfg 498 440 499 - and _render_toc_item (forest : State.t) (item : T.content T.section) = 441 + and _render_toc_item ~(env: Html_client.env) (item : T.content T.section) = 500 442 let to_str = 501 - Plain_text_client.string_of_content ~forest 502 - ~router:(Legacy_xml_client.route forest) 443 + Plain_text_client.string_of_content ~forest:env.forest 444 + ~router:(Legacy_xml_client.route env.forest) 503 445 in 504 446 null 505 447 [ ··· 522 464 [_tree_taxon_with_number item (default_toc_config ())]; 523 465 (* null @@ render_content forest item.mainmatter; *) 524 466 ]; 525 - ul [] (render_content forest item.mainmatter); 467 + ul [] (render_content ~env item.mainmatter); 526 468 ] 527 469 528 470 and render_toc_mainmatter content = ··· 552 494 ]; 553 495 ] 554 496 555 - let render_query_result (forest : State.t) (vs : Vertex_set.t) = 497 + let render_query_result ~forest (vs : Vertex_set.t) = 556 498 let module C = Types.Comparators (struct 557 499 let string_of_content = 558 500 Plain_text_client.string_of_content ~forest ~router:(route forest) 559 501 end) in 502 + let env : Html_client.env = 503 + { 504 + forest; 505 + section_depth = 0; 506 + scope = None; 507 + loops = Loop_detection.empty; 508 + xmlns = Xmlns.init ~reserved: [{prefix = ""; xmlns = "http://www.w3.org/1999/xhtml"}]; 509 + } 510 + in 560 511 let make_section = 561 512 T.article_to_section 562 513 ~flags: ··· 574 525 |> Seq.filter_map (State.get_article @~ forest) 575 526 |> List.of_seq 576 527 |> List.sort C.compare_article 577 - |> List.map (Fun.compose (render_section forest) make_section) 528 + |> List.map (Fun.compose (render_section ~env) make_section) 578 529 in 579 530 if List.length nodes = 0 then None 580 531 else Some (div [class_ "tree-content"] nodes)
+53 -10
lib/frontend/Htmx_client.mli
··· 8 8 open Forester_compiler 9 9 module T := Types 10 10 11 - type query = { 12 - query: (string, T.content T.vertex) Forester_core.Datalog_expr.query; 13 - } 11 + (* type query = { *) 12 + (* query : (string, T.content T.vertex) Forester_core.Datalog_expr.query; *) 13 + (* } *) 14 + (* val query_t : query Repr.ty *) 15 + (* val local_path_components : Forester_core.URI.t -> string list *) 16 + (* val route : *) 17 + (* State.t -> Forester_core.URI.t -> Forester_core.URI.t *) 18 + (* val title_flags_to_http_header : *) 19 + (* T.title_flags -> [> `Assoc of (string * [> `String of string ]) list ] *) 20 + (* val section_flags_to_http_header : *) 21 + (* T.section_flags -> [> `Assoc of (string * [> `String of string ]) list ] *) 22 + (* val content_target_to_http_header : *) 23 + (* T.content_target -> [> `Assoc of (string * [> `String of string ]) list ] *) 24 + (* val render_xml_qname : Forester_xml_names.xml_qname -> string *) 25 + (* val render_xml_attr : T.content T.xml_attr -> Pure_html.attr *) 26 + (* val render_xmlns_prefix : Forester_xml_names.xmlns_attr -> Pure_html.attr *) 27 + (* type toc_config = { *) 28 + (* suffix : string; *) 29 + (* taxon : string; *) 30 + (* number : string; *) 31 + (* fallback_number : string; *) 32 + (* in_backmatter : bool; *) 33 + (* is_root : bool; *) 34 + (* implicitly_unnumbered : bool; *) 35 + (* } *) 36 + (* val default_toc_config : *) 37 + (* ?suffix:string -> *) 38 + (* ?taxon:string -> *) 39 + (* ?number:string -> *) 40 + (* ?fallback_number:string -> ?in_backmatter:bool -> unit -> toc_config *) 41 + val render_article : 42 + forest:State.t-> T.content T.article -> Pure_html.node 43 + (* val render_section : *) 44 + (* env:Html_client.env -> T.content T.section -> Pure_html.node *) 45 + (* val render_backmatter : *) 46 + (* env:Html_client.env -> T.content -> Pure_html.node list *) 47 + (* val render_frontmatter : *) 48 + (* env:Html_client.env -> T.content T.frontmatter -> Pure_html.node *) 49 + (* val render_transclusion : T.transclusion -> Pure_html.node list *) 50 + val render_content : env:Html_client.env -> T.content -> Pure_html.node list 51 + (* val render_content_node : *) 52 + (* env:Html_client.env -> T.content T.content_node -> Pure_html.node list *) 53 + (* val render_link : *) 54 + (* env:Html_client.env -> T.content T.link -> Pure_html.node list *) 55 + (* val contextual_number : T.content T.section -> toc_config -> Pure_html.node *) 56 + (* val _tree_taxon_with_number : *) 57 + (* T.content T.section -> toc_config -> Pure_html.node *) 58 + (* val _render_toc_item : *) 59 + (* env:Html_client.env -> T.content T.section -> Pure_html.node *) 60 + val render_toc_mainmatter : T.content -> Pure_html.node 61 + (* val render_toc : T.content T.section -> Pure_html.node *) 62 + val render_query_result : 63 + forest:State.t -> Forester_core.Vertex_set.t -> Pure_html.node option 14 64 15 - val query_t : query Repr.t 16 - val route : State.t -> URI.t -> URI.t 17 - val render_article : State.t -> T.content T.article -> Pure_html.node 18 - val render_content : State.t -> T.content -> Pure_html.node list 19 - val render_frontmatter : State.t -> T.content T.frontmatter -> Pure_html.node 20 - val render_query_result : State.t -> Vertex_set.t -> Pure_html.node option 21 - val render_toc : T.content T.section -> Pure_html.node
+3 -3
lib/server/Search_menu.ml
··· 57 57 in 58 58 Pure_html.to_string markup 59 59 60 - let results (forest : State.t) (links : URI.t list) = 60 + let results ~( env: Html_client.env) (links : URI.t list) = 61 61 Pure_html.to_string 62 62 @@ ul 63 63 [id "search-results"] ··· 66 66 let title = 67 67 State.get_content_of_transclusion 68 68 {href = uri; target = Title {empty_when_untitled = false}} 69 - forest 69 + env.forest 70 70 in 71 71 Option.map 72 72 (fun t -> ··· 77 77 Hx.target "#tree-container"; 78 78 Hx.swap "outerHTML"; 79 79 ] 80 - @@ Htmx_client.render_content forest t) 80 + @@ Htmx_client.render_content ~env t) 81 81 title) 82 82 links)
+26 -6
lib/server/Server.ml
··· 8 8 open Forester_core 9 9 open Forester_compiler 10 10 open Forester_frontend 11 + open Forester_xml_names 11 12 12 13 open struct 13 14 module T = Types ··· 107 108 Cohttp_eio.Server.respond_string ~status:`Not_found ~body:"" () 108 109 | Some content -> 109 110 let response = 110 - Pure_html.to_string @@ Htmx_client.render_article forest content 111 + Pure_html.to_string @@ Htmx_client.render_article ~forest content 111 112 in 112 113 Cohttp_eio.Server.respond_string ~status:`OK ~body:response () 113 114 end ··· 117 118 Cohttp_eio.Server.respond_string ~status:`Not_found ~body:"" () 118 119 | Some content -> 119 120 (* TODO: Remove any sort of HTML generation from the handler. *) 121 + let env : Html_client.env = 122 + { 123 + forest; 124 + section_depth = 0; 125 + scope = Some href; 126 + loops = Loop_detection.empty; 127 + xmlns = Xmlns.init ~reserved: [{prefix = ""; xmlns = "http://www.w3.org/1999/xhtml"}]; 128 + } 129 + in 120 130 let response = 121 131 Pure_html.( 122 132 to_string 123 - @@ HTML.span [] (Htmx_client.render_content forest content)) 133 + @@ HTML.span [] (Htmx_client.render_content ~env content)) 124 134 in 125 135 Cohttp_eio.Server.respond_string ~status:`OK ~body:response ()) 126 136 end ··· 129 139 | Some article -> 130 140 let content = 131 141 Pure_html.to_string 132 - @@ Index.v ~c:(Htmx_client.render_article forest article) () 142 + @@ Index.v ~c:(Htmx_client.render_article ~forest article) () 133 143 in 134 144 let headers = Http.Header.of_list [("Content-Type", "text/html")] in 135 145 Cohttp_eio.Server.respond_string ~headers ~status:`OK ~body:content () ··· 162 172 | Some _ -> assert false 163 173 in 164 174 let response = 165 - Search_menu.results forest (List.map snd search_results) 175 + 176 + let env : Html_client.env = 177 + { 178 + forest; 179 + section_depth = 0; 180 + scope = None; 181 + loops = Loop_detection.empty; 182 + xmlns = Xmlns.init ~reserved: [{prefix = ""; xmlns = "http://www.w3.org/1999/xhtml"}]; 183 + } 184 + in 185 + Search_menu.results ~env (List.map snd search_results) 166 186 in 167 187 Cohttp_eio.Server.respond_string ~status:`OK ~body:response () 168 188 else ··· 176 196 | None -> Cohttp_eio.Server.respond_string ~status:`OK ~body:"" () 177 197 | Some home_tree -> 178 198 let content = 179 - Pure_html.to_string @@ Htmx_client.render_article forest home_tree 199 + Pure_html.to_string @@ Htmx_client.render_article ~forest home_tree 180 200 in 181 201 let headers = Http.Header.of_list [("Content-Type", "text/html")] in 182 202 Cohttp_eio.Server.respond_string ~headers ~status:`OK ~body:content () ··· 194 214 begin match None with 195 215 (* FIXME :*) 196 216 (* | `Vertex_set(vs : Vertex_set.t) -> Htmx_client.render_query_result forest vs *) 197 - | Some (`Vertex_set vs) -> Htmx_client.render_query_result forest vs 217 + | Some (`Vertex_set vs) -> Htmx_client.render_query_result ~forest vs 198 218 | _ -> None 199 219 end 200 220 | Error (`Msg str) ->
+1
lib/server/dune
··· 16 16 forester.compiler 17 17 forester.frontend 18 18 forester.search 19 + forester.xml_names 19 20 pure-html 20 21 logs 21 22 eio