ocaml
0
fork

Configure Feed

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

Html_client: simplify use of effects

+39 -49
+39 -49
lib/frontend/Html_client.ml
··· 17 17 end 18 18 19 19 module Xmlns = Xmlns_effect.Make () 20 - 21 - module Scope = Algaeff.Reader.Make (struct 22 - type t = URI.t option 23 - end) 24 - 25 - module Section_depth = Algaeff.Reader.Make (struct 26 - type t = int 27 - end) 28 - 29 20 module Loop_detection = Loop_detection_effect.Make () 30 21 31 - let hx attrs children = 32 - P.std_tag 33 - (Format.sprintf "h%i" @@ min 6 @@ Section_depth.read ()) 34 - attrs children 22 + type env = {forest: State.t; scope: URI.t option; section_depth: int} 35 23 36 - let incr_section_depth k = 37 - let i = Section_depth.read () in 38 - Section_depth.run ~env:(i + 1) k 24 + let hx ~env attrs children = 25 + P.std_tag (Format.sprintf "h%i" @@ min 6 env.section_depth) attrs children 39 26 40 27 let route uri = URI.to_string uri 41 28 42 - let get_expanded_title frontmatter forest = 43 - let scope = Scope.read () in 44 - State.get_expanded_title ?scope 29 + let get_expanded_title ~env frontmatter forest = 30 + State.get_expanded_title ?scope:env.scope 45 31 ~flags:T.{empty_when_untitled = true} 46 32 frontmatter forest 47 33 ··· 59 45 let attr = match prefix with "" -> "xmlns" | _ -> "xmlns:" ^ prefix in 60 46 P.string_attr attr "%s" xmlns 61 47 62 - let rec render_content (forest : State.t) (Content content : T.content) : 63 - P.node list = 48 + let rec render_content ~env (Content content : T.content) : P.node list = 64 49 match content with 65 50 | T.Text txt0 :: T.Text txt1 :: content -> 66 - render_content forest (Content (T.Text (txt0 ^ txt1) :: content)) 51 + render_content ~env @@ Content (T.Text (txt0 ^ txt1) :: content) 67 52 | node :: content -> 68 - let xs = render_content_node forest node in 69 - let ys = render_content forest (Content content) in 53 + let xs = render_content_node ~env node in 54 + let ys = render_content ~env (Content content) in 70 55 xs @ ys 71 56 | [] -> [] 72 57 73 - and render_content_node (forest : State.t) (node : 'a T.content_node) : 74 - P.node list = 75 - let config = forest.config in 58 + and render_content_node ~env (node : 'a T.content_node) : P.node list = 59 + let config = env.forest.config in 76 60 match node with 77 61 | Text str -> [P.txt "%s" str] 78 62 | CDATA str -> [P.txt ~raw:true "<![CDATA[%s]]>" str] ··· 81 65 let prefixes_to_add, (name, attrs, content) = 82 66 let@ () = Xmlns.within_scope in 83 67 ( render_xml_qname elt.name, 84 - List.map (render_xml_attr forest) elt.attrs, 85 - render_content forest elt.content ) 68 + List.map (render_xml_attr env.forest) elt.attrs, 69 + render_content ~env elt.content ) 86 70 in 87 71 let attrs = 88 72 let xmlns_attrs = List.map render_xmlns_prefix prefixes_to_add in ··· 92 76 | Route_of_uri uri -> [P.txt "%s" (route uri)] 93 77 | Contextual_number uri -> 94 78 let custom_number = 95 - let@ resource = Option.bind @@ forest.@{uri} in 79 + let@ resource = Option.bind @@ env.forest.@{uri} in 96 80 match resource with 97 81 | T.Article article -> article.frontmatter.number 98 82 | _ -> None ··· 101 85 | None -> [P.txt "%s" @@ URI.relative_path_string ~base:config.url uri] 102 86 | Some num -> [P.txt "%s" num] 103 87 end 104 - | KaTeX (_, content) -> [P.HTML.code [] @@ render_content forest content] 105 - | Artefact artefact -> render_content forest @@ artefact.content 106 - | Section section -> render_section forest section 107 - | Transclude transclusion -> render_transclusion forest transclusion 108 - | Link link -> render_link forest link 88 + | KaTeX (_, content) -> [P.HTML.code [] @@ render_content ~env content] 89 + | Artefact artefact -> render_content ~env @@ artefact.content 90 + | Section section -> render_section ~env section 91 + | Transclude transclusion -> render_transclusion ~env transclusion 92 + | Link link -> render_link ~env link 109 93 | Results_of_datalog_query _ -> [] (* TODO: just make a list of links *) 110 94 | Datalog_script _ -> [] 111 95 112 - and render_link (forest : State.t) (link : T.content T.link) : P.node list = 96 + and render_link ~env (link : T.content T.link) : P.node list = 113 97 [ 114 98 P.HTML.a [P.HTML.href "%s" (Format.asprintf "%a" URI.pp link.href)] 115 - @@ render_content forest link.content; 99 + @@ render_content ~env link.content; 116 100 ] 117 101 118 - and render_transclusion (forest : State.t) (transclusion : T.transclusion) : 119 - P.node list = 120 - match State.get_content_of_transclusion transclusion forest with 102 + and render_transclusion ~env (transclusion : T.transclusion) : P.node list = 103 + match State.get_content_of_transclusion transclusion env.forest with 121 104 | None -> Reporter.fatal (Resource_not_found transclusion.href) 122 - | Some content -> render_content forest content 105 + | Some content -> render_content ~env content 123 106 124 - and render_section forest (section : T.content T.section) : P.node list = 125 - let@ () = Scope.run ~env:section.frontmatter.uri in 126 - let@ () = incr_section_depth in 107 + and render_section ~env (section : T.content T.section) : P.node list = 108 + let env = 109 + { 110 + env with 111 + section_depth = env.section_depth + 1; 112 + scope = section.frontmatter.uri; 113 + } 114 + in 127 115 [ 128 116 P.HTML.section [] 129 117 [ 130 118 begin match section.frontmatter.title with 131 119 | None -> P.HTML.null [] 132 - | Some title -> P.HTML.header [] [hx [] @@ render_content forest title] 120 + | Some title -> 121 + P.HTML.header [] [hx ~env [] @@ render_content ~env title] 133 122 end; 134 123 (if Loop_detection.have_seen_uri_opt section.frontmatter.uri then 135 124 P.txt "Transclusion loop detected, rendering stopped." 136 125 else 137 126 let@ () = Loop_detection.add_seen_uri_opt section.frontmatter.uri in 138 - P.HTML.null @@ render_content forest section.mainmatter); 127 + P.HTML.null @@ render_content ~env section.mainmatter); 139 128 ]; 140 129 ] 141 130 142 131 let render_article_as_div ?(heading_level = 0) (forest : State.t) 143 132 (article : T.content T.article) : P.node = 144 - let@ () = Section_depth.run ~env:heading_level in 145 - let@ () = Scope.run ~env:article.frontmatter.uri in 133 + let env = 134 + {forest; section_depth = heading_level; scope = article.frontmatter.uri} 135 + in 146 136 let@ () = Loop_detection.run in 147 137 let reserved = [{prefix = ""; xmlns = "http://www.w3.org/1999/xhtml"}] in 148 138 let@ () = Xmlns.run ~reserved in ··· 150 140 (List.map render_xmlns_prefix reserved) 151 141 [ 152 142 (let@ () = Loop_detection.add_seen_uri_opt article.frontmatter.uri in 153 - P.HTML.null @@ render_content forest article.mainmatter); 143 + P.HTML.null @@ render_content ~env article.mainmatter); 154 144 ]