+3 -1

arod/bin/dune

··· 16 logs.cli 17 fmt 18 fmt.tty 19 - fmt.cli)) 0 0

··· 16 logs.cli 17 fmt 18 fmt.tty 19 + fmt.cli 20 + ezjsonm 21 + sitemap))

+348 -245

arod/bin/main.ml

··· 6 (** Arod webserver - a tiny_httpd based server for Bushel content *) 7 8 open Tiny_httpd 9 - open Htmlit 10 11 (** {1 Logging} *) 12 13 let src = Logs.Src.create "arod" ~doc:"Arod webserver" 14 module Log = (val Logs.src_log src : Logs.LOG) 15 16 - (** {1 Request Handlers} *) 17 18 - let index_handler _req = 19 - let cfg = Arod.Model.get_config () in 20 - let page_content = 21 - El.div [ 22 - El.h1 [El.txt cfg.site.name]; 23 - El.p [El.txt cfg.site.description]; 24 - El.h2 [El.txt "Recent Notes"]; 25 - El.ul ( 26 - List.map (fun note -> 27 - El.li [ 28 - El.a ~at:[At.href (Arod.Model.Entry.site_url (`Note note))] [ 29 - El.txt (Arod.Model.Note.title note) 30 - ] 31 - ] 32 - ) (List.filteri (fun i _ -> i < 10) (Arod.Model.notes ())) 33 - ) 34 - ] 35 - in 36 - let html = Arod.Html.(to_page (page 37 - ~page_title:cfg.site.name 38 - ~description:cfg.site.description 39 - ~page_content 40 - ())) in 41 - Response.make_string (Ok html) 42 43 - let notes_handler _req = 44 - let cfg = Arod.Model.get_config () in 45 - let notes = Arod.Model.notes () in 46 - let page_content = 47 - El.div [ 48 - El.h1 [El.txt "Notes"]; 49 - El.div ~at:[At.class' "entries-list"] ( 50 - List.map (fun note -> 51 - let ent = `Note note in 52 - El.article ~at:[At.class' "entry-card"] [ 53 - Arod.Html.entry_href ent; 54 - Arod.Html.tags_meta ent; 55 - El.div ~at:[At.class' "entry-synopsis"] [ 56 - match Arod.Model.Note.synopsis note with 57 - | Some s -> El.p [El.txt s] 58 - | None -> El.splice [] 59 - ] 60 - ] 61 - ) notes 62 - ) 63 - ] 64 - in 65 - let html = Arod.Html.(to_page (page 66 - ~page_title:"Notes" 67 - ~description:(Printf.sprintf "Notes from %s" cfg.site.name) 68 - ~page_content 69 - ())) in 70 - Response.make_string (Ok html) 71 72 - let papers_handler _req = 73 - let cfg = Arod.Model.get_config () in 74 - let papers = Arod.Model.papers () in 75 - let page_content = 76 - El.div [ 77 - El.h1 [El.txt "Papers"]; 78 - El.div ~at:[At.class' "entries-list"] ( 79 - List.map (fun paper -> 80 - let ent = `Paper paper in 81 - El.article ~at:[At.class' "entry-card"] [ 82 - Arod.Html.entry_href ent; 83 - Arod.Html.tags_meta ent; 84 - ] 85 - ) papers 86 - ) 87 - ] 88 - in 89 - let html = Arod.Html.(to_page (page 90 - ~page_title:"Papers" 91 - ~description:(Printf.sprintf "Papers by %s" cfg.site.author_name) 92 - ~page_content 93 - ())) in 94 - Response.make_string (Ok html) 95 96 - let projects_handler _req = 97 - let cfg = Arod.Model.get_config () in 98 - let projects = Arod.Model.projects () in 99 - let page_content = 100 - El.div [ 101 - El.h1 [El.txt "Projects"]; 102 - El.div ~at:[At.class' "entries-list"] ( 103 - List.map (fun project -> 104 - let ent = `Project project in 105 - El.article ~at:[At.class' "entry-card"] [ 106 - Arod.Html.entry_href ent; 107 - Arod.Html.tags_meta ent; 108 - Arod.Html.full_body ent 109 - ] 110 - ) projects 111 - ) 112 - ] 113 - in 114 - let html = Arod.Html.(to_page (page 115 - ~page_title:"Projects" 116 - ~description:(Printf.sprintf "Projects from %s" cfg.site.name) 117 - ~page_content 118 - ())) in 119 - Response.make_string (Ok html) 120 121 - let ideas_handler _req = 122 - let cfg = Arod.Model.get_config () in 123 - let ideas = Arod.Model.ideas () in 124 - let page_content = 125 - El.div [ 126 - El.h1 [El.txt "Ideas"]; 127 - El.div ~at:[At.class' "entries-list"] ( 128 - List.map (fun idea -> 129 - let ent = `Idea idea in 130 - El.article ~at:[At.class' "entry-card"] [ 131 - Arod.Html.entry_href ent; 132 - Arod.Html.tags_meta ent; 133 - Arod.Html.full_body ent 134 - ] 135 - ) ideas 136 - ) 137 - ] 138 - in 139 - let html = Arod.Html.(to_page (page 140 - ~page_title:"Ideas" 141 - ~description:(Printf.sprintf "Ideas from %s" cfg.site.name) 142 - ~page_content 143 - ())) in 144 - Response.make_string (Ok html) 145 146 - let videos_handler _req = 147 - let cfg = Arod.Model.get_config () in 148 - let videos = Arod.Model.videos () in 149 - let page_content = 150 - El.div [ 151 - El.h1 [El.txt "Talks & Videos"]; 152 - El.div ~at:[At.class' "entries-list"] ( 153 - List.map (fun video -> 154 - let ent = `Video video in 155 - El.article ~at:[At.class' "entry-card"] [ 156 - Arod.Html.entry_href ent; 157 - Arod.Html.tags_meta ent; 158 - ] 159 - ) videos 160 - ) 161 - ] 162 - in 163 - let html = Arod.Html.(to_page (page 164 - ~page_title:"Talks & Videos" 165 - ~description:(Printf.sprintf "Talks and videos by %s" cfg.site.author_name) 166 - ~page_content 167 - ())) in 168 - Response.make_string (Ok html) 169 170 - let entry_handler slug _req = 171 - match Arod.Model.lookup slug with 172 - | None -> 173 - Response.make_string ~code:404 (Ok "Not found") 174 - | Some ent -> 175 - let cfg = Arod.Model.get_config () in 176 - let page_content = 177 - El.article ~at:[At.class' "entry-full"] [ 178 - Arod.Html.entry_href ~tag:"h1" ent; 179 - Arod.Html.tags_meta ent; 180 - Arod.Html.full_body ent 181 - ] 182 - in 183 - let html = Arod.Html.(to_page (page 184 - ~page_title:(Arod.Model.Entry.title ent) 185 - ~description:(match Arod.Model.Entry.synopsis ent with Some s -> s | None -> cfg.site.description) 186 - ~page_content 187 - ())) in 188 - Response.make_string (Ok html) 189 190 - (** {1 Static File Handlers} *) 191 192 - let static_file_handler ~dir path _req = 193 - (* Remove any .. to prevent directory traversal *) 194 let clean_path = 195 let parts = String.split_on_char '/' path in 196 let safe_parts = List.filter (fun s -> s <> ".." && s <> ".") parts in 197 String.concat "/" safe_parts 198 in 199 let file_path = Filename.concat dir clean_path in 200 - if Sys.file_exists file_path && not (Sys.is_directory file_path) then begin 201 - let ext = Filename.extension file_path in 202 - let content_type = match ext with 203 - | ".css" -> "text/css" 204 - | ".js" -> "text/javascript" 205 - | ".svg" -> "image/svg+xml" 206 - | ".png" -> "image/png" 207 - | ".jpg" | ".jpeg" -> "image/jpeg" 208 - | ".webp" -> "image/webp" 209 - | ".ico" -> "image/x-icon" 210 - | ".woff" -> "font/woff" 211 - | ".woff2" -> "font/woff2" 212 - | ".pdf" -> "application/pdf" 213 - | ".json" -> "application/json" 214 - | ".xml" -> "application/xml" 215 - | ".html" -> "text/html" 216 - | _ -> "application/octet-stream" 217 - in 218 - let ic = open_in_bin file_path in 219 - let content = really_input_string ic (in_channel_length ic) in 220 - close_in ic; 221 - Response.make_string ~headers:[("Content-Type", content_type)] (Ok content) 222 - end else 223 - Response.make_string ~code:404 (Ok "Not found") 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 224 225 (** {1 Feed Handlers} *) 226 227 - let atom_handler _req = 228 - (* TODO: implement Atom feed generation *) 229 - Response.make_string 230 - ~headers:[("Content-Type", "application/atom+xml")] 231 - (Ok {|<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom"><title>Feed</title></feed>|}) 0 0 232 233 - let json_feed_handler _req = 234 - (* TODO: implement JSON feed generation *) 235 - Response.make_string 236 - ~headers:[("Content-Type", "application/feed+json")] 237 - (Ok {|{"version":"https://jsonfeed.org/version/1.1","title":"Feed","items":[]}|}) 0 0 0 238 239 - (** {1 Logging Middleware} *) 0 0 0 0 0 240 241 - let logging_middleware handler req = 242 - let start = Unix.gettimeofday () in 243 - let resp = handler req in 244 - let elapsed = Unix.gettimeofday () -. start in 245 - Log.info (fun m -> m "%s %s %.3fs" 246 - (Tiny_httpd.Meth.to_string (Request.meth req)) 247 - (Request.path req) 248 - elapsed); 249 - resp 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 250 251 (** {1 Server Setup} *) 252 253 let setup_routes server cfg = 254 - (* Index *) 255 - Server.add_route_handler server Route.(exact "/" @/ return) index_handler; 256 257 - (* Entry lists *) 258 - Server.add_route_handler server Route.(exact "/notes" @/ return) notes_handler; 259 - Server.add_route_handler server Route.(exact "/papers" @/ return) papers_handler; 260 - Server.add_route_handler server Route.(exact "/projects" @/ return) projects_handler; 261 - Server.add_route_handler server Route.(exact "/ideas" @/ return) ideas_handler; 262 - Server.add_route_handler server Route.(exact "/videos" @/ return) videos_handler; 263 - Server.add_route_handler server Route.(exact "/talks" @/ return) videos_handler; 264 265 - (* Individual entries *) 266 - Server.add_route_handler server Route.(exact "/notes" @/ string_urlencoded @/ return) entry_handler; 267 - Server.add_route_handler server Route.(exact "/papers" @/ string_urlencoded @/ return) entry_handler; 268 - Server.add_route_handler server Route.(exact "/projects" @/ string_urlencoded @/ return) entry_handler; 269 - Server.add_route_handler server Route.(exact "/ideas" @/ string_urlencoded @/ return) entry_handler; 270 - Server.add_route_handler server Route.(exact "/videos" @/ string_urlencoded @/ return) entry_handler; 271 272 - (* Static files *) 273 - Server.add_route_handler server 274 - Route.(exact_path "/assets" rest_of_path_urlencoded) 275 - (static_file_handler ~dir:cfg.Arod.Config.paths.assets_dir); 276 - Server.add_route_handler server 277 - Route.(exact_path "/images" rest_of_path_urlencoded) 278 - (static_file_handler ~dir:cfg.paths.images_dir); 279 - Server.add_route_handler server 280 - Route.(exact_path "/static" rest_of_path_urlencoded) 281 - (static_file_handler ~dir:cfg.paths.static_dir); 282 283 - (* Feeds *) 284 - Server.add_route_handler server Route.(exact "/news.xml" @/ return) atom_handler; 285 - Server.add_route_handler server Route.(exact "/feed.json" @/ return) json_feed_handler; 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 286 287 () 288 ··· 312 Eio_main.run @@ fun env -> 313 let fs = Eio.Stdenv.fs env in 314 315 - (* Load entries *) 316 Log.info (fun m -> m "Loading entries from %s" cfg.paths.data_dir); 317 let _entries = Arod.Model.init ~cfg fs in 318 Log.info (fun m -> m "Loaded %d notes, %d papers, %d projects, %d ideas, %d videos, %d images" ··· 323 (List.length (Arod.Model.videos ())) 324 (List.length (Arod.Model.images ()))); 325 326 - (* Create server *) 327 let server = Tiny_httpd.create ~addr:cfg.server.host ~port:cfg.server.port () in 328 - Tiny_httpd.add_middleware server ~stage:(`Stage 0) logging_middleware; 0 0 0 0 0 0 0 0 0 0 0 329 setup_routes server cfg; 330 331 Log.app (fun m -> m "Listening on http://%s:%d" cfg.server.host cfg.server.port);

··· 6 (** Arod webserver - a tiny_httpd based server for Bushel content *) 7 8 open Tiny_httpd 9 + open Arod.Entries 10 11 (** {1 Logging} *) 12 13 let src = Logs.Src.create "arod" ~doc:"Arod webserver" 14 module Log = (val Logs.src_log src : Logs.LOG) 15 16 + (** {1 Query Helpers} *) 17 18 + let get_query_params req = 19 + Request.query req 20 + 21 + let get_query_param req name = 22 + match List.assoc_opt name (get_query_params req) with 23 + | Some v -> Some v 24 + | None -> None 25 + 26 + let get_query_params_multi req name = 27 + List.filter_map (fun (k, v) -> 28 + if k = name then Some v else None 29 + ) (get_query_params req) 30 + 31 + let get_query_info req = 32 + let tags = get_query_params_multi req "t" |> List.map Arod.Model.Tags.of_string in 33 + let min = match get_query_param req "min" with None -> 25 | Some v -> int_of_string v in 34 + let show_all = match get_query_param req "all" with None -> false | Some _ -> true in 35 + {tags; min; show_all} 36 + 37 + (** {1 Response Helpers} *) 0 0 0 0 38 39 + let html_response content = 40 + Response.make_string ~headers:[("content-type", "text/html; charset=utf-8")] (Ok content) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41 42 + let not_found_response = Response.fail ~code:404 "Not Found" 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 43 44 + let plain_response content = 45 + Response.make_string ~headers:[("content-type", "text/plain")] (Ok content) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 46 47 + let atom_response content = 48 + Response.make_string ~headers:[("content-type", "application/atom+xml; charset=utf-8")] (Ok content) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 50 + let xml_response content = 51 + Response.make_string ~headers:[("content-type", "application/xml")] (Ok content) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 52 53 + let json_response content = 54 + Response.make_string ~headers:[("content-type", "application/json; charset=utf-8")] (Ok content) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 55 56 + (** {1 File Serving} *) 57 58 + let serve_file ~dir path = 0 59 let clean_path = 60 let parts = String.split_on_char '/' path in 61 let safe_parts = List.filter (fun s -> s <> ".." && s <> ".") parts in 62 String.concat "/" safe_parts 63 in 64 let file_path = Filename.concat dir clean_path in 65 + Log.info (fun m -> m "Serving file: %s (dir=%s, path=%s)" file_path dir path); 66 + try 67 + if Sys.file_exists file_path && not (Sys.is_directory file_path) then begin 68 + let ic = open_in_bin file_path in 69 + let len = in_channel_length ic in 70 + let content = really_input_string ic len in 71 + close_in ic; 72 + let mime_type = 73 + if String.ends_with ~suffix:".pdf" file_path then "application/pdf" 74 + else if String.ends_with ~suffix:".html" file_path then "text/html" 75 + else if String.ends_with ~suffix:".css" file_path then "text/css" 76 + else if String.ends_with ~suffix:".js" file_path then "text/javascript" 77 + else if String.ends_with ~suffix:".svg" file_path then "image/svg+xml" 78 + else if String.ends_with ~suffix:".png" file_path then "image/png" 79 + else if String.ends_with ~suffix:".jpg" file_path || String.ends_with ~suffix:".jpeg" file_path then "image/jpeg" 80 + else if String.ends_with ~suffix:".webp" file_path then "image/webp" 81 + else if String.ends_with ~suffix:".xml" file_path then "application/xml" 82 + else if String.ends_with ~suffix:".wasm" file_path then "application/wasm" 83 + else if String.ends_with ~suffix:".ico" file_path then "image/x-icon" 84 + else if String.ends_with ~suffix:".woff" file_path then "font/woff" 85 + else if String.ends_with ~suffix:".woff2" file_path then "font/woff2" 86 + else if String.ends_with ~suffix:".bib" file_path then "application/x-bibtex" 87 + else "application/octet-stream" 88 + in 89 + Log.info (fun m -> m "Served %s (%d bytes, %s)" file_path len mime_type); 90 + Response.make_string ~headers:[("content-type", mime_type)] (Ok content) 91 + end else begin 92 + Log.warn (fun m -> m "File not found: %s" file_path); 93 + not_found_response 94 + end 95 + with e -> 96 + Log.err (fun m -> m "Failed to serve file %s: %s" file_path (Printexc.to_string e)); 97 + not_found_response 98 + 99 + (** {1 HTML Output Helper} *) 100 + 101 + let to_page el = Htmlit.El.to_string ~doctype:true el 102 + 103 + (** {1 Entry Handlers} *) 104 + 105 + let entries_handler ~extra_tags ~types req = 106 + let q = get_query_info req in 107 + let all_tags = Arod.Model.concat_tags q.tags (List.map Arod.Model.Tags.of_string extra_tags) in 108 + html_response (to_page (view_entries ~show_all:q.show_all ~tags:all_tags ~min:q.min ~types (entries_of_req ~extra_tags ~types q))) 109 + 110 + let feed_handler ~types req = 111 + let q = get_query_info req in 112 + html_response (to_page (view_news ~show_all:q.show_all ~tags:q.tags ~min:q.min ~types (feed_of_req ~types q))) 113 + 114 + let feed_handler_with_tags ~extra_tags ~types req = 115 + let q = get_query_info req in 116 + let tags = Arod.Model.concat_tags q.tags (List.map Arod.Model.Tags.of_string extra_tags) in 117 + let q = { q with tags } in 118 + html_response (to_page (view_news ~show_all:q.show_all ~tags:q.tags ~min:q.min ~types (feed_of_req ~types q))) 119 + 120 + let ideas_handler _req = 121 + html_response (to_page (Arod.Ideas.view_ideas_by_project ())) 122 + 123 + let projects_handler _req = 124 + html_response (to_page (Arod.Projects.view_projects_timeline ())) 125 + 126 + let index_handler req = 127 + let q = get_query_info req in 128 + match Arod.Model.lookup "index" with 129 + | None -> not_found_response 130 + | Some ent -> html_response (to_page (view_one q ent)) 131 + 132 + (** {1 Content Handlers} *) 133 + 134 + let paper_handler cfg slug _req = 135 + let q = get_query_info _req in 136 + match slug with 137 + | slug when String.ends_with ~suffix:".pdf" slug -> 138 + serve_file ~dir:cfg.Arod.Config.paths.static_dir ("papers/" ^ slug) 139 + | slug when String.ends_with ~suffix:".bib" slug -> 140 + let paper_slug = Filename.chop_extension slug in 141 + (match Arod.Model.lookup paper_slug with 142 + | Some (`Paper p) -> plain_response (Arod.Model.Paper.bib p) 143 + | _ -> not_found_response) 144 + | _ -> 145 + match Arod.Model.lookup slug with 146 + | None -> not_found_response 147 + | Some ent -> html_response (to_page (view_one q ent)) 148 + 149 + let content_handler slug req = 150 + let q = get_query_info req in 151 + match Arod.Model.lookup slug with 152 + | None -> not_found_response 153 + | Some ent -> html_response (to_page (view_one q ent)) 154 + 155 + let news_redirect_handler slug _req = 156 + Response.make_raw ~code:301 157 + ~headers:[("Location", "/notes/" ^ slug)] 158 + "Moved Permanently" 159 160 (** {1 Feed Handlers} *) 161 162 + let atom_uri req = 163 + let path = Request.path req in 164 + let query = Request.query req in 165 + if query = [] then path 166 + else 167 + let query_string = String.concat "&" (List.map (fun (k,v) -> k ^ "=" ^ v) query) in 168 + path ^ "?" ^ query_string 169 170 + let atom_handler cfg req = 171 + try 172 + let q = get_query_info req in 173 + let feed = feed_of_req ~types:[] q in 174 + let ur = atom_uri req in 175 + let s = Arod.Feed.feed_string cfg ur feed in 176 + atom_response s 177 + with exn -> Printexc.print_backtrace stdout; raise exn 178 179 + let perma_atom_handler cfg _req = 180 + try 181 + let feed = perma_feed_of_req () in 182 + let s = Arod.Feed.feed_string cfg "/perma.xml" feed in 183 + atom_response s 184 + with exn -> Printexc.print_backtrace stdout; raise exn 185 186 + let jsonfeed_handler cfg req = 187 + try 188 + let q = get_query_info req in 189 + let feed = feed_of_req ~types:[] q in 190 + let s = Arod.Jsonfeed.feed_string cfg "/feed.json" feed in 191 + json_response s 192 + with exn -> Printexc.print_backtrace stdout; raise exn 193 + 194 + let perma_jsonfeed_handler cfg _req = 195 + try 196 + let feed = perma_feed_of_req () in 197 + let s = Arod.Jsonfeed.feed_string cfg "/perma.json" feed in 198 + json_response s 199 + with exn -> Printexc.print_backtrace stdout; raise exn 200 + 201 + (** {1 Sitemap Handler} *) 202 + 203 + let sitemap_handler cfg _req = 204 + let all_feed = Arod.Model.all_entries () 205 + |> List.sort Arod.Model.Entry.compare 206 + |> List.rev in 207 + let url_of_entry ent = 208 + let lastmod = Arod.Model.Entry.date ent in 209 + let loc = cfg.Arod.Config.site.base_url ^ Arod.Model.Entry.site_url ent in 210 + Sitemap.v ~lastmod loc 211 + in 212 + let sitemap = List.map url_of_entry all_feed |> Sitemap.output in 213 + xml_response sitemap 214 + 215 + (** {1 Bushel Graph Handlers} *) 216 + 217 + let bushel_graph_data_handler _req = 218 + let entries = Arod.Model.get_entries () in 219 + match Bushel.Link_graph.get_graph () with 220 + | None -> 221 + json_response "{\"error\": \"Link graph not initialized\"}" 222 + | Some graph -> 223 + let json = Bushel.Link_graph.to_json graph entries in 224 + json_response (Ezjsonm.value_to_string json) 225 + 226 + let bushel_graph_handler _req = 227 + html_response (to_page (Arod.Page.bushel_graph ())) 228 + 229 + (** {1 Pagination API Handler} *) 230 + 231 + let pagination_api_handler req = 232 + try 233 + let collection_type = match get_query_param req "collection" with 234 + | Some t -> t 235 + | None -> failwith "Missing collection parameter" 236 + in 237 + let offset = match get_query_param req "offset" with 238 + | Some o -> int_of_string o 239 + | None -> 0 240 + in 241 + let limit = match get_query_param req "limit" with 242 + | Some l -> int_of_string l 243 + | None -> 25 244 + in 245 + let type_strings = get_query_params_multi req "type" in 246 + let types = List.filter_map entry_type_of_string type_strings in 247 + let q = get_query_info req in 248 + 249 + let html = match collection_type with 250 + | "feed" -> 251 + let all_feed = feed_of_req ~types q in 252 + let total = List.length all_feed in 253 + let feed_slice = 254 + all_feed 255 + |> (fun l -> List.filteri (fun i _ -> i >= offset) l) 256 + |> (fun l -> List.filteri (fun i _ -> i < limit) l) 257 + in 258 + let has_more = (offset + List.length feed_slice) < total in 259 + (render_feeds_html feed_slice, total, has_more) 260 + | "entries" -> 261 + let all_ents = entries_of_req ~extra_tags:[] ~types q in 262 + let total = List.length all_ents in 263 + let ents_slice = 264 + all_ents 265 + |> (fun l -> List.filteri (fun i _ -> i >= offset) l) 266 + |> (fun l -> List.filteri (fun i _ -> i < limit) l) 267 + in 268 + let has_more = (offset + List.length ents_slice) < total in 269 + (render_entries_html ents_slice, total, has_more) 270 + | _ -> failwith "Invalid collection type" 271 + in 272 + let rendered_html, total, has_more = html in 273 + 274 + let json = `O [ 275 + ("html", `String rendered_html); 276 + ("total", `Float (float_of_int total)); 277 + ("offset", `Float (float_of_int offset)); 278 + ("limit", `Float (float_of_int limit)); 279 + ("has_more", `Bool has_more); 280 + ] in 281 + json_response (Ezjsonm.to_string json) 282 + with e -> 283 + let error_json = `O [("error", `String (Printexc.to_string e))] in 284 + json_response (Ezjsonm.to_string error_json) 285 + 286 + (** {1 Well-Known Handler} *) 287 + 288 + let well_known_handler cfg key _req = 289 + match List.find_opt (fun e -> e.Arod.Config.key = key) cfg.Arod.Config.well_known with 290 + | Some entry -> plain_response entry.value 291 + | None -> not_found_response 292 293 (** {1 Server Setup} *) 294 295 let setup_routes server cfg = 296 + let open Route in 0 297 298 + (* Index routes *) 299 + Server.add_route_handler ~meth:`GET server (exact_path "/" return) index_handler; 300 + Server.add_route_handler ~meth:`GET server (exact_path "/about" return) index_handler; 301 + Server.add_route_handler ~meth:`GET server (exact_path "/about/" return) index_handler; 0 0 0 302 303 + (* Atom feeds *) 304 + Server.add_route_handler ~meth:`GET server (exact_path "/wiki.xml" return) (atom_handler cfg); 305 + Server.add_route_handler ~meth:`GET server (exact_path "/news.xml" return) (atom_handler cfg); 306 + Server.add_route_handler ~meth:`GET server (exact_path "/feeds/atom.xml" return) (atom_handler cfg); 307 + Server.add_route_handler ~meth:`GET server (exact_path "/notes/atom.xml" return) (atom_handler cfg); 308 + Server.add_route_handler ~meth:`GET server (exact_path "/perma.xml" return) (perma_atom_handler cfg); 309 310 + (* JSON feeds *) 311 + Server.add_route_handler ~meth:`GET server (exact_path "/feed.json" return) (jsonfeed_handler cfg); 312 + Server.add_route_handler ~meth:`GET server (exact_path "/feeds/feed.json" return) (jsonfeed_handler cfg); 313 + Server.add_route_handler ~meth:`GET server (exact_path "/notes/feed.json" return) (jsonfeed_handler cfg); 314 + Server.add_route_handler ~meth:`GET server (exact_path "/perma.json" return) (perma_jsonfeed_handler cfg); 0 0 0 0 0 315 316 + (* Sitemap *) 317 + Server.add_route_handler ~meth:`GET server (exact_path "/sitemap.xml" return) (sitemap_handler cfg); 318 + 319 + (* Papers *) 320 + Server.add_route_handler ~meth:`GET server (exact "papers" @/ string @/ return) (paper_handler cfg); 321 + Server.add_route_handler ~meth:`GET server (exact "papers" @/ string @/ exact "" @/ return) (paper_handler cfg); 322 + Server.add_route_handler ~meth:`GET server (exact_path "/papers" return) (entries_handler ~extra_tags:[] ~types:[`Paper]); 323 + Server.add_route_handler ~meth:`GET server (exact_path "/papers/" return) (entries_handler ~extra_tags:[] ~types:[`Paper]); 324 + 325 + (* Ideas *) 326 + Server.add_route_handler ~meth:`GET server (exact "ideas" @/ string @/ return) content_handler; 327 + Server.add_route_handler ~meth:`GET server (exact "ideas" @/ string @/ exact "" @/ return) content_handler; 328 + Server.add_route_handler ~meth:`GET server (exact_path "/ideas" return) ideas_handler; 329 + Server.add_route_handler ~meth:`GET server (exact_path "/ideas/" return) ideas_handler; 330 + 331 + (* Notes *) 332 + Server.add_route_handler ~meth:`GET server (exact "notes" @/ string @/ return) content_handler; 333 + Server.add_route_handler ~meth:`GET server (exact "notes" @/ string @/ exact "" @/ return) content_handler; 334 + Server.add_route_handler ~meth:`GET server (exact_path "/notes" return) (feed_handler_with_tags ~extra_tags:[] ~types:[`Note]); 335 + Server.add_route_handler ~meth:`GET server (exact_path "/notes/" return) (feed_handler_with_tags ~extra_tags:[] ~types:[`Note]); 336 + 337 + (* Videos/Talks *) 338 + Server.add_route_handler ~meth:`GET server (exact "videos" @/ string @/ return) content_handler; 339 + Server.add_route_handler ~meth:`GET server (exact "videos" @/ string @/ exact "" @/ return) content_handler; 340 + Server.add_route_handler ~meth:`GET server (exact_path "/talks" return) (feed_handler_with_tags ~extra_tags:[] ~types:[`Video]); 341 + Server.add_route_handler ~meth:`GET server (exact_path "/talks/" return) (feed_handler_with_tags ~extra_tags:[] ~types:[`Video]); 342 + Server.add_route_handler ~meth:`GET server (exact_path "/videos" return) (feed_handler_with_tags ~extra_tags:[] ~types:[`Video]); 343 + Server.add_route_handler ~meth:`GET server (exact_path "/videos/" return) (feed_handler_with_tags ~extra_tags:[] ~types:[`Video]); 344 + 345 + (* Projects *) 346 + Server.add_route_handler ~meth:`GET server (exact "projects" @/ string @/ return) content_handler; 347 + Server.add_route_handler ~meth:`GET server (exact "projects" @/ string @/ exact "" @/ return) content_handler; 348 + Server.add_route_handler ~meth:`GET server (exact_path "/projects" return) projects_handler; 349 + Server.add_route_handler ~meth:`GET server (exact_path "/projects/" return) projects_handler; 350 + 351 + (* Legacy news redirect *) 352 + Server.add_route_handler ~meth:`GET server (exact "news" @/ string @/ return) news_redirect_handler; 353 + 354 + (* Wiki/News legacy *) 355 + Server.add_route_handler ~meth:`GET server (exact_path "/wiki" return) (entries_handler ~extra_tags:[] ~types:[`Paper; `Note; `Video; `Idea; `Project]); 356 + Server.add_route_handler ~meth:`GET server (exact_path "/news" return) (feed_handler ~types:[`Note]); 357 + 358 + (* Pagination API *) 359 + Server.add_route_handler ~meth:`GET server (exact_path "/api/entries" return) pagination_api_handler; 360 + 361 + (* Bushel link graph *) 362 + Server.add_route_handler ~meth:`GET server (exact_path "/bushel" return) bushel_graph_handler; 363 + Server.add_route_handler ~meth:`GET server (exact_path "/bushel/" return) bushel_graph_handler; 364 + Server.add_route_handler ~meth:`GET server (exact_path "/bushel/graph.json" return) bushel_graph_data_handler; 365 + 366 + (* Well-known endpoints *) 367 + Server.add_route_handler ~meth:`GET server (exact ".well-known" @/ string @/ return) (well_known_handler cfg); 368 + 369 + (* Robots.txt *) 370 + Server.add_route_handler ~meth:`GET server (exact_path "/robots.txt" return) 371 + (fun _req -> serve_file ~dir:cfg.paths.assets_dir "robots.txt"); 372 + 373 + (* Static files *) 374 + Server.add_route_handler ~meth:`GET server (exact "assets" @/ rest_of_path) 375 + (fun path _req -> serve_file ~dir:cfg.paths.assets_dir path); 376 + Server.add_route_handler ~meth:`GET server (exact "images" @/ rest_of_path) 377 + (fun path _req -> serve_file ~dir:cfg.paths.images_dir path); 378 + Server.add_route_handler ~meth:`GET server (exact "static" @/ rest_of_path) 379 + (fun path _req -> serve_file ~dir:cfg.paths.static_dir path); 380 381 () 382 ··· 406 Eio_main.run @@ fun env -> 407 let fs = Eio.Stdenv.fs env in 408 0 409 Log.info (fun m -> m "Loading entries from %s" cfg.paths.data_dir); 410 let _entries = Arod.Model.init ~cfg fs in 411 Log.info (fun m -> m "Loaded %d notes, %d papers, %d projects, %d ideas, %d videos, %d images" ··· 416 (List.length (Arod.Model.videos ())) 417 (List.length (Arod.Model.images ()))); 418 0 419 let server = Tiny_httpd.create ~addr:cfg.server.host ~port:cfg.server.port () in 420 + 421 + Tiny_httpd.add_middleware server ~stage:(`Stage 1) (fun h req -> 422 + let start_time = Unix.gettimeofday () in 423 + let resp = h req in 424 + let elapsed = Unix.gettimeofday () -. start_time in 425 + Log.info (fun m -> m "%s %s - %.3fs" 426 + (Meth.to_string (Request.meth req)) 427 + (Request.path req) 428 + elapsed); 429 + resp 430 + ); 431 + 432 setup_routes server cfg; 433 434 Log.app (fun m -> m "Listening on http://%s:%d" cfg.server.host cfg.server.port);

+40 -2

arod/lib/arod.ml

··· 12 13 - {!Config} - TOML configuration 14 - {!Model} - Bushel bridge layer 15 - - {!Html} - HTML generation with htmlit *) 0 0 16 17 module Config = Arod_config 18 (** TOML-based configuration for the webserver. *) ··· 20 module Model = Arod_model 21 (** Model layer bridging Bushel to the webserver. *) 22 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 23 module Html = Arod_html 24 - (** HTML generation using htmlit. *)

··· 12 13 - {!Config} - TOML configuration 14 - {!Model} - Bushel bridge layer 15 + - {!View} - Core rendering utilities 16 + - {!Page} - Page layout 17 + - {!Entries} - Entry type filtering and rendering *) 18 19 module Config = Arod_config 20 (** TOML-based configuration for the webserver. *) ··· 22 module Model = Arod_model 23 (** Model layer bridging Bushel to the webserver. *) 24 25 + module View = Arod_view 26 + (** Core view rendering utilities. *) 27 + 28 + module Page = Arod_page 29 + (** Page layout. *) 30 + 31 + module Footer = Arod_footer 32 + (** Standard footer. *) 33 + 34 + module Notes = Arod_notes 35 + (** Note rendering. *) 36 + 37 + module Papers = Arod_papers 38 + (** Paper rendering. *) 39 + 40 + module Ideas = Arod_ideas 41 + (** Idea rendering. *) 42 + 43 + module Projects = Arod_projects 44 + (** Project rendering. *) 45 + 46 + module Videos = Arod_videos 47 + (** Video rendering. *) 48 + 49 + module Entries = Arod_entries 50 + (** Entry type filtering and rendering. *) 51 + 52 + module Feed = Arod_feed 53 + (** Atom feed generation. *) 54 + 55 + module Jsonfeed = Arod_jsonfeed 56 + (** JSON feed generation. *) 57 + 58 + module Richdata = Arod_richdata 59 + (** JSON-LD rich data for SEO. *) 60 + 61 module Html = Arod_html 62 + (** Legacy HTML generation (for compatibility). *)

+406

arod/lib/arod_entries.ml

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Entry type filtering and rendering for Arod webserver *) 7 + 8 + open Htmlit 9 + 10 + (** Entry type filter *) 11 + type entry_type = [ `Paper | `Note | `Video | `Idea | `Project ] 12 + 13 + let entry_type_to_string = function 14 + | `Paper -> "paper" 15 + | `Note -> "note" 16 + | `Video -> "video" 17 + | `Idea -> "idea" 18 + | `Project -> "project" 19 + 20 + let entry_type_of_string = function 21 + | "paper" -> Some `Paper 22 + | "note" -> Some `Note 23 + | "video" -> Some `Video 24 + | "idea" -> Some `Idea 25 + | "project" -> Some `Project 26 + | _ -> None 27 + 28 + (** Helper functions for common attributes *) 29 + let class_ c = At.class' c 30 + let href h = At.href h 31 + 32 + let render_entry (ent:Arod_model.Entry.entry) = 33 + let (t, _word_count_info) = match ent with 34 + | `Paper p -> Arod_papers.paper_for_entry p 35 + | `Note n -> Arod_notes.one_note_brief n 36 + | `Video v -> Arod_videos.one_video v 37 + | `Idea i -> Arod_ideas.one_idea_brief i 38 + | `Project p -> Arod_projects.one_project_brief p 39 + in 40 + El.splice [t; Arod_view.tags_meta ent] 41 + 42 + let render_entry_for_feed ent = 43 + match ent with 44 + | `Paper p -> fst (Arod_papers.paper_for_feed p) 45 + | `Note n -> fst (Arod_notes.note_for_feed n) 46 + | `Video v -> fst (Arod_videos.video_for_feed v) 47 + | `Idea i -> fst (Arod_ideas.idea_for_feed i) 48 + | `Project p -> fst (Arod_projects.project_for_feed p) 49 + 50 + let render_feed ent = 51 + let (entry_html, _word_count_info) = match ent with 52 + | `Paper p -> Arod_papers.paper_for_feed p 53 + | `Note n -> Arod_notes.note_for_feed n 54 + | `Video v -> Arod_videos.video_for_feed v 55 + | `Idea i -> Arod_ideas.idea_for_feed i 56 + | `Project p -> Arod_projects.project_for_feed p 57 + in 58 + El.splice [ 59 + Arod_view.entry_href ent; 60 + entry_html; 61 + Arod_view.tags_meta ent 62 + ] 63 + 64 + let render_backlinks_content ent = 65 + let slug = Arod_model.Entry.slug ent in 66 + let entry_type = match ent with 67 + | `Paper _ -> "paper" 68 + | `Note _ -> "note" 69 + | `Idea _ -> "idea" 70 + | `Project _ -> "project" 71 + | `Video _ -> "video" 72 + in 73 + let entries = Arod_model.get_entries () in 74 + let backlink_slugs = Bushel.Link_graph.get_backlinks_for_slug slug in 75 + if backlink_slugs = [] then 76 + None 77 + else 78 + let backlink_items = List.filter_map (fun backlink_slug -> 79 + match Arod_model.Entry.lookup entries backlink_slug with 80 + | Some entry -> 81 + let title = Arod_model.Entry.title entry in 82 + let url = Arod_model.Entry.site_url entry in 83 + Some (El.li [El.a ~at:[At.href url] [El.txt title]]) 84 + | None -> None 85 + ) backlink_slugs in 86 + if backlink_items = [] then 87 + None 88 + else 89 + Some (El.splice [ 90 + El.span ~at:[At.class' "sidenote-number"] [El.txt "↑"]; 91 + El.span ~at:[At.class' "sidenote-icon"] [El.txt ""]; 92 + El.txt (Printf.sprintf "The following entries link to this %s: " entry_type); 93 + El.ul backlink_items 94 + ]) 95 + 96 + let render_one_entry ent = 97 + match ent with 98 + | `Paper p -> Arod_papers.one_paper_full p, Arod_papers.one_paper_extra p 99 + | `Idea i -> Arod_ideas.one_idea_full i, El.splice [] 100 + | `Note n -> Arod_notes.one_note_full n, El.splice [] 101 + | `Video v -> Arod_videos.one_video_full v, El.splice [] 102 + | `Project p -> Arod_projects.one_project_full p, El.splice [] 103 + 104 + type query_info = { 105 + tags: Arod_model.Tags.t list; 106 + min: int; 107 + show_all: bool; 108 + } 109 + 110 + let sort_of_ent ent = 111 + match ent with 112 + | `Paper p -> (match Arod_model.Paper.bibtype p with 113 + | "inproceedings" -> "conference paper" 114 + | "article" | "journal" -> "journal paper" 115 + | "misc" -> "preprint" 116 + | "techreport" -> "technical report" 117 + | _ -> "paper"), "" 118 + | `Note {Arod_model.Note.updated=Some _;date=u; _} -> 119 + "note", Printf.sprintf " (originally on %s)" (Arod_view.ptime_date ~with_d:true u) 120 + | `Note _ -> "note", "" 121 + | `Project _ -> "project", "" 122 + | `Idea _ -> "research idea", "" 123 + | `Video _ -> "video", "" 124 + 125 + let footer = Arod_footer.footer 126 + 127 + let take n l = 128 + let[@tail_mod_cons] rec aux n l = 129 + match n, l with 130 + | 0, _ | _, [] -> [] 131 + | n, x::l -> x::aux (n - 1) l 132 + in 133 + if n < 0 then invalid_arg "List.take"; 134 + aux n l 135 + 136 + let feed_title_link ent = 137 + El.a ~at:[href (Arod_model.Entry.site_url ent)] [El.txt (Arod_model.Entry.title ent)] 138 + 139 + let tags_heading tags = 140 + Arod_view.map_and Arod_model.Tags.to_raw_string tags 141 + 142 + let view_news ~show_all ~tags ~min:_ ~types feed = 143 + let feed' = 144 + match show_all, List.length feed with 145 + | false, n when n > 25 -> take 25 feed 146 + | false, _ -> feed 147 + | true, _ -> feed 148 + in 149 + let title = "News " ^ (match tags with [] -> "" | tags -> " about " ^ (tags_heading tags)) in 150 + let description = Printf.sprintf "Showing %d news item(s)" (List.length feed') in 151 + let main_content = 152 + let rec intersperse_hr = function 153 + | [] -> [] 154 + | [x] -> [render_feed x] 155 + | x::xs -> render_feed x :: El.hr () :: intersperse_hr xs 156 + in 157 + intersperse_hr feed' in 158 + let page_footer = El.splice [footer] in 159 + let pagination_attrs = 160 + let tags_str = String.concat "," (List.map Arod_model.Tags.to_raw_string tags) in 161 + let types_str = String.concat "," (List.map entry_type_to_string types) in 162 + [ 163 + At.v "data-pagination" "true"; 164 + At.v "data-collection-type" "feed"; 165 + At.v "data-total-count" (string_of_int (List.length feed)); 166 + At.v "data-current-count" (string_of_int (List.length feed')); 167 + At.v "data-tags" tags_str; 168 + At.v "data-types" types_str; 169 + ] 170 + in 171 + let page_content = 172 + El.splice [ 173 + El.article ~at:pagination_attrs main_content; 174 + El.aside [] 175 + ] 176 + in 177 + Arod_page.page ~title ~page_content ~page_footer ~description () 178 + 179 + let render_entries_html ents = 180 + let rendered = List.map render_entry ents in 181 + let rec add_separators = function 182 + | [] -> [] 183 + | [x] -> [x] 184 + | x :: xs -> x :: El.hr () :: add_separators xs 185 + in 186 + let html_elements = El.hr () :: add_separators rendered in 187 + El.to_string ~doctype:false (El.splice html_elements) 188 + 189 + let render_feeds_html feeds = 190 + let rec intersperse_hr = function 191 + | [] -> [] 192 + | [x] -> [render_feed x] 193 + | x::xs -> render_feed x :: El.hr () :: intersperse_hr xs 194 + in 195 + let html_elements = El.hr () :: intersperse_hr feeds in 196 + El.to_string ~doctype:false (El.splice html_elements) 197 + 198 + let view_entries ~show_all ~tags ~min:_ ~types ents = 199 + let ents' = 200 + match show_all, List.length ents with 201 + | false, n when n > 25 -> take 25 ents 202 + | false, _ -> ents 203 + | true, _ -> ents 204 + in 205 + let title = String.capitalize_ascii (tags_heading tags ^ (if tags <> [] then " " else "")) in 206 + let description = Printf.sprintf "Showing %d item(s)" (List.length ents') in 207 + let main_content = 208 + let rendered = List.map render_entry ents' in 209 + let rec add_separators = function 210 + | [] -> [] 211 + | [x] -> [x] 212 + | x :: xs -> x :: El.hr () :: add_separators xs 213 + in 214 + add_separators rendered 215 + in 216 + let page_footer = El.splice [footer] in 217 + let pagination_attrs = 218 + let tags_str = String.concat "," (List.map Arod_model.Tags.to_raw_string tags) in 219 + let types_str = String.concat "," (List.map entry_type_to_string types) in 220 + [ 221 + At.v "data-pagination" "true"; 222 + At.v "data-collection-type" "entries"; 223 + At.v "data-total-count" (string_of_int (List.length ents)); 224 + At.v "data-current-count" (string_of_int (List.length ents')); 225 + At.v "data-tags" tags_str; 226 + At.v "data-types" types_str; 227 + ] 228 + in 229 + let page_content = 230 + El.splice [ 231 + El.article ~at:pagination_attrs main_content; 232 + El.aside [] 233 + ] 234 + in 235 + Arod_page.page ~title ~page_content ~page_footer ~description () 236 + 237 + let breadcrumbs cfg l = ("Home", cfg.Arod_config.site.base_url ^ "/") :: l 238 + 239 + let view_one _q ent = 240 + let cfg = Arod_model.get_config () in 241 + let entries = Arod_model.get_entries () in 242 + let title = Arod_model.Entry.title ent in 243 + let description = match Arod_model.Entry.synopsis ent with Some v -> v | None -> "" in 244 + let eh, extra = render_one_entry ent in 245 + let is_index = Arod_model.Entry.is_index_entry ent in 246 + let standardsite = match ent with 247 + | `Note n -> Arod_model.Note.standardsite n 248 + | _ -> None 249 + in 250 + let backlinks_content = 251 + if is_index then None 252 + else render_backlinks_content ent 253 + in 254 + let related_container = 255 + match ent with 256 + | `Project _ -> El.splice [] 257 + | _ when is_index -> El.splice [] 258 + | `Note _ -> 259 + let tags = Arod_model.Entry.tags_of_ent entries ent in 260 + let tag_strings = List.map Arod_model.Tags.to_raw_string tags |> String.concat " " in 261 + El.div ~at:[ 262 + class_ "related-items"; 263 + At.v "data-entry-title" title; 264 + At.v "data-entry-id" (Arod_model.Entry.slug ent); 265 + At.v "data-entry-tags" tag_strings 266 + ] [] 267 + | _ -> 268 + let tags = Arod_model.Entry.tags_of_ent entries ent in 269 + let tag_strings = List.map Arod_model.Tags.to_raw_string tags |> String.concat " " in 270 + El.splice [ 271 + El.hr (); 272 + El.div ~at:[ 273 + class_ "related-items"; 274 + At.v "data-entry-title" title; 275 + At.v "data-entry-id" (Arod_model.Entry.slug ent); 276 + At.v "data-entry-tags" tag_strings 277 + ] [] 278 + ] 279 + in 280 + let bs = Arod_richdata.(breadcrumbs @@ breadcrumb_of_ent cfg ent) in 281 + let jsonld = bs ^ (Arod_richdata.json_of_entry cfg ent) in 282 + let image = match Arod_model.Entry.thumbnail entries ent with 283 + | Some thumb -> cfg.site.base_url ^ thumb 284 + | None -> cfg.site.base_url ^ "/assets/imagetitle-default.jpg" 285 + in 286 + let page_footer, page_content = 287 + if is_index then 288 + let page_footer = footer in 289 + let page_content = El.splice [ 290 + El.article [eh]; 291 + El.aside [] 292 + ] in 293 + page_footer, page_content 294 + else 295 + let page_footer = footer in 296 + let references_html = match ent with 297 + | `Note n -> El.splice [El.hr (); Arod_view.note_references_html n] 298 + | _ -> El.splice [] 299 + in 300 + let page_content = El.splice [ 301 + El.article [ 302 + eh; 303 + Arod_view.tags_meta ?backlinks_content ent; 304 + references_html; 305 + related_container; 306 + extra 307 + ]; 308 + El.aside [] 309 + ] in 310 + page_footer, page_content 311 + in 312 + Arod_page.page ~image ~title ~jsonld ?standardsite ~page_content ~page_footer ~description () 313 + 314 + let filter_fn query_tags item_tags = 315 + let item_sets, item_text = List.partition (function `Set _ -> true | _ -> false) item_tags in 316 + let query_sets, query_text = List.partition (function `Set _ -> true | _ -> false) query_tags in 317 + let test_set seta setb = 318 + match setb with 319 + | [] -> true 320 + | setb -> List.exists (fun tag -> List.mem tag seta) setb 321 + in 322 + (test_set item_sets query_sets) && 323 + (test_set item_text query_text) 324 + 325 + let entry_matches_type types ent = 326 + if types = [] then true 327 + else 328 + List.exists (fun typ -> 329 + match typ, ent with 330 + | `Paper, `Paper _ -> true 331 + | `Note, `Note _ -> true 332 + | `Video, `Video _ -> true 333 + | `Idea, `Idea _ -> true 334 + | `Project, `Project _ -> true 335 + | _ -> false 336 + ) types 337 + 338 + let feed_of_req ~types q = 339 + let entries = Arod_model.get_entries () in 340 + let filterent = entry_matches_type types in 341 + let select ent = 342 + let only_talks = function 343 + | `Video { Arod_model.Video.talk; _ } -> talk 344 + | _ -> true 345 + in 346 + let not_index_page = function 347 + | `Note { Arod_model.Note.index_page; _ } -> not index_page 348 + | _ -> true 349 + in 350 + only_talks ent && not_index_page ent 351 + in 352 + let all_entries = Arod_model.all_entries () in 353 + match q.tags with 354 + | [] -> 355 + all_entries 356 + |> List.filter (fun ent -> select ent && filterent ent) 357 + |> List.sort Arod_model.Entry.compare 358 + |> List.rev 359 + | t -> 360 + all_entries 361 + |> List.filter (fun ent -> 362 + select ent && filterent ent && filter_fn t (Arod_model.Entry.tags_of_ent entries ent)) 363 + |> List.sort Arod_model.Entry.compare 364 + |> List.rev 365 + 366 + let perma_feed_of_req () = 367 + let filterent ent = 368 + match ent with 369 + | `Note n -> Arod_model.Note.perma n 370 + | _ -> false 371 + in 372 + let all_entries = Arod_model.all_entries () in 373 + all_entries 374 + |> List.filter filterent 375 + |> List.sort Arod_model.Entry.compare 376 + |> List.rev 377 + 378 + let entries_of_req ~extra_tags ~types q = 379 + let entries = Arod_model.get_entries () in 380 + let tags = Arod_model.concat_tags q.tags (List.map Arod_model.Tags.of_string extra_tags) in 381 + let q = { q with tags } in 382 + let filterent = entry_matches_type types in 383 + let select ent = 384 + let only_talks = function 385 + | `Video { Arod_model.Video.talk; _ } -> talk 386 + | _ -> true 387 + in 388 + let not_index_page = function 389 + | `Note { Arod_model.Note.index_page; _ } -> not index_page 390 + | _ -> true 391 + in 392 + only_talks ent && not_index_page ent 393 + in 394 + let all_entries = Arod_model.all_entries () in 395 + match q.tags with 396 + | [] -> 397 + all_entries 398 + |> List.filter (fun ent -> select ent && filterent ent) 399 + |> List.sort Arod_model.Entry.compare 400 + |> List.rev 401 + | ts -> 402 + all_entries 403 + |> List.filter (fun ent -> 404 + select ent && filterent ent && filter_fn ts (Arod_model.Entry.tags_of_ent entries ent)) 405 + |> List.sort Arod_model.Entry.compare 406 + |> List.rev

+138

arod/lib/arod_feed.ml

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Atom feed generation for Arod webserver *) 7 + 8 + module E = Arod_model.Entry 9 + module N = Arod_model.Note 10 + module C = Sortal_schema.Contact 11 + module X = Syndic.Atom 12 + 13 + let anil_copyright = "(c) 1998-2025, all rights reserved" 14 + 15 + let author c = 16 + let uri = Option.map Uri.of_string (C.best_url c) in 17 + let email = match C.emails c with e :: _ -> Some e.C.address | [] -> None in 18 + {X.name=(C.name c); email; uri} 19 + 20 + let form_uri cfg path = Uri.of_string (cfg.Arod_config.site.base_url ^ path) 21 + 22 + let atom_id cfg e = form_uri cfg @@ E.site_url e 23 + 24 + let generator = { 25 + X.version = Some "1.0"; 26 + uri = Some (Uri.of_string "https://github.com/avsm/bushel"); 27 + content = "Bushel" 28 + } 29 + 30 + let link cfg e = 31 + let href = form_uri cfg @@ E.site_url e in 32 + let rel = X.Self in 33 + let type_media = None in 34 + let title = E.title e in 35 + let length = None in 36 + let hreflang = None in 37 + {X.href; rel; type_media; title; length; hreflang} 38 + 39 + let news_feed_link cfg = 40 + let href = form_uri cfg "/news.xml" in 41 + let rel = X.Self in 42 + let type_media = None in 43 + let title = cfg.Arod_config.site.name in 44 + let length = None in 45 + let hreflang = None in 46 + {X.href; rel; type_media; title; length; hreflang} 47 + 48 + let ext_link ~title l = 49 + let href = Uri.of_string l in 50 + let rel = X.Alternate in 51 + let type_media = None in 52 + let title = title in 53 + let length = None in 54 + let hreflang = None in 55 + [{X.href; rel; type_media; title; length; hreflang}] 56 + 57 + let atom_of_note cfg ~author note = 58 + let e = `Note note in 59 + let id = atom_id cfg e in 60 + let categories = List.map (fun tag -> 61 + X.category tag 62 + ) (N.tags note) in 63 + let rights : X.title = X.Text anil_copyright in 64 + let source = None in 65 + let title : X.title = X.Text note.N.title in 66 + let published = N.origdate note in 67 + let updated = N.datetime note in 68 + let authors = author, [] in 69 + 70 + let base_html = Arod_view.md_to_atom_html note.N.body in 71 + 72 + let is_perma = N.perma note in 73 + let has_doi = match N.doi note with Some _ -> true | None -> false in 74 + let html_with_refs = 75 + if is_perma || has_doi then 76 + let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with 77 + | Some c -> c 78 + | None -> failwith "Author not found" 79 + in 80 + let references = Bushel.Md.note_references (Arod_model.get_entries ()) me note in 81 + if List.length references > 0 then 82 + let refs_html = 83 + let ref_items = List.map (fun (doi, citation, _) -> 84 + let doi_url = Printf.sprintf "https://doi.org/%s" doi in 85 + Printf.sprintf "<li>%s<a href=\"%s\" target=\"_blank\"><i>%s</i></a></li>" 86 + citation doi_url doi 87 + ) references |> String.concat "\n" in 88 + Printf.sprintf "<h1>References</h1><ul>%s</ul>" ref_items 89 + in 90 + base_html ^ refs_html 91 + else 92 + base_html 93 + else 94 + base_html 95 + in 96 + 97 + let html_base_uri = Some (Uri.of_string (cfg.site.base_url ^ "/")) in 98 + let content, links = 99 + match N.link note with 100 + | `Local _ -> 101 + let content = Some (X.Html (html_base_uri, html_with_refs)) in 102 + let links = [link cfg e] in 103 + content, links 104 + | `Ext (_l,u) -> 105 + let content = Some (X.Html (html_base_uri, html_with_refs)) in 106 + let links = ext_link ~title:note.N.title u in 107 + content, links 108 + in 109 + let entry = Syndic.Atom.entry 110 + ~categories ~links ~published ~rights ?content 111 + ?source ~title ~updated 112 + ~id ~authors () 113 + in 114 + entry 115 + 116 + let atom_of_entry cfg ~author (e:Arod_model.Entry.entry) = 117 + match e with 118 + | `Note n -> Some (atom_of_note cfg ~author n) 119 + | _ -> None 120 + 121 + let feed cfg uri entries = 122 + try 123 + let author = author @@ (Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle |> Option.get) in 124 + let authors = [author] in 125 + let icon = Uri.of_string (cfg.site.base_url ^ "/assets/favicon.ico") in 126 + let links = [news_feed_link cfg] in 127 + let atom_entries = List.filter_map (atom_of_entry cfg ~author) entries in 128 + let title : X.text_construct = X.Text (cfg.site.name ^ "'s feed") in 129 + let updated = Arod_model.Entry.datetime (List.hd entries) in 130 + let id = form_uri cfg uri in 131 + let rights : X.title = X.Text anil_copyright in 132 + X.feed ~id ~rights ~authors ~title ~updated ~icon ~links atom_entries 133 + with exn -> Printexc.print_backtrace stdout; print_endline "x"; raise exn 134 + 135 + let feed_string cfg uri f = 136 + let buf = Buffer.create 1024 in 137 + X.output (feed cfg uri f) (`Buffer buf); 138 + Buffer.contents buf

+68

arod/lib/arod_footer.ml

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Standard footer for all pages *) 7 + 8 + open Htmlit 9 + 10 + let footer = 11 + El.splice [ 12 + El.p [ 13 + El.em [ 14 + El.txt "This site is © 1998-2025 Anil Madhavapeddy, all rights reserved, except where the content is otherwise licensed. There are no third-party trackers. You can follow me on the usual social media and some self-hosted ones." 15 + ] 16 + ]; 17 + El.p [ 18 + El.em [ 19 + El.txt "Chat ("; 20 + El.a ~at:[At.rel "me"; At.class' "noicon"; At.href "https://bsky.app/profile/anil.recoil.org"] [El.txt "Bluesky"]; 21 + El.txt " / "; 22 + El.a ~at:[At.rel "me"; At.class' "noicon"; At.href "https://amok.recoil.org/@avsm"] [El.txt "Mastodon"]; 23 + El.txt " / "; 24 + El.a ~at:[At.class' "noicon"; At.href "https://www.linkedin.com/in/anilmadhavapeddy/"] [El.txt "LinkedIn"]; 25 + El.txt " / "; 26 + El.s [El.txt "Twitter"]; 27 + El.txt ")"; 28 + El.br (); 29 + El.txt "Video ("; 30 + El.a ~at:[At.class' "noicon"; At.href "https://crank.recoil.org/@avsm"] [El.txt "Recoil"]; 31 + El.txt " / "; 32 + El.a ~at:[At.class' "noicon"; At.href "https://watch.eeg.cl.cam.ac.uk"] [El.txt "EEG"]; 33 + El.txt " / "; 34 + El.a ~at:[At.class' "noicon"; At.href "https://watch.ocaml.org"] [El.txt "OCaml"]; 35 + El.txt ")"; 36 + El.br (); 37 + El.txt "Code ("; 38 + El.a ~at:[At.class' "noicon"; At.href "https://github.com/avsm"] [El.txt "GitHub"]; 39 + El.txt " / "; 40 + El.a ~at:[At.class' "noicon"; At.href "https://gitlab.developers.cam.ac.uk/avsm2"] [El.txt "GitLab@cam"]; 41 + El.txt " / "; 42 + El.a ~at:[At.class' "noicon"; At.href "https://tangled.org/@anil.recoil.org"] [El.txt "Tangled"]; 43 + El.txt ")"; 44 + El.br (); 45 + El.txt "Feed ("; 46 + El.a ~at:[At.href "/news.xml"] [ 47 + El.txt "Atom "; 48 + El.img ~at:[At.class' "inline-icon"; At.alt "atom"; At.src "/assets/rss.svg"] () 49 + ]; 50 + El.txt " / "; 51 + El.a ~at:[At.href "/perma.xml"] [ 52 + El.txt "Perma "; 53 + El.img ~at:[At.class' "inline-icon"; At.alt "atom"; At.src "/assets/rss.svg"] () 54 + ]; 55 + El.txt " / "; 56 + El.a ~at:[At.href "/feed.json"] [ 57 + El.txt "JSON "; 58 + El.img ~at:[At.class' "inline-icon"; At.alt "json"; At.src "/assets/rss.svg"] () 59 + ]; 60 + El.txt " / "; 61 + El.a ~at:[At.href "/perma.json"] [ 62 + El.txt "Perma JSON "; 63 + El.img ~at:[At.class' "inline-icon"; At.alt "json"; At.src "/assets/rss.svg"] () 64 + ]; 65 + El.txt ")" 66 + ] 67 + ] 68 + ]

+260

arod/lib/arod_ideas.ml

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Idea rendering for Arod webserver *) 7 + 8 + open Htmlit 9 + open Printf 10 + 11 + module MI = Arod_model.Idea 12 + 13 + let class_ c = At.class' c 14 + 15 + let color_of_status = 16 + let open MI in 17 + function 18 + | Available -> "#ddffdd" 19 + | Discussion -> "#efee99" 20 + | Ongoing -> "#ffeebb" 21 + | Completed -> "#f0f0fe" 22 + | Expired -> "#cccccc" 23 + 24 + let status_to_long_string s = 25 + let open MI in 26 + function 27 + | Available -> sprintf {|is <span class="idea-available">available</span> for being worked on|} 28 + | Discussion -> sprintf {|is <span class="idea-discussion">under discussion</span> with a student but not yet confirmed|} 29 + | Ongoing -> sprintf {|is currently <span class="idea-ongoing">being worked on</span> by %s|} s 30 + | Completed -> sprintf {|has been <span class="idea-completed">completed</span> by %s|} s 31 + | Expired -> sprintf {|has <span class="idea-expired">expired</span>|} 32 + 33 + let level_to_long_string = 34 + let open MI in 35 + function 36 + | Any -> " as a good starter project" 37 + | PartII -> " as a Cambridge Computer Science Part II project" 38 + | MPhil -> " as a Cambridge Computer Science Part III or MPhil project" 39 + | PhD -> " as a Cambridge Computer Science PhD topic" 40 + | Postdoc -> " as a postdoctoral project" 41 + 42 + let idea_to_html_no_sidenotes idea = 43 + let open MI in 44 + let idea_url = "/ideas/" ^ idea.slug in 45 + 46 + let render_contacts contacts = 47 + match contacts with 48 + | [] -> El.splice [] 49 + | cs -> 50 + let contact_links = List.filter_map (fun handle -> 51 + match Arod_model.lookup_by_handle handle with 52 + | Some contact -> 53 + let name = Sortal_schema.Contact.name contact in 54 + (match Sortal_schema.Contact.best_url contact with 55 + | Some url -> Some (El.a ~at:[At.href url] [El.txt name]) 56 + | None -> Some (El.txt name)) 57 + | None -> 58 + Some (El.txt ("@" ^ handle)) 59 + ) cs in 60 + let rec intersperse_and = function 61 + | [] -> [] 62 + | [x] -> [x] 63 + | [x; y] -> [x; El.txt " and "; y] 64 + | x :: xs -> x :: El.txt ", " :: intersperse_and xs 65 + in 66 + El.splice (intersperse_and contact_links) 67 + in 68 + 69 + let sups = List.filter (fun x -> x <> "avsm") idea.supervisors in 70 + let sups_el = match sups with 71 + | [] -> El.splice [] 72 + | _ -> El.splice [El.txt " and cosupervised with "; render_contacts sups] 73 + in 74 + 75 + let studs_el = match idea.students with 76 + | [] -> El.splice [] 77 + | _ -> El.splice [render_contacts idea.students] 78 + in 79 + 80 + let lev = match idea.level with 81 + | Any -> "" 82 + | PartII -> " (Part II)" 83 + | MPhil -> " (MPhil)" 84 + | PhD -> " (PhD)" 85 + | Postdoc -> "" 86 + in 87 + 88 + let status_and_info = match idea.status with 89 + | Available -> El.splice [ 90 + El.a ~at:[At.href idea_url] [El.txt (MI.title idea)]; 91 + El.txt " "; 92 + El.br (); 93 + El.span ~at:[At.class' "idea-available"] [El.txt ("Available" ^ lev)]; 94 + El.txt " "; 95 + sups_el 96 + ] 97 + | Discussion -> El.splice [ 98 + El.a ~at:[At.href idea_url] [El.txt (MI.title idea)]; 99 + El.txt " "; 100 + El.br (); 101 + El.span ~at:[At.class' "idea-discussion"] [El.txt ("Under discussion" ^ lev)]; 102 + El.txt " "; 103 + sups_el 104 + ] 105 + | Ongoing -> El.splice [ 106 + El.a ~at:[At.href idea_url] [El.txt (MI.title idea)]; 107 + El.txt " "; 108 + El.br (); 109 + El.span ~at:[At.class' "idea-ongoing"] [El.txt ("Currently ongoing" ^ lev)]; 110 + El.txt " with "; 111 + studs_el; 112 + El.txt " "; 113 + sups_el 114 + ] 115 + | Completed -> El.splice [ 116 + El.a ~at:[At.href idea_url] [El.txt (MI.title idea)]; 117 + El.txt " "; 118 + El.br (); 119 + El.span ~at:[At.class' "idea-completed"] [El.txt ("Completed" ^ lev)]; 120 + El.txt " by "; 121 + studs_el; 122 + El.txt " "; 123 + sups_el; 124 + El.txt (" in " ^ string_of_int idea.year) 125 + ] 126 + | Expired -> El.splice [ 127 + El.a ~at:[At.href idea_url] [El.txt (MI.title idea)]; 128 + El.txt " "; 129 + El.br (); 130 + El.span ~at:[At.class' "idea-expired"] [El.txt ("Expired" ^ lev)]; 131 + El.txt " "; 132 + sups_el 133 + ] 134 + in 135 + status_and_info 136 + 137 + let sups_for i = 138 + let v = match MI.status i with 139 + | Completed -> "was" 140 + | Ongoing -> "is" 141 + | _ -> "may be" in 142 + let sups = List.filter (fun x -> x <> "avsm") i.supervisors in 143 + match sups with 144 + | [] -> "" 145 + | s -> " It " ^ v ^ " co-supervised with " ^ (Arod_view.map_and (sprintf "[@%s]") s) ^ "." 146 + 147 + let one_idea_full i = 148 + let studs = Arod_view.map_and (sprintf "[@%s]") (MI.students i) in 149 + let r = Printf.sprintf "# %s\n\nThis is an idea proposed in %d%s, and %s.%s\n\n%s" 150 + (MI.title i) (MI.year i) (level_to_long_string @@ MI.level i) (status_to_long_string studs (MI.status i)) (sups_for i) (MI.body i) 151 + in 152 + El.div ~at:[class_ "idea"] [ 153 + El.unsafe_raw (Arod_view.md_to_html r) 154 + ] 155 + 156 + let idea_for_feed i = 157 + let studs = Arod_view.map_and (sprintf "[@%s]") (MI.students i) in 158 + let r = Printf.sprintf "This is an idea proposed %s, and %s.%s" 159 + (level_to_long_string @@ MI.level i) (status_to_long_string studs (MI.status i)) (sups_for i) 160 + in 161 + let (body_html, word_count_info) = Arod_view.truncated_body (`Idea i) in 162 + (El.splice [ 163 + El.unsafe_raw (Arod_view.md_to_html r); 164 + body_html 165 + ], word_count_info) 166 + 167 + let one_idea_brief i = 168 + let studs = Arod_view.map_and (sprintf "[@%s]") (MI.students i) in 169 + let r = Printf.sprintf "This is an idea proposed in %d%s, and %s.%s" 170 + (MI.year i) (level_to_long_string @@ MI.level i) (status_to_long_string studs (MI.status i)) (sups_for i) 171 + in 172 + let (body_html, word_count_info) = Arod_view.truncated_body (`Idea i) in 173 + (El.splice [ 174 + Arod_view.entry_href (`Idea i); 175 + El.div ~at:[class_ "idea"] [ 176 + El.unsafe_raw (Arod_view.md_to_html r); 177 + body_html 178 + ] 179 + ], word_count_info) 180 + 181 + let view_ideas_by_project () = 182 + let entries = Arod_model.get_entries () in 183 + let all_ideas = Arod_model.Entry.ideas entries in 184 + let all_projects = Arod_model.Entry.projects entries 185 + |> List.sort Arod_model.Project.compare |> List.rev in 186 + 187 + let ideas_by_project = Hashtbl.create 32 in 188 + List.iter (fun i -> 189 + let proj_slug = MI.project i in 190 + let existing = try Hashtbl.find ideas_by_project proj_slug with Not_found -> [] in 191 + Hashtbl.replace ideas_by_project proj_slug (i :: existing) 192 + ) all_ideas; 193 + 194 + Hashtbl.iter (fun proj_slug ideas -> 195 + Hashtbl.replace ideas_by_project proj_slug (List.sort MI.compare ideas) 196 + ) ideas_by_project; 197 + 198 + let project_sections = List.filter_map (fun p -> 199 + let proj_slug = p.Arod_model.Project.slug in 200 + match Hashtbl.find_opt ideas_by_project proj_slug with 201 + | None -> None 202 + | Some ideas -> 203 + let idea_items = List.map (fun i -> 204 + El.li ~at:[At.class' "idea-item"; At.v "data-status" (MI.status_to_string (MI.status i))] [ 205 + idea_to_html_no_sidenotes i 206 + ] 207 + ) ideas in 208 + let thumbnail_md = Printf.sprintf "![%%lc](:project-%s \"%s\")" proj_slug p.Arod_model.Project.title in 209 + let thumbnail_html = El.unsafe_raw (Arod_view.md_to_html thumbnail_md) in 210 + Some (El.div ~at:[At.class' "project-section"] [ 211 + El.h2 [ 212 + El.a ~at:[At.href ("/projects/" ^ proj_slug)] [El.txt p.Arod_model.Project.title] 213 + ]; 214 + thumbnail_html; 215 + El.p [Arod_view.truncated_body (`Project p) |> fst]; 216 + El.ul ~at:[At.class' "ideas-list"] idea_items 217 + ]) 218 + ) all_projects in 219 + 220 + let status_filter = El.div ~at:[At.class' "status-filter"] [ 221 + El.h3 [El.txt "Filter by status:"]; 222 + El.label [ 223 + El.input ~at:[At.type' "checkbox"; At.id "filter-available"; At.checked; At.class' "status-checkbox"; At.v "data-status" "Available"] (); 224 + El.span ~at:[At.class' "status-label idea-available"] [El.txt "Available"] 225 + ]; 226 + El.label [ 227 + El.input ~at:[At.type' "checkbox"; At.id "filter-discussion"; At.checked; At.class' "status-checkbox"; At.v "data-status" "Discussion"] (); 228 + El.span ~at:[At.class' "status-label idea-discussion"] [El.txt "Discussion"] 229 + ]; 230 + El.label [ 231 + El.input ~at:[At.type' "checkbox"; At.id "filter-ongoing"; At.checked; At.class' "status-checkbox"; At.v "data-status" "Ongoing"] (); 232 + El.span ~at:[At.class' "status-label idea-ongoing"] [El.txt "Ongoing"] 233 + ]; 234 + El.label [ 235 + El.input ~at:[At.type' "checkbox"; At.id "filter-completed"; At.checked; At.class' "status-checkbox"; At.v "data-status" "Completed"] (); 236 + El.span ~at:[At.class' "status-label idea-completed"] [El.txt "Completed"] 237 + ]; 238 + El.label [ 239 + El.input ~at:[At.type' "checkbox"; At.id "filter-expired"; At.class' "status-checkbox"; At.v "data-status" "Expired"] (); 240 + El.span ~at:[At.class' "status-label idea-expired"] [El.txt "Expired"] 241 + ] 242 + ] in 243 + 244 + let title = "Research Ideas" in 245 + let description = "Research ideas grouped by project" in 246 + 247 + let intro = El.p [El.txt "These are research ideas for students at various levels (Part II, MPhil, PhD, and postdoctoral). Browse through the ideas below to find projects that interest you. You're also welcome to propose your own research ideas that align with our ongoing projects."] in 248 + 249 + let page_footer = Arod_footer.footer in 250 + let page_content = El.splice [ 251 + El.article [ 252 + El.h1 [El.txt title]; 253 + intro; 254 + El.splice project_sections 255 + ]; 256 + El.aside [ 257 + status_filter 258 + ] 259 + ] in 260 + Arod_page.page ~title ~page_content ~page_footer ~description ()

+194

arod/lib/arod_jsonfeed.ml

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** JSON feed generation for Arod webserver *) 7 + 8 + module E = Arod_model.Entry 9 + module N = Arod_model.Note 10 + module C = Sortal_schema.Contact 11 + module P = Arod_model.Paper 12 + module J = Jsonfeed 13 + 14 + let form_uri cfg path = cfg.Arod_config.site.base_url ^ path 15 + 16 + let author cfg c = 17 + let name = C.name c in 18 + let url = match C.orcid c with 19 + | Some orcid -> Some (Printf.sprintf "https://orcid.org/%s" orcid) 20 + | None -> C.best_url c 21 + in 22 + let avatar = Some (form_uri cfg "/images/anil-headshot.webp") in 23 + Jsonfeed.Author.create ?name:(Some name) ?url ?avatar () 24 + 25 + let item_of_note cfg note = 26 + let e = `Note note in 27 + let id = match N.doi note with 28 + | Some doi -> 29 + let is_valid_doi = 30 + not (String.contains doi ' ') && 31 + not (String.contains doi '\t') && 32 + not (String.contains doi '\n') && 33 + String.length doi > 0 34 + in 35 + if is_valid_doi then 36 + Printf.sprintf "https://doi.org/%s" doi 37 + else 38 + let note_title = N.title note in 39 + failwith (Printf.sprintf "Invalid DOI in note '%s': '%s'" note_title doi) 40 + | None -> form_uri cfg (E.site_url e) 41 + in 42 + let url = form_uri cfg (E.site_url e) in 43 + let title = N.title note in 44 + let date_published = N.origdate note in 45 + let date_modified = N.datetime note in 46 + let tags = N.tags note in 47 + 48 + let base_html = Arod_view.md_to_atom_html note.N.body in 49 + 50 + let is_perma = N.perma note in 51 + let has_doi = match N.doi note with Some _ -> true | None -> false in 52 + let html_with_refs = 53 + if is_perma || has_doi then 54 + let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with 55 + | Some c -> c 56 + | None -> failwith "Author not found" 57 + in 58 + let references = Bushel.Md.note_references (Arod_model.get_entries ()) me note in 59 + if List.length references > 0 then 60 + let refs_html = 61 + let ref_items = List.map (fun (doi, citation, _) -> 62 + let doi_url = Printf.sprintf "https://doi.org/%s" doi in 63 + Printf.sprintf "<li>%s<a href=\"%s\" target=\"_blank\"><i>%s</i></a></li>" 64 + citation doi_url doi 65 + ) references |> String.concat "\n" in 66 + Printf.sprintf "<h1>References</h1><ul>%s</ul>" ref_items 67 + in 68 + base_html ^ refs_html 69 + else 70 + base_html 71 + else 72 + base_html 73 + in 74 + let content = `Html html_with_refs in 75 + 76 + let external_url = match note.N.via with 77 + | Some (_title, via_url) -> Some via_url 78 + | None -> 79 + match N.link note with 80 + | `Local _ -> None 81 + | `Ext (_l, u) -> Some u 82 + in 83 + 84 + let image = match note.N.titleimage with 85 + | Some img_slug -> 86 + (try 87 + let entries = Arod_model.get_entries () in 88 + (match E.lookup_image entries img_slug with 89 + | Some img_ent -> 90 + let target_width = 1280 in 91 + let open Arod_model.Img in 92 + let variants = MS.bindings img_ent.variants in 93 + let best_variant = 94 + match variants with 95 + | [] -> 96 + Printf.sprintf "%s.webp" (Filename.chop_extension (origin img_ent)) 97 + | _ -> 98 + let sorted = List.sort (fun (_f1,(w1,_h1)) (_f2,(w2,_h2)) -> 99 + let diff1 = abs (w1 - target_width) in 100 + let diff2 = abs (w2 - target_width) in 101 + compare diff1 diff2 102 + ) variants in 103 + fst (List.hd sorted) 104 + in 105 + Some (Printf.sprintf "%s/images/%s" cfg.Arod_config.site.base_url best_variant) 106 + | None -> None) 107 + with Not_found -> None) 108 + | None -> None 109 + in 110 + 111 + let summary = note.N.synopsis in 112 + 113 + let attachments = match N.slug_ent note with 114 + | Some slug -> 115 + (match Arod_model.lookup slug with 116 + | Some (`Paper p) -> 117 + (match P.best_url p with 118 + | Some url when String.ends_with ~suffix:".pdf" url -> 119 + let pdf_url = form_uri cfg url in 120 + let pdf_title = P.title p in 121 + [J.Attachment.create ~url:pdf_url ~mime_type:"application/pdf" ~title:pdf_title ()] 122 + | _ -> []) 123 + | _ -> []) 124 + | None -> [] 125 + in 126 + 127 + let references = 128 + let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with 129 + | Some c -> c 130 + | None -> failwith "Author not found" 131 + in 132 + Bushel.Md.note_references (Arod_model.get_entries ()) me note 133 + |> List.map (fun (doi, _citation, ref_source) -> 134 + let doi_url = Printf.sprintf "https://doi.org/%s" doi in 135 + let cito = match ref_source with 136 + | Bushel.Md.Paper -> [`CitesAsSourceDocument] 137 + | Bushel.Md.Note -> [`CitesAsRelated] 138 + | Bushel.Md.External -> [`Cites] 139 + in 140 + J.Reference.create ~url:doi_url ~doi ~cito () 141 + ) 142 + in 143 + 144 + let json_author = author cfg (Arod_model.lookup_by_handle cfg.site.author_handle |> Option.get) in 145 + 146 + Jsonfeed.Item.create 147 + ~id 148 + ~content 149 + ~url 150 + ?external_url 151 + ?image 152 + ?summary 153 + ~title 154 + ~date_published 155 + ~date_modified 156 + ~authors:[json_author] 157 + ~tags 158 + ~attachments 159 + ~references 160 + () 161 + 162 + let item_of_entry cfg (e:Arod_model.Entry.entry) = 163 + match e with 164 + | `Note n -> Some (item_of_note cfg n) 165 + | _ -> None 166 + 167 + let feed cfg uri entries = 168 + let title = cfg.Arod_config.site.name ^ "'s feed" in 169 + let home_page_url = cfg.site.base_url in 170 + let feed_url = form_uri cfg uri in 171 + let icon = cfg.site.base_url ^ "/assets/favicon.ico" in 172 + let json_author = author cfg (Arod_model.lookup_by_handle cfg.site.author_handle |> Option.get) in 173 + let authors = [json_author] in 174 + let language = "en-US" in 175 + 176 + let items = List.filter_map (item_of_entry cfg) entries in 177 + 178 + Jsonfeed.create 179 + ~title 180 + ~home_page_url 181 + ~feed_url 182 + ~icon 183 + ~authors 184 + ~language 185 + ~items 186 + () 187 + 188 + let feed_string cfg uri entries = 189 + let f = feed cfg uri entries in 190 + match Jsonfeed.to_string f with 191 + | Ok s -> s 192 + | Error e -> 193 + let msg = Fmt.str "Failed to encode JSON Feed: %a" Jsont.Error.pp e in 194 + failwith msg

+39 -24

arod/lib/arod_model.ml

··· 16 module Md = Bushel.Md 17 module Util = Bushel.Util 18 module Img = Srcsetter 0 19 20 (** {1 Global State} *) 21 ··· 100 let open Cmarkit_renderer.Context in 101 let inline c = function 102 | Inline.Image (img, _meta) -> 103 - (* Handle bushel image syntax *) 104 (match Inline.Link.reference img with 105 | `Inline (ld, _) -> 106 (match Link_definition.dest ld with ··· 138 | Some img -> "/images/" ^ Img.name img 139 | None -> "/images/" ^ slug ^ ".webp" 140 in 0 0 0 0 0 0 0 0 0 0 141 (* Check for positioning directive *) 142 (match caption with 143 | "%c" | "%r" | "%lc" | "%rc" -> ··· 148 | "%rc" -> "image-right-float" 149 | _ -> "image-center" 150 in 151 - let srcset_attr = match img_info with 152 - | Some img -> 153 - let variants = Img.variants img in 154 - let parts = Img.MS.fold (fun name (w, _) acc -> 155 - Printf.sprintf "/images/%s %dw" name w :: acc 156 - ) variants [] in 157 - if parts = [] then "" 158 - else Printf.sprintf " srcset=\"%s\"" (String.concat ", " parts) 159 - | None -> "" 160 - in 161 let html = Printf.sprintf 162 - {|<figure class="%s"><img src="%s" alt="%s" title="%s" loading="lazy"%s><figcaption>%s</figcaption></figure>|} 163 fig_class dest title title srcset_attr title 164 in 165 string c html; 166 true 167 | _ -> 168 - (* Regular image *) 169 - let srcset_attr = match img_info with 170 - | Some img -> 171 - let variants = Img.variants img in 172 - let parts = Img.MS.fold (fun name (w, _) acc -> 173 - Printf.sprintf "/images/%s %dw" name w :: acc 174 - ) variants [] in 175 - if parts = [] then "" 176 - else Printf.sprintf " srcset=\"%s\"" (String.concat ", " parts) 177 - | None -> "" 178 - in 179 let html = Printf.sprintf 180 - {|<img src="%s" alt="%s" title="%s" loading="lazy"%s>|} 181 dest caption title srcset_attr 182 in 183 string c html; ··· 205 206 let concat_tags tags1 tags2 = 207 tags1 @ (List.filter (fun t -> not (List.mem t tags1)) tags2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 16 module Md = Bushel.Md 17 module Util = Bushel.Util 18 module Img = Srcsetter 19 + module Contact = Sortal_schema.Contact 20 21 (** {1 Global State} *) 22 ··· 101 let open Cmarkit_renderer.Context in 102 let inline c = function 103 | Inline.Image (img, _meta) -> 104 + (* Handle bushel image syntax - :slug format *) 105 (match Inline.Link.reference img with 106 | `Inline (ld, _) -> 107 (match Link_definition.dest ld with ··· 139 | Some img -> "/images/" ^ Img.name img 140 | None -> "/images/" ^ slug ^ ".webp" 141 in 142 + let srcset_attr = match img_info with 143 + | Some img -> 144 + let variants = Img.variants img in 145 + let parts = Img.MS.fold (fun name (w, _) acc -> 146 + Printf.sprintf "/images/%s %dw" name w :: acc 147 + ) variants [] in 148 + if parts = [] then "" 149 + else Printf.sprintf " srcset=\"%s\"" (String.concat ", " parts) 150 + | None -> "" 151 + in 152 (* Check for positioning directive *) 153 (match caption with 154 | "%c" | "%r" | "%lc" | "%rc" -> ··· 159 | "%rc" -> "image-right-float" 160 | _ -> "image-center" 161 in 0 0 0 0 0 0 0 0 0 0 162 let html = Printf.sprintf 163 + {|<figure class="%s"><img class="content-image" src="%s" alt="%s" title="%s" loading="lazy"%s sizes="(max-width: 768px) 100vw, 33vw"><figcaption>%s</figcaption></figure>|} 164 fig_class dest title title srcset_attr title 165 in 166 string c html; 167 true 168 | _ -> 169 + (* Regular image with content-image class for lightbox *) 0 0 0 0 0 0 0 0 0 0 170 let html = Printf.sprintf 171 + {|<img class="content-image" src="%s" alt="%s" title="%s" loading="lazy"%s sizes="(max-width: 768px) 100vw, 33vw">|} 172 dest caption title srcset_attr 173 in 174 string c html; ··· 196 197 let concat_tags tags1 tags2 = 198 tags1 @ (List.filter (fun t -> not (List.mem t tags1)) tags2) 199 + 200 + (** Count tags across all entries *) 201 + let count_tags_for_ents entries = 202 + let counts = Hashtbl.create 32 in 203 + List.iter (fun ent -> 204 + let tags = Entry.tags_of_ent (get_entries ()) ent in 205 + List.iter (fun tag -> 206 + let current = Hashtbl.find_opt counts tag |> Option.value ~default:0 in 207 + Hashtbl.replace counts tag (current + 1) 208 + ) tags 209 + ) entries; 210 + counts 211 + 212 + (** Get category tags with counts for the header navigation *) 213 + let cats () = 214 + let entries = all_entries () in 215 + let counts = count_tags_for_ents entries in 216 + Hashtbl.fold (fun k v acc -> 217 + match k with 218 + | `Set "videos" -> acc (* Skip videos, use talks instead *) 219 + | `Set _ -> (k, v) :: acc 220 + | _ -> acc 221 + ) counts [] 222 + |> List.sort (fun (a, _) (b, _) -> compare (Tags.to_string a) (Tags.to_string b))

+32

arod/lib/arod_notes.ml

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Note rendering for Arod webserver *) 7 + 8 + open Htmlit 9 + 10 + let note_for_feed n = 11 + let (body_html, word_count_info) = Arod_view.truncated_body (`Note n) in 12 + (body_html, word_count_info) 13 + 14 + let one_note_brief n = 15 + let (body_html, word_count_info) = Arod_view.truncated_body (`Note n) in 16 + (El.splice [ 17 + Arod_view.entry_href (`Note n); 18 + body_html 19 + ], word_count_info) 20 + 21 + let one_note_full n = 22 + let body = Arod_model.Note.body n in 23 + let body_with_ref = match Arod_model.Note.slug_ent n with 24 + | None -> body 25 + | Some slug_ent -> 26 + let parent_ent = Arod_model.lookup_exn slug_ent in 27 + let parent_title = Arod_model.Entry.title parent_ent in 28 + body ^ "\n\nRead more about [" ^ parent_title ^ "](:" ^ slug_ent ^ ")." 29 + in 30 + El.div ~at:[At.class' "note"] [ 31 + El.unsafe_raw (Arod_view.md_to_html body_with_ref) 32 + ]

+303

arod/lib/arod_page.ml

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Page layout for Arod webserver *) 7 + 8 + open Htmlit 9 + 10 + (** SVG icons for navigation *) 11 + let svg_icon_paper = 12 + El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M3 2 L3 30 29 30 29 10 21 2 Z M21 2 L21 10 29 10 M7 14 L17 14 M7 18 L25 18 M7 22 L25 22 M7 26 L17 26" /></svg>|} 13 + 14 + let svg_icon_project = 15 + El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M2 26 L30 26 30 8 2 8 Z M2 8 L10 8 12 4 20 4 22 8" /></svg>|} 16 + 17 + let svg_icon_note = 18 + El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M16 7 C16 7 2 11 2 22 L2 30 10 30 C10 30 22 30 30 22 M16 7 L30 22 M16 7 L30 4 30 22 M30 4 L16 4 10 10" /></svg>|} 19 + 20 + let svg_icon_video = 21 + El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M22 13 L30 8 30 24 22 19 Z M2 8 L2 24 22 24 22 8 Z" /></svg>|} 22 + 23 + let svg_icon_idea = 24 + El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M18 13 L26 2 8 13 14 19 6 30 24 19 Z" /></svg>|} 25 + 26 + let svg_icon_search = 27 + El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 24 24" width="18" height="18" fill="none" stroke="currentColor" stroke-width="2" stroke-linecap="round" stroke-linejoin="round"><circle cx="11" cy="11" r="8"/><path d="m21 21-4.35-4.35"/></svg>|} 28 + 29 + (** Search modal HTML *) 30 + let search_modal = 31 + El.div ~at:[At.class' "search-modal"; At.id "search-modal"] [ 32 + El.div ~at:[At.class' "search-modal-content"] [ 33 + El.div ~at:[At.class' "search-modal-header"] [ 34 + El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 24 24" width="20" height="20" fill="none" stroke="currentColor" stroke-width="2" stroke-linecap="round" stroke-linejoin="round"><circle cx="11" cy="11" r="8"/><path d="m21 21-4.35-4.35"/></svg>|}; 35 + El.input ~at:[ 36 + At.class' "search-modal-input"; 37 + At.id "search-modal-input"; 38 + At.type' "text"; 39 + At.v "placeholder" "Search papers, notes, videos, projects..."; 40 + At.v "autocomplete" "off" 41 + ] (); 42 + El.button ~at:[At.class' "search-modal-close"; At.id "search-modal-close"] [ 43 + El.txt "×" 44 + ] 45 + ]; 46 + El.div ~at:[At.class' "search-filters"; At.id "search-filters"] [ 47 + El.div ~at:[At.class' "search-filters-controls"] [ 48 + El.button ~at:[At.class' "search-filter-toggle"; At.id "filter-toggle-all"] [El.txt "All"]; 49 + El.button ~at:[At.class' "search-filter-toggle"; At.id "filter-toggle-none"] [El.txt "None"] 50 + ]; 51 + El.button ~at:[At.class' "search-filter active"; At.v "data-collection" "papers"] [El.txt "Papers"]; 52 + El.button ~at:[At.class' "search-filter active"; At.v "data-collection" "notes"] [El.txt "Notes"]; 53 + El.button ~at:[At.class' "search-filter active"; At.v "data-collection" "videos"] [El.txt "Videos"]; 54 + El.button ~at:[At.class' "search-filter active"; At.v "data-collection" "projects"] [El.txt "Projects"]; 55 + El.button ~at:[At.class' "search-filter active"; At.v "data-collection" "ideas"] [El.txt "Ideas"] 56 + ]; 57 + El.div ~at:[At.class' "search-modal-body"; At.id "search-modal-body"] [ 58 + El.div ~at:[At.class' "search-loading"] [ 59 + El.txt "Loading recent items..." 60 + ] 61 + ]; 62 + El.div ~at:[At.class' "search-modal-footer"] [ 63 + El.div ~at:[At.class' "search-status"; At.id "search-status"] [ 64 + El.span ~at:[At.class' "search-status-indicator"] []; 65 + El.span ~at:[At.class' "search-status-text"] [El.txt "Ready"] 66 + ]; 67 + El.div ~at:[At.class' "search-keyboard-hint"] [ 68 + El.span [ 69 + El.unsafe_raw {|<kbd>↑</kbd> <kbd>↓</kbd>|}; 70 + El.txt " navigate" 71 + ]; 72 + El.span [ 73 + El.unsafe_raw {|<kbd>↵</kbd>|}; 74 + El.txt " select" 75 + ]; 76 + El.span [ 77 + El.unsafe_raw {|<kbd>ESC</kbd>|}; 78 + El.txt " close" 79 + ] 80 + ] 81 + ] 82 + ] 83 + ] 84 + 85 + let page ?(image="/assets/imagetitle-default.jpg") ?(jsonld="") ?standardsite ?(page_footer=El.splice []) ~title ~description ~page_content:content () = 86 + let cfg = Arod_model.get_config () in 87 + let page_title = if title = "" then cfg.site.name else title in 88 + 89 + let head_els = [ 90 + El.title [El.txt page_title]; 91 + El.meta ~at:[At.charset "UTF-8"] (); 92 + El.meta ~at:[At.name "viewport"; At.content "width=device-width, initial-scale=1.0"] (); 93 + El.meta ~at:[At.v "http-equiv" "X-UA-Compatible"; At.content "ie=edge"] (); 94 + El.meta ~at:[At.name "description"; At.content description] (); 95 + El.meta ~at:[At.v "property" "og:image"; At.content image] (); 96 + El.meta ~at:[At.v "property" "og:site_name"; At.content cfg.site.name] (); 97 + El.meta ~at:[At.v "property" "og:type"; At.content "object"] (); 98 + El.meta ~at:[At.v "property" "og:title"; At.content page_title] (); 99 + El.meta ~at:[At.v "property" "og:description"; At.content description] (); 100 + El.meta ~at:[At.name "twitter:card"; At.content "summary_large_image"] (); 101 + El.meta ~at:[At.name "twitter:title"; At.content page_title] (); 102 + El.meta ~at:[At.name "twitter:description"; At.content description] (); 103 + El.meta ~at:[At.name "twitter:image"; At.content image] (); 104 + El.meta ~at:[At.name "theme-color"; At.content "#fff"] (); 105 + El.meta ~at:[At.name "color-scheme"; At.content "white"] (); 106 + El.link ~at:[At.rel "apple-touch-icon"; At.v "sizes" "180x180"; At.href "/assets/apple-touch-icon.png"] (); 107 + El.link ~at:[At.rel "icon"; At.type' "image/png"; At.v "sizes" "32x32"; At.href "/assets/favicon-32x32.png"] (); 108 + El.link ~at:[At.rel "icon"; At.type' "image/png"; At.v "sizes" "16x16"; At.href "/assets/favicon-16x16.png"] (); 109 + El.link ~at:[At.rel "alternate"; At.type' "application/atom+xml"; At.title "Atom Feed"; At.href "/news.xml"] (); 110 + El.link ~at:[At.rel "alternate"; At.type' "application/atom+xml"; At.title "Perma Feed (Significant Articles)"; At.href "/perma.xml"] (); 111 + El.link ~at:[At.rel "alternate"; At.type' "application/feed+json"; At.title "JSON Feed"; At.href "/feed.json"] (); 112 + El.link ~at:[At.rel "alternate"; At.type' "application/feed+json"; At.title "Perma JSON Feed (Significant Articles)"; At.href "/perma.json"] (); 113 + El.link ~at:[At.rel "stylesheet"; At.href "/assets/site.css"] (); 114 + El.link ~at:[At.rel "stylesheet"; At.href "/assets/highlight.min.css"] (); 115 + El.unsafe_raw jsonld; 116 + El.script ~at:[At.src "/assets/highlight.min.js"] []; 117 + El.script [El.txt "hljs.highlightAll();"] 118 + ] in 119 + 120 + (* Add standardsite link if present *) 121 + let head_els = match standardsite with 122 + | Some url -> head_els @ [El.link ~at:[At.rel "site.standard.document"; At.href url] ()] 123 + | None -> head_els 124 + in 125 + 126 + let header_el = El.header ~at:[At.class' "site-header"] [ 127 + El.div ~at:[At.class' "header-content"] [ 128 + (* Site name on the left *) 129 + El.h1 ~at:[At.class' "site-name"] [ 130 + El.a ~at:[At.href "/"] [El.txt cfg.site.name] 131 + ]; 132 + (* Navigation links *) 133 + El.nav ~at:[At.class' "main-nav"] [ 134 + El.a ~at:[At.class' "nav-link"; At.href "/papers"] [ 135 + svg_icon_paper; 136 + El.txt "Papers" 137 + ]; 138 + El.a ~at:[At.class' "nav-link"; At.href "/projects"] [ 139 + svg_icon_project; 140 + El.txt "Projects" 141 + ]; 142 + El.a ~at:[At.class' "nav-link"; At.href "/notes"] [ 143 + svg_icon_note; 144 + El.txt "Notes" 145 + ]; 146 + El.a ~at:[At.class' "nav-link"; At.href "/videos"] [ 147 + svg_icon_video; 148 + El.txt "Talks" 149 + ]; 150 + El.a ~at:[At.class' "nav-link"; At.href "/ideas"] [ 151 + svg_icon_idea; 152 + El.txt "Ideas" 153 + ] 154 + ]; 155 + (* Right side: Search *) 156 + El.div ~at:[At.class' "header-right"] [ 157 + El.div ~at:[At.class' "search-container"] [ 158 + El.button ~at:[ 159 + At.class' "search-toggle"; 160 + At.v "aria-label" "Search"; 161 + At.id "search-toggle-btn" 162 + ] [ 163 + svg_icon_search; 164 + El.span ~at:[At.class' "search-label"] [El.txt "Search"] 165 + ] 166 + ] 167 + ] 168 + ] 169 + ] in 170 + 171 + let footer_el = El.footer [page_footer] in 172 + 173 + let body_el = El.body ~at:[At.class' "light"] [ 174 + header_el; 175 + El.div ~at:[At.class' "content-grid"] [content]; 176 + footer_el; 177 + search_modal; 178 + El.script ~at:[At.src "/assets/site.js"] [] 179 + ] in 180 + 181 + El.page ~lang:"en" ~title:title ~more_head:(El.splice head_els) body_el 182 + 183 + let bushel_graph () = 184 + let title = "Bushel Link Graph" in 185 + let description = "Interactive force-directed graph visualization of links and backlinks in the Bushel dataset" in 186 + 187 + let graph_html = El.div [ 188 + El.h1 [El.txt "Bushel Link Graph"]; 189 + 190 + El.div ~at:[At.id "controls"; At.style "margin: 20px 0; padding: 15px; background: #f5f5f5; border-radius: 5px;"] [ 191 + El.div ~at:[At.style "margin-bottom: 10px;"] [ 192 + El.strong [El.txt "Filter by type: "]; 193 + El.label ~at:[At.style "margin: 0 10px;"] [ 194 + El.input ~at:[At.type' "checkbox"; At.id "filter-paper"; At.checked; At.class' "type-filter"] (); 195 + El.txt " Papers" 196 + ]; 197 + El.label ~at:[At.style "margin: 0 10px;"] [ 198 + El.input ~at:[At.type' "checkbox"; At.id "filter-project"; At.checked; At.class' "type-filter"] (); 199 + El.txt " Projects" 200 + ]; 201 + El.label ~at:[At.style "margin: 0 10px;"] [ 202 + El.input ~at:[At.type' "checkbox"; At.id "filter-note"; At.checked; At.class' "type-filter"] (); 203 + El.txt " Notes" 204 + ]; 205 + El.label ~at:[At.style "margin: 0 10px;"] [ 206 + El.input ~at:[At.type' "checkbox"; At.id "filter-idea"; At.checked; At.class' "type-filter"] (); 207 + El.txt " Ideas" 208 + ]; 209 + El.label ~at:[At.style "margin: 0 10px;"] [ 210 + El.input ~at:[At.type' "checkbox"; At.id "filter-video"; At.checked; At.class' "type-filter"] (); 211 + El.txt " Videos" 212 + ]; 213 + El.label ~at:[At.style "margin: 0 10px;"] [ 214 + El.input ~at:[At.type' "checkbox"; At.id "filter-contact"; At.checked; At.class' "type-filter"] (); 215 + El.txt " Contacts" 216 + ]; 217 + El.label ~at:[At.style "margin: 0 10px;"] [ 218 + El.input ~at:[At.type' "checkbox"; At.id "filter-domain"; At.checked; At.class' "type-filter"] (); 219 + El.txt " Domains" 220 + ] 221 + ]; 222 + El.div ~at:[At.style "margin-bottom: 10px;"] [ 223 + El.strong [El.txt "Link type: "]; 224 + El.label ~at:[At.style "margin: 0 10px;"] [ 225 + El.input ~at:[At.type' "checkbox"; At.id "filter-internal"; At.checked; At.class' "link-filter"] (); 226 + El.txt " Internal" 227 + ]; 228 + El.label ~at:[At.style "margin: 0 10px;"] [ 229 + El.input ~at:[At.type' "checkbox"; At.id "filter-external"; At.checked; At.class' "link-filter"] (); 230 + El.txt " External" 231 + ] 232 + ]; 233 + El.div [ 234 + El.button ~at:[At.id "reset-filters"; At.style "padding: 5px 15px; cursor: pointer;"] [El.txt "Reset Filters"] 235 + ] 236 + ]; 237 + 238 + El.div ~at:[At.id "graph"; At.style "width: 100%; height: 800px; border: 1px solid #ddd;"] []; 239 + 240 + El.script ~at:[At.src "https://d3js.org/d3.v7.min.js"] []; 241 + 242 + El.script [El.unsafe_raw {| 243 + fetch('/bushel/graph.json') 244 + .then(response => response.json()) 245 + .then(data => { initGraph(data); }) 246 + .catch(error => { 247 + console.error('Error loading graph data:', error); 248 + document.getElementById('graph').innerHTML = '<p style="color: red;">Error loading graph data</p>'; 249 + }); 250 + 251 + function initGraph(graphData) { 252 + const width = document.getElementById('graph').offsetWidth; 253 + const height = 800; 254 + const colors = { 255 + 'paper': '#4285f4', 'project': '#ea4335', 'note': '#fbbc04', 256 + 'idea': '#34a853', 'video': '#ff6d00', 'contact': '#9c27b0', 'domain': '#607d8b' 257 + }; 258 + const svg = d3.select('#graph').append('svg').attr('width', width).attr('height', height); 259 + const g = svg.append('g'); 260 + svg.call(d3.zoom().scaleExtent([0.1, 4]).on('zoom', (event) => g.attr('transform', event.transform))); 261 + const simulation = d3.forceSimulation(graphData.nodes) 262 + .force('link', d3.forceLink(graphData.links).id(d => d.id).distance(d => d.type === 'external' ? 150 : 100)) 263 + .force('charge', d3.forceManyBody().strength(-300)) 264 + .force('center', d3.forceCenter(width / 2, height / 2)) 265 + .force('collision', d3.forceCollide().radius(30)); 266 + const link = g.append('g').selectAll('line').data(graphData.links).join('line') 267 + .attr('class', d => 'link link-' + d.type) 268 + .attr('stroke', d => d.type === 'internal' ? '#999' : '#ccc') 269 + .attr('stroke-opacity', 0.6).attr('stroke-width', 1); 270 + const node = g.append('g').selectAll('g').data(graphData.nodes).join('g') 271 + .attr('class', d => 'node node-' + d.type).style('cursor', 'pointer') 272 + .call(d3.drag().on('start', dragstarted).on('drag', dragged).on('end', dragended)); 273 + node.append('circle').attr('r', d => d.group === 'domain' ? 8 : 10) 274 + .attr('fill', d => colors[d.type] || '#999').attr('stroke', '#fff').attr('stroke-width', 2); 275 + node.append('text').text(d => d.group === 'domain' ? d.title : d.id) 276 + .attr('x', 12).attr('y', 4).attr('font-size', '10px').attr('fill', '#333'); 277 + node.append('title').text(d => d.title + '\nType: ' + d.type); 278 + simulation.on('tick', () => { 279 + link.attr('x1', d => d.source.x).attr('y1', d => d.source.y).attr('x2', d => d.target.x).attr('y2', d => d.target.y); 280 + node.attr('transform', d => 'translate(' + d.x + ',' + d.y + ')'); 281 + }); 282 + function dragstarted(event) { if (!event.active) simulation.alphaTarget(0.3).restart(); event.subject.fx = event.subject.x; event.subject.fy = event.subject.y; } 283 + function dragged(event) { event.subject.fx = event.x; event.subject.fy = event.y; } 284 + function dragended(event) { if (!event.active) simulation.alphaTarget(0); event.subject.fx = null; event.subject.fy = null; } 285 + function updateFilters() { 286 + const activeTypes = new Set(); 287 + document.querySelectorAll('.type-filter').forEach(cb => { if (cb.checked) activeTypes.add(cb.id.replace('filter-', '')); }); 288 + const activeLinks = new Set(); 289 + document.querySelectorAll('.link-filter').forEach(cb => { if (cb.checked) activeLinks.add(cb.id.replace('filter-', '')); }); 290 + node.style('display', d => activeTypes.has(d.type) ? null : 'none'); 291 + link.style('display', d => (activeTypes.has(d.source.type) && activeTypes.has(d.target.type) && activeLinks.has(d.type)) ? null : 'none'); 292 + simulation.alpha(0.3).restart(); 293 + } 294 + document.querySelectorAll('.type-filter, .link-filter').forEach(cb => cb.addEventListener('change', updateFilters)); 295 + document.getElementById('reset-filters').addEventListener('click', () => { 296 + document.querySelectorAll('.type-filter, .link-filter').forEach(cb => cb.checked = true); 297 + updateFilters(); 298 + }); 299 + } 300 + |}] 301 + ] in 302 + 303 + page ~title ~description ~page_content:graph_html ~page_footer:Arod_footer.footer ()

+214

arod/lib/arod_papers.ml

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Paper rendering for Arod webserver *) 7 + 8 + open Htmlit 9 + open Printf 10 + 11 + module MP = Arod_model.Paper 12 + module MC = Arod_model.Contact 13 + 14 + (** Author name with text-wrap:nowrap *) 15 + let author_name name = 16 + El.span ~at:[At.style "text-wrap:nowrap"] [El.txt name] 17 + 18 + (** Render one author - link to their best URL if available *) 19 + let one_author author_name_str = 20 + match Arod_model.lookup_by_name author_name_str with 21 + | None -> 22 + El.span ~at:[At.class' "author"] [author_name author_name_str] 23 + | Some contact -> 24 + let name = MC.name contact in 25 + match MC.best_url contact with 26 + | None -> 27 + El.span ~at:[At.class' "author"] [author_name name] 28 + | Some url -> 29 + El.a ~at:[At.href url] [author_name name] 30 + 31 + (** Render all authors with proper comma and "and" formatting *) 32 + let authors p = 33 + let author_names = MP.authors p in 34 + let author_els = List.map one_author author_names in 35 + match author_els with 36 + | [] -> El.splice [] 37 + | [a] -> a 38 + | els -> 39 + let rec make_list = function 40 + | [] -> [] 41 + | [x] -> [El.txt " and "; x] 42 + | x :: xs -> x :: El.txt ", " :: make_list xs 43 + in 44 + El.splice (make_list els) 45 + 46 + (** Generate publication info based on bibtype *) 47 + let paper_publisher p = 48 + let bibty = MP.bibtype p in 49 + let ourl l = function 50 + | None -> l 51 + | Some u -> sprintf {|<a href="%s">%s</a>|} u l 52 + in 53 + let string_of_vol_issue p = 54 + match (MP.volume p), (MP.number p) with 55 + | Some v, Some n -> sprintf " (vol %s issue %s)" v n 56 + | Some v, None -> sprintf " (vol %s)" v 57 + | None, Some n -> sprintf " (issue %s)" n 58 + | _ -> "" 59 + in 60 + let result = match String.lowercase_ascii bibty with 61 + | "misc" -> 62 + sprintf {|Working paper at %s|} (ourl (MP.publisher p) (MP.url p)) 63 + | "inproceedings" -> 64 + sprintf {|Paper in the %s|} (ourl (MP.booktitle p) (MP.url p)) 65 + | "proceedings" -> 66 + sprintf {|%s|} (ourl (MP.title p) (MP.url p)) 67 + | "abstract" -> 68 + sprintf {|Abstract in the %s|} (ourl (MP.booktitle p) (MP.url p)) 69 + | "article" | "journal" -> 70 + sprintf {|Journal paper in %s%s|} (ourl (MP.journal p) (MP.url p)) (string_of_vol_issue p) 71 + | "book" -> 72 + sprintf {|Book published by %s|} (ourl (MP.publisher p) (MP.url p)) 73 + | "techreport" -> 74 + sprintf {|Technical report%s at %s|} 75 + (match MP.number p with None -> "" | Some n -> " (" ^ n ^ ")") 76 + (ourl (MP.institution p) (MP.url p)) 77 + | _ -> sprintf {|Publication in %s|} (ourl (MP.publisher p) (MP.url p)) 78 + in 79 + El.unsafe_raw result 80 + 81 + (** Extract host without www prefix *) 82 + let host_without_www u = 83 + match Uri.host (Uri.of_string u) with 84 + | None -> "" 85 + | Some h -> 86 + if String.starts_with ~prefix:"www." h then 87 + String.sub h 4 (String.length h - 4) 88 + else h 89 + 90 + (** Render the links bar (URL, DOI, BIB, PDF) *) 91 + let paper_bar_for_feed ?(nopdf=false) p = 92 + let cfg = Arod_model.get_config () in 93 + let pdf = 94 + let pdf_path = Filename.concat cfg.paths.static_dir (sprintf "papers/%s.pdf" (MP.slug p)) in 95 + if Sys.file_exists pdf_path && not nopdf then 96 + Some (El.a ~at:[At.href (sprintf "/papers/%s.pdf" (MP.slug p))] [ 97 + El.span ~at:[At.class' "nobreak"] [ 98 + El.txt "PDF"; 99 + El.img ~at:[At.class' "inline-icon"; At.alt "pdf"; At.src "/assets/pdf.svg"] () 100 + ] 101 + ]) 102 + else None 103 + in 104 + let bib = 105 + if nopdf then None 106 + else Some (El.a ~at:[At.href (sprintf "/papers/%s.bib" (MP.slug p))] [El.txt "BIB"]) 107 + in 108 + let url = 109 + match MP.url p with 110 + | None -> None 111 + | Some u -> 112 + Some (El.splice [ 113 + El.a ~at:[At.href u] [El.txt "URL"]; 114 + El.txt " "; 115 + El.unsafe_raw (sprintf {|<i style="color: #666666">(%s)</i>|} (host_without_www u)) 116 + ]) 117 + in 118 + let doi = 119 + match MP.doi p with 120 + | None -> None 121 + | Some d -> 122 + Some (El.a ~at:[At.href ("https://doi.org/" ^ d)] [El.txt "DOI"]) 123 + in 124 + let bits = [url; doi; bib; pdf] |> List.filter_map Fun.id in 125 + El.splice ~sep:(El.unsafe_raw " &nbsp; ") bits 126 + 127 + (** Render paper for feed/listing (blockquote style) *) 128 + let paper_for_feed p = 129 + let title_el = El.p ~at:[At.class' "paper-title"] [ 130 + El.a ~at:[At.href (Arod_model.Entry.site_url (`Paper p))] [El.txt (MP.title p)] 131 + ] in 132 + (El.blockquote ~at:[At.class' "paper noquote"] [ 133 + El.div ~at:[At.class' "paper-info"] [ 134 + title_el; 135 + El.p [authors p; El.txt "."]; 136 + El.p [paper_publisher p; El.txt "."]; 137 + El.p [paper_bar_for_feed p] 138 + ] 139 + ], None) 140 + 141 + (** Render paper for entry listing *) 142 + let paper_for_entry ?nopdf p = 143 + (El.div ~at:[At.class' "paper"] [ 144 + El.div ~at:[At.class' "paper-info"] [ 145 + El.p ~at:[At.class' "paper-title"] [ 146 + El.a ~at:[At.href (Arod_model.Entry.site_url (`Paper p))] [El.txt (MP.title p)] 147 + ]; 148 + El.p [authors p; El.txt "."]; 149 + El.p [paper_publisher p; El.txt "."]; 150 + El.p [paper_bar_for_feed ?nopdf p] 151 + ] 152 + ], None) 153 + 154 + (** Render older versions section for a paper *) 155 + let one_paper_extra p = 156 + let entries = Arod_model.get_entries () in 157 + let all = Arod_model.Entry.old_papers entries 158 + |> List.filter (fun op -> MP.slug op = MP.slug p) 159 + in 160 + match all with 161 + | [] -> El.splice [] 162 + | all -> 163 + let older_versions = List.map (fun op -> 164 + let (paper_html, _) = paper_for_entry ~nopdf:true op in 165 + El.splice [ 166 + El.hr (); 167 + El.p [ 168 + El.txt ("This is " ^ op.Arod_model.Paper.ver ^ " of the publication from " ^ 169 + Arod_view.ptime_date ~with_d:false (MP.date op) ^ ".") 170 + ]; 171 + El.blockquote ~at:[At.class' "noquote"] [ 172 + paper_html 173 + ]; 174 + Arod_view.tags_meta (`Paper op) 175 + ] 176 + ) all in 177 + El.splice [ 178 + El.h1 [El.txt "Older versions"]; 179 + El.p [ 180 + El.txt "There are earlier revisions of this paper available below for historical reasons. "; 181 + El.txt "Please cite the latest version of the paper above instead of these." 182 + ]; 183 + El.splice older_versions 184 + ] 185 + 186 + (** Render full paper page *) 187 + let one_paper_full p = 188 + let img_el = 189 + match Arod_model.lookup_image (MP.slug p) with 190 + | Some img -> 191 + El.p [ 192 + El.a ~at:[At.href (Option.value ~default:"#" (MP.best_url p))] [ 193 + Arod_view.img ~cl:"image-center" img 194 + ] 195 + ] 196 + | None -> El.splice [] 197 + in 198 + let abstract_html = 199 + let abstract = MP.abstract p in 200 + if abstract <> "" then 201 + El.p [El.unsafe_raw (Arod_view.md_to_html abstract)] 202 + else 203 + El.splice [] 204 + in 205 + El.div ~at:[At.class' "paper"] [ 206 + El.div ~at:[At.class' "paper-info"] [ 207 + El.h2 [El.txt (MP.title p)]; 208 + El.p [authors p; El.txt "."]; 209 + El.p [paper_publisher p; El.txt "."]; 210 + El.p [paper_bar_for_feed p] 211 + ]; 212 + img_el; 213 + abstract_html 214 + ]

+255

arod/lib/arod_projects.ml

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Project rendering for Arod webserver *) 7 + 8 + open Htmlit 9 + open Printf 10 + 11 + module MP = Arod_model.Project 12 + module StringSet = Set.Make(String) 13 + 14 + let class_ c = At.class' c 15 + 16 + let ideas_for_project entries project = 17 + List.filter (fun i -> Arod_model.Idea.project i = project.MP.slug) 18 + (Arod_model.Entry.ideas entries) 19 + 20 + let project_for_feed p = 21 + let (body_html, word_count_info) = Arod_view.truncated_body (`Project p) in 22 + (El.div [body_html], word_count_info) 23 + 24 + let one_project_brief p = 25 + let entries = Arod_model.get_entries () in 26 + let idea_items = ideas_for_project entries p 27 + |> List.sort Arod_model.Idea.compare 28 + |> List.map (fun i -> 29 + El.li [Arod_ideas.idea_to_html_no_sidenotes i] 30 + ) in 31 + let (body_html, word_count_info) = Arod_view.truncated_body (`Project p) in 32 + (El.splice [ 33 + Arod_view.entry_href (`Project p); 34 + body_html; 35 + El.ul idea_items 36 + ], word_count_info) 37 + 38 + let one_project_full p = 39 + let entries = Arod_model.get_entries () in 40 + let project_slug = p.MP.slug in 41 + 42 + let backlink_slugs = Bushel.Link_graph.get_backlinks_for_slug project_slug in 43 + let backlink_set = List.fold_left (fun acc slug -> 44 + StringSet.add slug acc 45 + ) StringSet.empty backlink_slugs in 46 + 47 + let all_entries = Arod_model.all_entries () in 48 + 49 + let project_papers = List.filter (fun e -> 50 + match e with 51 + | `Paper paper -> List.mem project_slug (Arod_model.Paper.project_slugs paper) 52 + | _ -> false 53 + ) all_entries |> List.sort (fun a b -> 54 + compare (Arod_model.Entry.date b) (Arod_model.Entry.date a) 55 + ) in 56 + 57 + let recent_activity = List.filter (fun e -> 58 + match e with 59 + | `Paper _ -> false 60 + | _ -> StringSet.mem (Arod_model.Entry.slug e) backlink_set 61 + ) all_entries |> List.sort (fun a b -> 62 + compare (Arod_model.Entry.date b) (Arod_model.Entry.date a) 63 + ) in 64 + 65 + let activity_section = 66 + if recent_activity = [] then El.splice [] 67 + else 68 + let activity_items = List.map (fun ent -> 69 + let icon_name = Arod_view.ent_to_icon ent in 70 + let date_str = Arod_view.ptime_date ~with_d:false (Arod_model.Entry.date ent) in 71 + 72 + let lookup_title slug = 73 + match Arod_model.Entry.lookup entries slug with 74 + | Some ent -> Some (Arod_model.Entry.title ent) 75 + | None -> None 76 + in 77 + 78 + let description = match ent with 79 + | `Paper paper -> Bushel.Description.paper_description paper ~date_str 80 + | `Note n -> Bushel.Description.note_description n ~date_str ~lookup_fn:lookup_title 81 + | `Idea i -> Bushel.Description.idea_description i ~date_str 82 + | `Video v -> Bushel.Description.video_description v ~date_str ~lookup_fn:lookup_title 83 + | `Project pr -> Bushel.Description.project_description pr 84 + in 85 + 86 + El.li [ 87 + El.img ~at:[ 88 + At.alt "icon"; 89 + At.class' "inline-icon"; 90 + At.src (sprintf "/assets/%s" icon_name) 91 + ] (); 92 + El.a ~at:[At.href (Arod_model.Entry.site_url ent)] [ 93 + El.txt (Arod_model.Entry.title ent) 94 + ]; 95 + El.txt " – "; 96 + El.span ~at:[At.class' "activity-description"] [El.txt description] 97 + ] 98 + ) recent_activity in 99 + El.splice [ 100 + El.h1 [El.txt "Activity"]; 101 + El.ul ~at:[At.class' "activity-list"] activity_items 102 + ] 103 + in 104 + 105 + let references_section = 106 + if project_papers = [] then El.splice [] 107 + else 108 + let paper_items = List.map (fun ent -> 109 + match ent with 110 + | `Paper paper -> Arod_papers.paper_for_entry paper |> fst 111 + | _ -> El.splice [] 112 + ) project_papers in 113 + El.splice [ 114 + El.h1 [El.txt "References"]; 115 + El.splice paper_items 116 + ] 117 + in 118 + 119 + let title = MP.title p in 120 + 121 + El.div ~at:[class_ "project"] [ 122 + El.h1 [El.txt title]; 123 + El.p [Arod_view.full_body (`Project p)]; 124 + activity_section; 125 + references_section 126 + ] 127 + 128 + let view_projects_timeline () = 129 + let entries = Arod_model.get_entries () in 130 + let all_projects = Arod_model.Entry.projects entries 131 + |> List.sort MP.compare 132 + |> List.rev in 133 + 134 + if all_projects = [] then 135 + El.div [El.txt "No projects found"] 136 + else 137 + let current_year = let (y, _, _), _ = Ptime.to_date_time (Ptime_clock.now ()) in y in 138 + 139 + let project_cards = List.map (fun p -> 140 + let start_year = p.MP.start in 141 + let end_year = match p.MP.finish with Some y -> y | None -> current_year in 142 + let duration = end_year - start_year in 143 + 144 + let all_entries = Arod_model.all_entries () in 145 + let project_slug = p.MP.slug in 146 + 147 + let recent_papers = List.filter (fun e -> 148 + match e with 149 + | `Paper paper -> List.mem project_slug (Arod_model.Paper.project_slugs paper) 150 + | _ -> false 151 + ) all_entries |> List.sort (fun a b -> 152 + compare (Arod_model.Entry.date b) (Arod_model.Entry.date a) 153 + ) |> (fun l -> if List.length l > 3 then List.filteri (fun i _ -> i < 3) l else l) in 154 + 155 + let backlink_slugs = Bushel.Link_graph.get_backlinks_for_slug project_slug in 156 + let backlink_set = List.fold_left (fun acc slug -> 157 + StringSet.add slug acc 158 + ) StringSet.empty backlink_slugs in 159 + 160 + let recent_notes = List.filter (fun e -> 161 + match e with 162 + | `Note _ -> StringSet.mem (Arod_model.Entry.slug e) backlink_set 163 + | _ -> false 164 + ) all_entries |> List.sort (fun a b -> 165 + compare (Arod_model.Entry.date b) (Arod_model.Entry.date a) 166 + ) |> (fun l -> if List.length l > 3 then List.filteri (fun i _ -> i < 3) l else l) in 167 + 168 + let recent_items_display = 169 + let paper_items = List.map (fun ent -> 170 + El.li [ 171 + El.a ~at:[At.href (Arod_model.Entry.site_url ent)] [ 172 + El.txt (Arod_model.Entry.title ent) 173 + ] 174 + ] 175 + ) recent_papers in 176 + let note_items = List.map (fun ent -> 177 + El.li [ 178 + El.a ~at:[At.href (Arod_model.Entry.site_url ent)] [ 179 + El.txt (Arod_model.Entry.title ent) 180 + ] 181 + ] 182 + ) recent_notes in 183 + 184 + if paper_items = [] && note_items = [] then El.splice [] 185 + else 186 + El.div ~at:[At.class' "project-recent-items"] [ 187 + (if paper_items <> [] then 188 + El.div ~at:[At.class' "project-recent-column"] [ 189 + El.h4 [El.txt "Recent papers"]; 190 + El.ul paper_items 191 + ] 192 + else El.splice []); 193 + (if note_items <> [] then 194 + El.div ~at:[At.class' "project-recent-column"] [ 195 + El.h4 [El.txt "Recent notes"]; 196 + El.ul note_items 197 + ] 198 + else El.splice []) 199 + ] 200 + in 201 + 202 + let thumbnail_md = sprintf "![%%lc](:project-%s \"%s\")" p.MP.slug p.MP.title in 203 + let thumbnail_html = El.unsafe_raw (Arod_view.md_to_html thumbnail_md) in 204 + 205 + let date_range = match p.MP.finish with 206 + | Some y -> sprintf "%d–%d" start_year y 207 + | None -> sprintf "%d–present" start_year 208 + in 209 + 210 + let duration_height = max 40 (duration * 8) in 211 + 212 + El.div ~at:[At.class' "timeline-project"] [ 213 + El.div ~at:[At.class' "timeline-marker-wrapper"] [ 214 + El.div ~at:[At.class' "timeline-dot"] []; 215 + El.div ~at:[ 216 + At.class' "timeline-duration"; 217 + At.v "style" (sprintf "height: %dpx" duration_height) 218 + ] []; 219 + El.span ~at:[At.class' "timeline-year"] [El.txt (string_of_int start_year)] 220 + ]; 221 + El.div ~at:[At.class' "project-card"] [ 222 + El.div ~at:[At.class' "project-header"] [ 223 + El.h3 [ 224 + El.a ~at:[At.href ("/projects/" ^ p.MP.slug)] [ 225 + El.txt p.MP.title 226 + ] 227 + ]; 228 + El.span ~at:[At.class' "project-dates"] [El.txt date_range] 229 + ]; 230 + thumbnail_html; 231 + El.div ~at:[At.class' "project-body"] [ 232 + Arod_view.truncated_body (`Project p) |> fst 233 + ]; 234 + recent_items_display 235 + ] 236 + ] 237 + ) all_projects in 238 + 239 + let title = "Projects" in 240 + let description = "Research projects timeline" in 241 + 242 + let intro = El.p [El.txt "Research projects and relevant publications, ideas and notes."] in 243 + 244 + let page_footer = Arod_footer.footer in 245 + 246 + let page_content = El.splice [ 247 + El.article [ 248 + El.h1 [El.txt title]; 249 + intro; 250 + El.div ~at:[At.class' "projects-timeline"] project_cards 251 + ]; 252 + El.aside [] 253 + ] in 254 + 255 + Arod_page.page ~title ~page_content ~page_footer ~description ()

+130

arod/lib/arod_richdata.ml

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** JSON-LD rich data for SEO *) 7 + 8 + let jsonld j = 9 + Printf.sprintf {|<script type="application/ld+json">%s</script>|} 10 + (Ezjsonm.to_string (`O j)) 11 + 12 + let jsonlds j = 13 + Printf.sprintf {|<script type="application/ld+json">%s</script>|} 14 + (Ezjsonm.to_string (`A j)) 15 + 16 + type els = (string * string) list 17 + 18 + let breadcrumbs_ld (els:els) = 19 + let elsj = 20 + List.mapi (fun i (name, item) -> 21 + let last = i = List.length els - 1 in 22 + `O ([ 23 + "@type", `String "ListItem"; 24 + "position", `String (string_of_int (i+1)); 25 + "name", `String name ] @ (if last then [] else ["item", `String item])) 26 + ) els in 27 + [ 28 + "@context", `String "https://schema.org"; 29 + "@type", `String "BreadcrumbList"; 30 + "itemListElement", `A elsj 31 + ] 32 + 33 + let breadcrumbs els = jsonld @@ breadcrumbs_ld els 34 + 35 + module MC = Sortal_schema.Contact 36 + module MN = Bushel.Note 37 + module MP = Bushel.Paper 38 + 39 + let json_of_contact (c:MC.t) = 40 + `O ([ 41 + "@type", `String "Person"; 42 + "name", `String (MC.name c); 43 + ] @ (match MC.best_url c with None -> [] | Some c -> ["url", `String c])) 44 + 45 + let date p = Ptime.to_rfc3339 p 46 + 47 + let note_ld ~author ?(images=[]) (c:MN.t) = 48 + let x = [ 49 + "@context", `String "https://schema.org"; 50 + "@type", `String "NewsArticle"; 51 + "headline", `String c.MN.title; 52 + "image", `A (List.map (fun i -> `String i) images); 53 + "datePublished", `String (date @@ MN.origdate c); 54 + "dateModified", `String (date @@ MN.datetime c); 55 + "abstract", `String (Option.value ~default:"" @@ MN.synopsis c); 56 + "author", `A [json_of_contact author] 57 + ] in 58 + match c.MN.via with 59 + | None -> x 60 + | Some (_,u) -> ("significantLink", `String u) :: x 61 + 62 + let paper_ld (p:MP.t) = 63 + let authors = MP.authors p |> List.filter_map Arod_model.lookup_by_name in 64 + [ 65 + "@context", `String "https://schema.org"; 66 + "@type", `String "ScholarlyArticle"; 67 + "pagination", `String (MP.pages p); 68 + "abstract", `String (MP.abstract p); 69 + "datePublished", `String (date @@ MP.datetime p); 70 + "publisher", `String (MP.publisher p); 71 + "url", `String (Option.value ~default:"" @@ MP.url p); 72 + "headline", `String (MP.title p); 73 + "author", `A (List.map json_of_contact authors) 74 + ] 75 + 76 + let generic_ld cfg e = 77 + let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with 78 + | Some c -> c 79 + | None -> failwith "Author not found" 80 + in 81 + [ 82 + "@context", `String "https://schema.org"; 83 + "@type", `String "WebPage"; 84 + "datePublished", `String (date @@ Bushel.Entry.datetime e); 85 + "author", `A [json_of_contact me]; 86 + "abstract", `String (Option.value ~default:"" @@ Bushel.Entry.synopsis e) 87 + ] 88 + 89 + let entry_ld cfg e = 90 + let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with 91 + | Some c -> c 92 + | None -> failwith "Author not found" 93 + in 94 + match e with 95 + | `Note n -> note_ld ~author:me n 96 + | `Paper p -> paper_ld p 97 + | _ -> generic_ld cfg e 98 + 99 + let breadcrumb_of_ent cfg ent = 100 + ("Home", cfg.Arod_config.site.base_url ^ "/") :: 101 + ( match ent with 102 + | `Paper _ -> "Papers", (cfg.site.base_url ^ "/papers") 103 + | `Video _ -> "Videos", (cfg.site.base_url ^ "/videos") 104 + | `Idea _ -> "Ideas", (cfg.site.base_url ^ "/ideas") 105 + | `Project _ -> "Projects", (cfg.site.base_url ^ "/projects") 106 + | `Note _ -> "Notes", (cfg.site.base_url ^ "/notes") 107 + ) :: 108 + [Bushel.Entry.title ent, ""] 109 + 110 + let json_of_entry cfg ent = 111 + jsonld @@ entry_ld cfg ent 112 + 113 + let json_of_feed cfg feed = 114 + match feed with 115 + | `Note (n, e) -> 116 + let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with 117 + | Some c -> c 118 + | None -> failwith "Author not found" 119 + in 120 + let note_with_ent_ld = [ 121 + "@context", `String "https://schema.org"; 122 + "@type", `String "NewsArticle"; 123 + "headline", `String (MN.title n); 124 + "image", `A []; 125 + "datePublished", `String (date @@ MN.datetime n); 126 + "author", `A [json_of_contact me]; 127 + "mainEntity", `O (entry_ld cfg e) 128 + ] in 129 + jsonld note_with_ent_ld 130 + | `Entry e -> jsonld @@ entry_ld cfg e

+26

arod/lib/arod_videos.ml

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Video rendering for Arod webserver *) 7 + 8 + open Htmlit 9 + open Printf 10 + 11 + module MV = Arod_model.Video 12 + 13 + let video_for_feed v = 14 + let md = sprintf "\n\n" v.MV.slug in 15 + (El.unsafe_raw (Arod_view.md_to_html md), None) 16 + 17 + let one_video v = 18 + let md = sprintf "\n\n%s" v.MV.slug v.MV.description in 19 + (El.splice [ 20 + Arod_view.entry_href (`Video v); 21 + El.unsafe_raw (Arod_view.md_to_html md) 22 + ], None) 23 + 24 + let one_video_full v = 25 + let (html, _word_count_info) = one_video v in 26 + html

+905

arod/lib/arod_view.ml

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Core view rendering for Arod webserver *) 7 + 8 + open Htmlit 9 + 10 + (** {1 Attribute Helpers} *) 11 + 12 + let class_ c = At.class' c 13 + 14 + (** {1 HTML Escaping} *) 15 + 16 + let html_escape_attr s = 17 + let buf = Buffer.create (String.length s) in 18 + String.iter (function 19 + | '&' -> Buffer.add_string buf "&amp;" 20 + | '"' -> Buffer.add_string buf "&quot;" 21 + | '<' -> Buffer.add_string buf "&lt;" 22 + | '>' -> Buffer.add_string buf "&gt;" 23 + | c -> Buffer.add_char buf c 24 + ) s; 25 + Buffer.contents buf 26 + 27 + (** {1 Icon Helpers} *) 28 + 29 + let ent_to_icon = function 30 + | `Paper _ -> "paper.svg" 31 + | `Note _ -> "note.svg" 32 + | `Project _ -> "project.svg" 33 + | `Idea _ -> "idea.svg" 34 + | `Video _ -> "video.svg" 35 + 36 + let set_to_icon = function 37 + | "papers" -> Some "paper.svg" 38 + | "notes" -> Some "note.svg" 39 + | "projects" -> Some "project.svg" 40 + | "ideas" -> Some "idea.svg" 41 + | "videos" -> Some "video.svg" 42 + | "talks" -> Some "video.svg" 43 + | _ -> None 44 + 45 + (** {1 Tag Rendering} *) 46 + 47 + let render_tag ?(relevant=false) ?(active=false) ?fnum ?num t = 48 + let active_cl = if active then " tag-active" else "" in 49 + let relevant_cl = if relevant then " tag-relevant" else "" in 50 + 51 + let icon, text = 52 + match t with 53 + | `Slug t -> 54 + let ent = Arod_model.lookup_exn t in 55 + let icon_name = match ent with 56 + | `Paper _ -> "paper.svg" 57 + | `Note _ -> "note.svg" 58 + | `Project _ -> "project.svg" 59 + | `Idea _ -> "idea.svg" 60 + | `Video _ -> "video.svg" 61 + in 62 + Some icon_name, Arod_model.Entry.slug ent 63 + | `Set slug -> 64 + let icon_name = match slug with 65 + | "papers" -> Some "paper.svg" 66 + | "notes" -> Some "note.svg" 67 + | "projects" -> Some "project.svg" 68 + | "ideas" -> Some "idea.svg" 69 + | "videos" | "talks" -> Some "video.svg" 70 + | _ -> None 71 + in 72 + icon_name, slug 73 + | _ -> None, Arod_model.Tags.to_string t 74 + in 75 + 76 + let t_str = Arod_model.Tags.to_string t in 77 + let icon_el = match icon with 78 + | None -> El.splice [] 79 + | Some icon_name -> 80 + El.img ~at:[ 81 + At.alt "icon"; 82 + At.class' "hide-mobile inline-icon"; 83 + At.src (Printf.sprintf "/assets/%s" icon_name) 84 + ] () 85 + in 86 + 87 + let count_els = match num, fnum with 88 + | None, None -> [] 89 + | None, Some fn -> 90 + [El.span ~at:[At.class' "tag-count-container"] [ 91 + El.span ~at:[At.class' "tag-count-bg"] [El.txt (string_of_int fn)] 92 + ]] 93 + | Some n, Some fn when fn <> n -> 94 + [El.span ~at:[At.class' "tag-count-container"] [ 95 + El.span ~at:[At.class' "tag-count"] [El.txt (string_of_int n)]; 96 + El.span ~at:[At.class' "tag-count-bg"] [El.txt (string_of_int fn)] 97 + ]] 98 + | Some n, _ -> 99 + [El.span ~at:[At.class' "tag-count-container"] [ 100 + El.span ~at:[At.class' "tag-count"] [El.txt (string_of_int n)] 101 + ]] 102 + in 103 + 104 + El.span ~at:[ 105 + At.v "data-tag" t_str; 106 + At.class' ("tag-label" ^ active_cl ^ relevant_cl) 107 + ] ([icon_el; El.txt text] @ count_els) 108 + 109 + let render_tags (ts:Arod_model.Tags.t list) = 110 + let ts = List.filter (function 111 + | `Text _ 112 + | `Set _ -> true 113 + | _ -> false 114 + ) ts in 115 + El.splice ~sep:(El.txt " ") (List.map render_tag ts) 116 + 117 + (** {1 Image Rendering} *) 118 + 119 + let img ?cl ?(alt="") ?(title="") img_ent = 120 + let origin_url = Printf.sprintf "/images/%s.webp" 121 + (Filename.chop_extension (Arod_model.Img.origin img_ent)) in 122 + 123 + let open Arod_model.Img in 124 + let srcsets = String.concat "," 125 + (List.map (fun (f,(w,_h)) -> Printf.sprintf "/images/%s %dw" f w) 126 + (MS.bindings img_ent.variants)) in 127 + 128 + let base_attrs = [ 129 + At.v "loading" "lazy"; 130 + At.src origin_url; 131 + At.v "srcset" srcsets; 132 + At.v "sizes" "(max-width: 768px) 100vw, 33vw" 133 + ] in 134 + 135 + let attrs = match cl with 136 + | Some c -> At.class' c :: base_attrs 137 + | None -> base_attrs 138 + in 139 + 140 + match alt with 141 + | "%r" -> 142 + El.figure ~at:[At.class' "image-right"] [ 143 + El.img ~at:(At.alt title :: At.title title :: attrs) (); 144 + El.figcaption [El.txt title] 145 + ] 146 + | "%c" -> 147 + El.figure ~at:[At.class' "image-center"] [ 148 + El.img ~at:(At.alt title :: At.title title :: attrs) (); 149 + El.figcaption [El.txt title] 150 + ] 151 + | "%lc" -> 152 + El.figure ~at:[At.class' "image-left-float"] [ 153 + El.img ~at:(At.alt title :: At.title title :: attrs) (); 154 + El.figcaption [El.txt title] 155 + ] 156 + | "%rc" -> 157 + El.figure ~at:[At.class' "image-right-float"] [ 158 + El.img ~at:(At.alt title :: At.title title :: attrs) (); 159 + El.figcaption [El.txt title] 160 + ] 161 + | _ -> 162 + El.img ~at:(At.alt alt :: At.title title :: attrs) () 163 + 164 + (** {1 Date Formatting} *) 165 + 166 + let int_to_date_suffix ~r n = 167 + let suffix = 168 + if n mod 10 = 1 && n mod 100 <> 11 then "st" 169 + else if n mod 10 = 2 && n mod 100 <> 12 then "nd" 170 + else if n mod 10 = 3 && n mod 100 <> 13 then "rd" 171 + else "th" 172 + in 173 + let x = string_of_int n in 174 + let x = if r && String.length x = 1 then " " ^ x else x in 175 + x ^ suffix 176 + 177 + let month_name = function 178 + | 1 -> "Jan" | 2 -> "Feb" | 3 -> "Mar" | 4 -> "Apr" 179 + | 5 -> "May" | 6 -> "Jun" | 7 -> "Jul" | 8 -> "Aug" 180 + | 9 -> "Sep" | 10 -> "Oct" | 11 -> "Nov" | 12 -> "Dec" 181 + | _ -> "" 182 + 183 + let ptime_date ?(r=false) ?(with_d=false) (y,m,d) = 184 + let ms = month_name m in 185 + match with_d with 186 + | false -> Printf.sprintf "%s %4d" ms y 187 + | true -> Printf.sprintf "%s %s %4d" (int_to_date_suffix ~r d) ms y 188 + 189 + (** {1 String Helpers} *) 190 + 191 + let string_drop_prefix ~prefix str = 192 + let prefix_len = String.length prefix in 193 + let str_len = String.length str in 194 + if str_len >= prefix_len && String.sub str 0 prefix_len = prefix then 195 + String.sub str prefix_len (str_len - prefix_len) 196 + else 197 + str 198 + 199 + let map_and fn l = 200 + let ll = List.length l in 201 + List.mapi (fun i v -> 202 + match i with 203 + | 0 -> fn v 204 + | _ when i + 1 = ll -> " and " ^ (fn v) 205 + | _ -> ", " ^ (fn v) 206 + ) l |> String.concat "" 207 + 208 + (** {1 Link Renderers for Cmarkit} *) 209 + 210 + let bushel_link c l = 211 + let defs = Cmarkit_renderer.Context.get_defs c in 212 + match Cmarkit.Inline.Link.reference_definition defs l with 213 + | Some Cmarkit.Link_definition.Def (ld, _) -> begin 214 + match Cmarkit.Link_definition.dest ld with 215 + | Some ("#", _) -> 216 + let text = 217 + Cmarkit.Inline.Link.text l |> 218 + Cmarkit.Inline.to_plain_text ~break_on_soft:false |> fun r -> 219 + String.concat "\n" (List.map (String.concat "") r) in 220 + Cmarkit_renderer.Context.string c 221 + (Printf.sprintf {|<a href="#" class="tag-search-link" data-search-tag="%s">#%s</a>|} 222 + (html_escape_attr text) (html_escape_attr text)); 223 + true 224 + | Some (dest, _) when String.starts_with ~prefix:"###" dest -> 225 + let type_filter = String.sub dest 3 (String.length dest - 3) in 226 + let text = 227 + Cmarkit.Inline.Link.text l |> 228 + Cmarkit.Inline.to_plain_text ~break_on_soft:false |> fun r -> 229 + String.concat "\n" (List.map (String.concat "") r) in 230 + Cmarkit_renderer.Context.string c 231 + (Printf.sprintf {|<a href="#" class="type-filter-link" data-filter-type="%s">%s</a>|} 232 + (html_escape_attr type_filter) (html_escape_attr text)); 233 + true 234 + | Some (dest, _) when String.starts_with ~prefix:"##" dest -> 235 + let tag = String.sub dest 2 (String.length dest - 2) in 236 + let text = 237 + Cmarkit.Inline.Link.text l |> 238 + Cmarkit.Inline.to_plain_text ~break_on_soft:false |> fun r -> 239 + String.concat "\n" (List.map (String.concat "") r) in 240 + Cmarkit_renderer.Context.string c 241 + (Printf.sprintf {|<a href="#" class="tag-search-link" data-search-tag="%s">#%s</a>|} 242 + (html_escape_attr tag) (html_escape_attr text)); 243 + true 244 + | _ -> false 245 + end 246 + | _ -> false 247 + 248 + let media_link c l = 249 + let is_bushel_image = String.starts_with ~prefix:"/images/" in 250 + let is_bushel_video = String.starts_with ~prefix:"/videos/" in 251 + let defs = Cmarkit_renderer.Context.get_defs c in 252 + match Cmarkit.Inline.Link.reference_definition defs l with 253 + | Some Cmarkit.Link_definition.Def (ld, _) -> begin 254 + match Cmarkit.Link_definition.dest ld with 255 + | Some (src, _) when is_bushel_image src -> 256 + let title = match Cmarkit.Link_definition.title ld with 257 + | None -> "" 258 + | Some title -> String.concat "\n" (List.map (fun (_, (t, _)) -> t) title) in 259 + let alt = 260 + Cmarkit.Inline.Link.text l |> 261 + Cmarkit.Inline.to_plain_text ~break_on_soft:false |> fun r -> 262 + String.concat "\n" (List.map (String.concat "") r) in 263 + (* Strip /images/ prefix and .webp extension to get the slug *) 264 + let img_path = string_drop_prefix ~prefix:"/images/" src in 265 + let img_slug = Filename.chop_extension img_path in 266 + let img_ent = Arod_model.lookup_image img_slug in 267 + (match img_ent with 268 + | Some img_ent -> 269 + let html = El.to_string ~doctype:false (img ~title ~alt ~cl:"content-image" img_ent) in 270 + Cmarkit_renderer.Context.string c html; 271 + true 272 + | None -> 273 + (* Image not in index - still handle positioning directives *) 274 + let html = match alt with 275 + | "%c" -> 276 + Printf.sprintf 277 + {|<figure class="image-center"><img class="content-image" src="%s" alt="%s" title="%s" loading="lazy" sizes="(max-width: 768px) 100vw, 33vw"><figcaption>%s</figcaption></figure>|} 278 + src title title title 279 + | "%r" -> 280 + Printf.sprintf 281 + {|<figure class="image-right"><img class="content-image" src="%s" alt="%s" title="%s" loading="lazy" sizes="(max-width: 768px) 100vw, 33vw"><figcaption>%s</figcaption></figure>|} 282 + src title title title 283 + | "%lc" -> 284 + Printf.sprintf 285 + {|<figure class="image-left-float"><img class="content-image" src="%s" alt="%s" title="%s" loading="lazy" sizes="(max-width: 768px) 100vw, 33vw"><figcaption>%s</figcaption></figure>|} 286 + src title title title 287 + | "%rc" -> 288 + Printf.sprintf 289 + {|<figure class="image-right-float"><img class="content-image" src="%s" alt="%s" title="%s" loading="lazy" sizes="(max-width: 768px) 100vw, 33vw"><figcaption>%s</figcaption></figure>|} 290 + src title title title 291 + | _ -> 292 + Printf.sprintf 293 + {|<img class="content-image" src="%s" alt="%s" title="%s" loading="lazy" sizes="(max-width: 768px) 100vw, 33vw">|} 294 + src alt title 295 + in 296 + Cmarkit_renderer.Context.string c html; 297 + true) 298 + | Some (src, _) when is_bushel_video src -> 299 + let title = match Cmarkit.Link_definition.title ld with 300 + | None -> "" 301 + | Some title -> String.concat "\n" (List.map (fun (_, (t, _)) -> t) title) in 302 + let url = 303 + match Arod_model.lookup (string_drop_prefix ~prefix:"/videos/" src) with 304 + | Some (`Video v) -> 305 + let rewrite_watch_to_embed url = 306 + let url = Uri.of_string url in 307 + let path = Uri.path url |> String.split_on_char '/' in 308 + let path = List.map (function "watch" -> "embed" |v -> v) path in 309 + Uri.with_path url (String.concat "/" path) |> Uri.to_string in 310 + rewrite_watch_to_embed (Arod_model.Video.url v) 311 + | Some _ -> failwith "slug not a video" 312 + | None -> failwith "video not found" 313 + in 314 + let html = El.to_string ~doctype:false (El.div ~at:[At.class' "video-center"] [ 315 + El.iframe ~at:[ 316 + At.title title; 317 + At.v "width" "100%"; 318 + At.v "height" "315px"; 319 + At.src url; 320 + At.v "frameborder" "0"; 321 + At.v "allowfullscreen" ""; 322 + At.v "sandbox" "allow-same-origin allow-scripts allow-popups allow-forms" 323 + ] [] 324 + ]) in 325 + Cmarkit_renderer.Context.string c html; 326 + true 327 + | None | Some _ -> false 328 + end 329 + | None | Some _ -> false 330 + 331 + (** {1 Sidenote Rendering} *) 332 + 333 + let rec render_sidenote c = function 334 + | Bushel.Md.Contact_note (contact, trigger_text) -> 335 + let open Sortal_schema.Contact in 336 + let handle = handle contact in 337 + let name = name contact in 338 + let link_url = best_url contact |> Option.value ~default:"" in 339 + let thumbnail_url = Arod_model.Entry.contact_thumbnail (Arod_model.get_entries ()) contact in 340 + 341 + let data_attrs = [ 342 + Printf.sprintf {|data-slug="%s"|} handle; 343 + Printf.sprintf {|data-handle="%s"|} handle; 344 + Printf.sprintf {|data-name="%s"|} (html_escape_attr name); 345 + Printf.sprintf {|data-link="%s"|} link_url; 346 + ] in 347 + 348 + let data_attrs = match thumbnail_url with 349 + | Some url -> data_attrs @ [Printf.sprintf {|data-image="%s"|} url] 350 + | None -> data_attrs 351 + in 352 + 353 + let data_attrs = match emails contact with 354 + | e :: _ -> data_attrs @ [Printf.sprintf {|data-email="%s"|} (html_escape_attr e.address)] 355 + | [] -> data_attrs 356 + in 357 + 358 + let data_attrs = match github_handle contact with 359 + | Some g -> data_attrs @ [Printf.sprintf {|data-github="%s"|} (html_escape_attr g)] 360 + | None -> data_attrs 361 + in 362 + 363 + let data_attrs = match orcid contact with 364 + | Some o -> data_attrs @ [Printf.sprintf {|data-orcid="%s"|} (html_escape_attr o)] 365 + | None -> data_attrs 366 + in 367 + 368 + Cmarkit_renderer.Context.string c (Printf.sprintf 369 + {|<side-note type="contact" %s>%s</side-note>|} 370 + (String.concat " " data_attrs) trigger_text); 371 + true 372 + 373 + | Bushel.Md.Paper_note (paper, trigger_text) -> 374 + let paper_slug = paper.Bushel.Paper.slug in 375 + let title = Bushel.Paper.title paper in 376 + let authors = Bushel.Paper.authors paper in 377 + let year = Bushel.Paper.year paper in 378 + let doi = Bushel.Paper.doi paper in 379 + 380 + let link_url = Printf.sprintf "/papers/%s" paper_slug in 381 + 382 + let author_str = match authors with 383 + | [] -> "" 384 + | [a] -> 385 + let parts = String.split_on_char ' ' a in 386 + List.nth parts (List.length parts - 1) 387 + | a :: _ -> 388 + let parts = String.split_on_char ' ' a in 389 + let last_name = List.nth parts (List.length parts - 1) in 390 + last_name ^ " et al" 391 + in 392 + 393 + let data_attrs = [ 394 + Printf.sprintf {|data-slug="%s"|} paper_slug; 395 + Printf.sprintf {|data-title="%s"|} (html_escape_attr title); 396 + Printf.sprintf {|data-authors="%s"|} (html_escape_attr author_str); 397 + Printf.sprintf {|data-year="%d"|} year; 398 + Printf.sprintf {|data-link="%s"|} link_url; 399 + ] in 400 + 401 + let data_attrs = match doi with 402 + | Some d -> data_attrs @ [Printf.sprintf {|data-doi="%s"|} (html_escape_attr d)] 403 + | None -> data_attrs 404 + in 405 + 406 + Cmarkit_renderer.Context.string c (Printf.sprintf 407 + {|<side-note type="paper" %s>%s</side-note>|} 408 + (String.concat " " data_attrs) trigger_text); 409 + true 410 + 411 + | Bushel.Md.Idea_note (idea, trigger_text) -> 412 + let idea_slug = idea.Bushel.Idea.slug in 413 + let title = Bushel.Idea.title idea in 414 + let year = Bushel.Idea.year idea in 415 + let status = Bushel.Idea.status idea |> Bushel.Idea.status_to_string in 416 + let level = Bushel.Idea.level idea |> Bushel.Idea.level_to_string in 417 + 418 + let link_url = Printf.sprintf "/ideas/%s" idea_slug in 419 + 420 + let data_attrs = [ 421 + Printf.sprintf {|data-slug="%s"|} idea_slug; 422 + Printf.sprintf {|data-title="%s"|} (html_escape_attr title); 423 + Printf.sprintf {|data-year="%d"|} year; 424 + Printf.sprintf {|data-status="%s"|} (html_escape_attr status); 425 + Printf.sprintf {|data-level="%s"|} (html_escape_attr level); 426 + Printf.sprintf {|data-link="%s"|} link_url; 427 + ] in 428 + 429 + Cmarkit_renderer.Context.string c (Printf.sprintf 430 + {|<side-note type="idea" %s>%s</side-note>|} 431 + (String.concat " " data_attrs) trigger_text); 432 + true 433 + 434 + | Bushel.Md.Note_note (note, trigger_text) -> 435 + let note_slug = note.Bushel.Note.slug in 436 + let title = Bushel.Note.title note in 437 + let year, month, day = Bushel.Note.date note in 438 + let word_count = Bushel.Note.words note in 439 + 440 + let link_url = Printf.sprintf "/notes/%s" note_slug in 441 + let thumbnail_url = Arod_model.Entry.thumbnail (Arod_model.get_entries ()) (`Note note) in 442 + 443 + let data_attrs = [ 444 + Printf.sprintf {|data-slug="%s"|} note_slug; 445 + Printf.sprintf {|data-title="%s"|} (html_escape_attr title); 446 + Printf.sprintf {|data-year="%d"|} year; 447 + Printf.sprintf {|data-month="%d"|} month; 448 + Printf.sprintf {|data-day="%d"|} day; 449 + Printf.sprintf {|data-words="%d"|} word_count; 450 + Printf.sprintf {|data-link="%s"|} link_url; 451 + ] in 452 + 453 + let data_attrs = match thumbnail_url with 454 + | Some url -> data_attrs @ [Printf.sprintf {|data-image="%s"|} url] 455 + | None -> data_attrs 456 + in 457 + 458 + Cmarkit_renderer.Context.string c (Printf.sprintf 459 + {|<side-note type="note" %s>%s</side-note>|} 460 + (String.concat " " data_attrs) trigger_text); 461 + true 462 + 463 + | Bushel.Md.Project_note (project, trigger_text) -> 464 + let project_slug = project.Bushel.Project.slug in 465 + let title = Bushel.Project.title project in 466 + let start = project.Bushel.Project.start in 467 + let finish = project.Bushel.Project.finish in 468 + let ideas = Bushel.Project.ideas project in 469 + 470 + let link_url = Printf.sprintf "/projects/%s" project_slug in 471 + 472 + let data_attrs = [ 473 + Printf.sprintf {|data-slug="%s"|} project_slug; 474 + Printf.sprintf {|data-title="%s"|} (html_escape_attr title); 475 + Printf.sprintf {|data-start="%d"|} start; 476 + Printf.sprintf {|data-ideas="%s"|} (html_escape_attr ideas); 477 + Printf.sprintf {|data-link="%s"|} link_url; 478 + ] in 479 + 480 + let data_attrs = match finish with 481 + | Some f -> data_attrs @ [Printf.sprintf {|data-finish="%d"|} f] 482 + | None -> data_attrs 483 + in 484 + 485 + Cmarkit_renderer.Context.string c (Printf.sprintf 486 + {|<side-note type="project" %s>%s</side-note>|} 487 + (String.concat " " data_attrs) trigger_text); 488 + true 489 + 490 + | Bushel.Md.Video_note (video, trigger_text) -> 491 + let video_slug = video.Bushel.Video.slug in 492 + let title = Bushel.Video.title video in 493 + let is_talk = Bushel.Video.talk video in 494 + let year, month, day = Bushel.Video.date video in 495 + 496 + let link_url = Printf.sprintf "/videos/%s" video_slug in 497 + 498 + let data_attrs = [ 499 + Printf.sprintf {|data-slug="%s"|} video_slug; 500 + Printf.sprintf {|data-title="%s"|} (html_escape_attr title); 501 + Printf.sprintf {|data-year="%d"|} year; 502 + Printf.sprintf {|data-month="%d"|} month; 503 + Printf.sprintf {|data-day="%d"|} day; 504 + Printf.sprintf {|data-talk="%b"|} is_talk; 505 + Printf.sprintf {|data-link="%s"|} link_url; 506 + ] in 507 + 508 + Cmarkit_renderer.Context.string c (Printf.sprintf 509 + {|<side-note type="video" %s>%s</side-note>|} 510 + (String.concat " " data_attrs) trigger_text); 511 + true 512 + 513 + | Bushel.Md.Footnote_note (slug, block, trigger_text) -> 514 + let temp_doc = Cmarkit.Doc.make block in 515 + let footnote_inline c = function 516 + | Cmarkit.Inline.Image (l, _) -> media_link c l 517 + | Cmarkit.Inline.Link (l, _) -> bushel_link c l 518 + | _ -> false 519 + in 520 + let footnote_renderer = Cmarkit_html.renderer ~safe:false () in 521 + let footnote_renderer = Cmarkit_renderer.compose footnote_renderer (Cmarkit_renderer.make ~inline:footnote_inline ()) in 522 + let content_html = Cmarkit_renderer.doc_to_string footnote_renderer temp_doc in 523 + 524 + let data_attrs = [ 525 + Printf.sprintf {|data-slug="%s"|} slug; 526 + Printf.sprintf {|data-label="%s"|} (html_escape_attr trigger_text); 527 + ] in 528 + 529 + Cmarkit_renderer.Context.string c (Printf.sprintf 530 + {|<side-note type="footnote" %s><template class="footnote-content">%s</template></side-note>|} 531 + (String.concat " " data_attrs) content_html); 532 + true 533 + 534 + and custom_inline_renderer c = function 535 + | Cmarkit.Inline.Image (l, _) -> media_link c l 536 + | Cmarkit.Inline.Link (l, _) -> bushel_link c l 537 + | Bushel.Md.Side_note data -> render_sidenote c data 538 + | _ -> false 539 + 540 + (** Custom HTML renderer that handles sidenotes and bushel extensions *) 541 + let custom_html_renderer () = 542 + let default = Cmarkit_html.renderer ~safe:false () in 543 + Cmarkit_renderer.compose default (Cmarkit_renderer.make ~inline:custom_inline_renderer ()) 544 + 545 + (** {1 Markdown to HTML} *) 546 + 547 + let md_to_html content = 548 + let open Cmarkit in 549 + let doc = Doc.of_string ~strict:false ~resolver:Bushel.Md.with_bushel_links content in 550 + let entries = Arod_model.get_entries () in 551 + (* Use sidenote mapper to create Side_note inlines *) 552 + let mapper = Mapper.make ~inline:(Bushel.Md.make_sidenote_mapper entries) () in 553 + let mapped_doc = Mapper.map_doc mapper doc in 554 + let renderer = custom_html_renderer () in 555 + Cmarkit_renderer.doc_to_string renderer mapped_doc 556 + 557 + let md_to_atom_html content = 558 + let open Cmarkit in 559 + let doc = Doc.of_string ~strict:false ~heading_auto_ids:true ~resolver:Bushel.Md.with_bushel_links content in 560 + let defs = Doc.defs doc in 561 + let footnote_map = Hashtbl.create 7 in 562 + let entries = Arod_model.get_entries () in 563 + 564 + let atom_bushel_mapper _m inline = 565 + match inline with 566 + | Inline.Image (lb, meta) -> 567 + (match Inline.Link.reference lb with 568 + | `Inline (ld, _) -> 569 + (match Link_definition.dest ld with 570 + | Some (url, _) when Bushel.Md.is_bushel_slug url -> 571 + let slug = Bushel.Md.strip_handle url in 572 + (match Arod_model.Entry.lookup entries slug with 573 + | Some (`Video _) -> 574 + let dest = Printf.sprintf "/videos/%s" slug in 575 + let title = Link_definition.title ld in 576 + let alt_text = Inline.Link.text lb |> Inline.to_plain_text ~break_on_soft:false 577 + |> fun r -> String.concat "\n" (List.map (String.concat "") r) in 578 + let txt = Inline.Text (alt_text, meta) in 579 + let new_ld = Link_definition.make ?title ~dest:(dest, meta) () in 580 + let ll = `Inline (new_ld, meta) in 581 + let new_lb = Inline.Link.make txt ll in 582 + Mapper.ret (Inline.Image (new_lb, meta)) 583 + | Some ent -> 584 + let dest = Arod_model.Entry.site_url ent in 585 + let title = Link_definition.title ld in 586 + let alt_text = Inline.Link.text lb |> Inline.to_plain_text ~break_on_soft:false 587 + |> fun r -> String.concat "\n" (List.map (String.concat "") r) in 588 + let txt = Inline.Text (alt_text, meta) in 589 + let new_ld = Link_definition.make ?title ~dest:(dest, meta) () in 590 + let ll = `Inline (new_ld, meta) in 591 + let new_lb = Inline.Link.make txt ll in 592 + Mapper.ret (Inline.Image (new_lb, meta)) 593 + | None -> 594 + (match Arod_model.Entry.lookup_image entries slug with 595 + | Some img -> 596 + let dest = Printf.sprintf "/images/%s.webp" (Filename.chop_extension (Arod_model.Img.origin img)) in 597 + let title = Link_definition.title ld in 598 + let alt_text = Inline.Link.text lb |> Inline.to_plain_text ~break_on_soft:false 599 + |> fun r -> String.concat "\n" (List.map (String.concat "") r) in 600 + let txt = Inline.Text (alt_text, meta) in 601 + let new_ld = Link_definition.make ?title ~dest:(dest, meta) () in 602 + let ll = `Inline (new_ld, meta) in 603 + let new_lb = Inline.Link.make txt ll in 604 + Mapper.ret (Inline.Image (new_lb, meta)) 605 + | None -> 606 + failwith (Printf.sprintf "%s slug not found in atom markdown" slug))) 607 + | _ -> Mapper.default) 608 + | _ -> Mapper.default) 609 + | _ -> 610 + Bushel.Md.make_bushel_link_only_mapper defs entries _m inline 611 + in 612 + let doc = 613 + Mapper.map_doc 614 + (Mapper.make ~inline:atom_bushel_mapper ()) 615 + doc 616 + in 617 + 618 + let footnotes = ref [] in 619 + let atom_inline c = function 620 + | Inline.Image (lb, _meta) -> 621 + (match Inline.Link.reference lb with 622 + | `Inline (ld, _) -> 623 + (match Link_definition.dest ld with 624 + | Some (dest, _) when String.starts_with ~prefix:"/videos/" dest -> 625 + let slug = string_drop_prefix ~prefix:"/videos/" dest in 626 + (match Arod_model.lookup slug with 627 + | Some (`Video v) -> 628 + let video_url = 629 + let url_str = Arod_model.Video.url v in 630 + let url = Uri.of_string url_str in 631 + let path = Uri.path url |> String.split_on_char '/' in 632 + let path = List.map (function "watch" -> "embed" | v -> v) path in 633 + Uri.with_path url (String.concat "/" path) |> Uri.to_string in 634 + let title = Arod_model.Video.title v in 635 + let iframe_html = Printf.sprintf 636 + {|<div class="video-center"><iframe title="%s" src="%s" frameborder="0" allowfullscreen="" sandbox="allow-same-origin allow-scripts allow-popups allow-forms" style="aspect-ratio: 16/9; width: 100%%;"></iframe></div>|} 637 + title video_url in 638 + Cmarkit_renderer.Context.string c iframe_html; 639 + true 640 + | _ -> false) 641 + | _ -> false) 642 + | _ -> false) 643 + | Inline.Link (lb, _meta) -> 644 + (match Inline.Link.referenced_label lb with 645 + | Some l when String.starts_with ~prefix:"^" (Label.key l) -> 646 + (match Inline.Link.reference_definition defs lb with 647 + | Some (Block.Footnote.Def (fn, _)) -> 648 + let label_key = Label.key l in 649 + let num, text = 650 + match Hashtbl.find_opt footnote_map label_key with 651 + | Some (n, t) -> (n, t) 652 + | None -> 653 + let n = Hashtbl.length footnote_map + 1 in 654 + let t = Printf.sprintf "[%d]" n in 655 + Hashtbl.add footnote_map label_key (n, t); 656 + footnotes := (n, label_key, Block.Footnote.block fn) :: !footnotes; 657 + (n, t) 658 + in 659 + let sup_id = Printf.sprintf "fnref:%d" num in 660 + let href_attr = Printf.sprintf "#fn:%d" num in 661 + Cmarkit_renderer.Context.string c (Printf.sprintf "<sup id=\"%s\"><a href=\"%s\" class=\"footnote\">%s</a></sup>" sup_id href_attr text); 662 + true 663 + | _ -> false) 664 + | _ -> false) 665 + | _ -> false 666 + in 667 + let atom_renderer = Cmarkit_renderer.make ~inline:atom_inline () in 668 + let default = Cmarkit_html.renderer ~safe:false () in 669 + let renderer = Cmarkit_renderer.compose default atom_renderer in 670 + let main_html = Cmarkit_renderer.doc_to_string renderer doc in 671 + 672 + if !footnotes = [] then main_html 673 + else 674 + let sorted_footnotes = List.sort (fun (a,_,_) (b,_,_) -> compare a b) !footnotes in 675 + let footnote_content_renderer = Cmarkit_html.renderer ~safe:false () in 676 + let footnote_items = 677 + String.concat "\n" (List.map (fun (num, _label, block) -> 678 + let fn_id = Printf.sprintf "fn:%d" num in 679 + let fnref_id = Printf.sprintf "fnref:%d" num in 680 + let temp_doc = Cmarkit.Doc.make block in 681 + let processed_doc = Mapper.map_doc (Mapper.make ~inline:atom_bushel_mapper ()) temp_doc in 682 + let block_html = Cmarkit_renderer.doc_to_string footnote_content_renderer processed_doc in 683 + Printf.sprintf "<li id=\"%s\"><p>%s <a href=\"#%s\" class=\"reversefootnote\">&#8617;</a></p></li>" fn_id block_html fnref_id 684 + ) sorted_footnotes) 685 + in 686 + let footnotes_html = Printf.sprintf "<div class=\"footnotes\"><ol>%s</ol></div>" footnote_items in 687 + main_html ^ "\n" ^ footnotes_html 688 + 689 + (** {1 Body Rendering} *) 690 + 691 + let truncated_body ent = 692 + let body = Arod_model.Entry.body ent in 693 + let first, last = Arod_model.Util.first_and_last_hunks body in 694 + let remaining_words = Arod_model.Util.count_words last in 695 + let total_words = Arod_model.Util.count_words first + remaining_words in 696 + let is_note = match ent with `Note _ -> true | _ -> false in 697 + let is_truncated = remaining_words > 1 in 698 + let word_count_info = 699 + if is_truncated || (is_note && total_words > 0) then 700 + Some (total_words, is_truncated) 701 + else 702 + None 703 + in 704 + let markdown_with_link = 705 + let footnote_lines = Arod_model.Util.find_footnote_lines last in 706 + let footnotes_text = 707 + if footnote_lines = [] then "" 708 + else "\n\n" ^ String.concat "\n" footnote_lines 709 + in 710 + match word_count_info with 711 + | Some (total, true) -> 712 + let url = Arod_model.Entry.site_url ent in 713 + first ^ "\n\n*[Read full note... (" ^ string_of_int total ^ " words](" ^ url ^ "))*\n" ^ footnotes_text 714 + | _ -> first ^ footnotes_text 715 + in 716 + (El.unsafe_raw (md_to_html markdown_with_link), word_count_info) 717 + 718 + let full_body ent = 719 + El.unsafe_raw (md_to_html (Arod_model.Entry.body ent)) 720 + 721 + (** {1 Entry Heading} *) 722 + 723 + let entry_href ?title ?(tag="h2") ent = 724 + let via, via_url = 725 + match ent with 726 + | `Note n -> 727 + ( match n.Arod_model.Note.via with 728 + | None -> None, None 729 + | Some (t,u) -> Some t, Some u ) 730 + | _ -> None, None 731 + in 732 + 733 + let via_el = 734 + match via, via_url with 735 + | Some t, Some u when t <> "" -> 736 + El.a ~at:[At.class' "via"; At.href u] [El.txt (Printf.sprintf "(via %s)" t)] 737 + | _, Some u -> 738 + El.a ~at:[At.class' "via"; At.href u] [El.txt "(via)"] 739 + | _ -> El.splice [] 740 + in 741 + 742 + let title_text = match title with 743 + | None -> Arod_model.Entry.title ent 744 + | Some t -> t 745 + in 746 + 747 + match ent with 748 + | `Note {index_page=true;_} -> El.splice [] 749 + | _ -> 750 + let h_fn = match tag with 751 + | "h1" -> El.h1 752 + | "h2" -> El.h2 753 + | "h3" -> El.h3 754 + | "h4" -> El.h4 755 + | "h5" -> El.h5 756 + | "h6" -> El.h6 757 + | _ -> El.h2 758 + in 759 + 760 + let doi_el = match ent with 761 + | `Note n when Arod_model.Note.perma n -> 762 + (match Arod_model.Note.doi n with 763 + | Some doi_str -> 764 + El.span ~at:[At.class' "title-doi"] [ 765 + El.txt " / "; 766 + El.a ~at:[At.href ("https://doi.org/" ^ doi_str)] [El.txt "DOI"]; 767 + ] 768 + | None -> El.splice []) 769 + | _ -> El.splice [] 770 + in 771 + 772 + h_fn [ 773 + El.a ~at:[At.href (Arod_model.Entry.site_url ent)] [El.txt title_text]; 774 + El.txt " "; 775 + via_el; 776 + El.span ~at:[At.class' "title-date"] [ 777 + El.txt " / "; 778 + El.txt (ptime_date ~with_d:false (Arod_model.Entry.date ent)) 779 + ]; 780 + doi_el 781 + ] 782 + 783 + (** {1 Tags Metadata} *) 784 + 785 + let tags_meta ?extra ?link ?(tags=[]) ?date ?backlinks_content ent = 786 + let tags = List.map Arod_model.Tags.of_string tags in 787 + let hash_span = El.span ~at:[At.class' "hash-prefix"] [El.txt "#"] in 788 + let link_el = match link with 789 + | None -> El.a ~at:[At.href (Arod_model.Entry.site_url ent)] [hash_span] 790 + | Some l -> El.a ~at:[At.href l] [hash_span] 791 + in 792 + 793 + let date_str = ptime_date ~with_d:true 794 + (match date with None -> Arod_model.Entry.date ent | Some d -> d) in 795 + 796 + let bullet = El.span ~at:[At.class' "meta-bullet"] [El.txt "•"] in 797 + 798 + let sections = [] in 799 + let sections = sections @ [[link_el; El.txt " "; El.txt date_str]] in 800 + 801 + let sections = match ent with 802 + | `Note n when Arod_model.Note.perma n -> 803 + (match Arod_model.Note.doi n with 804 + | Some doi_str -> 805 + let doi_section = [ 806 + El.txt "DOI: "; 807 + El.a ~at:[At.href ("https://doi.org/" ^ doi_str)] [El.txt doi_str] 808 + ] in 809 + sections @ [doi_section] 810 + | None -> sections) 811 + | _ -> sections 812 + in 813 + 814 + let sections = match extra with 815 + | Some v -> sections @ [[El.txt v]] 816 + | None -> sections 817 + in 818 + 819 + let sections = match backlinks_content with 820 + | Some content -> 821 + let entry_slug = Arod_model.Entry.slug ent in 822 + let checkbox_id = "sidenote__checkbox--backlinks-" ^ entry_slug in 823 + let content_id = "sidenote-backlinks-" ^ entry_slug in 824 + let backlinks_section = [ 825 + El.span ~at:[At.class' "sidenote"; At.v "role" "note"] [ 826 + El.input ~at:[ 827 + At.type' "checkbox"; 828 + At.id checkbox_id; 829 + At.class' "sidenote__checkbox"; 830 + At.v "aria-label" "Show backlinks"; 831 + At.v "aria-hidden" "true"; 832 + At.v "hidden" "" 833 + ] (); 834 + El.label ~at:[ 835 + At.v "for" checkbox_id; 836 + At.class' "sidenote__button"; 837 + At.v "data-sidenote-number" "↑"; 838 + At.v "aria-describedby" content_id; 839 + At.v "tabindex" "0" 840 + ] [El.txt "backlinks"]; 841 + El.span ~at:[ 842 + At.id content_id; 843 + At.class' "sidenote__content"; 844 + At.v "aria-hidden" "true"; 845 + At.v "hidden" ""; 846 + At.v "data-sidenote-number" "↑" 847 + ] [content] 848 + ] 849 + ] in 850 + sections @ [backlinks_section] 851 + | None -> sections 852 + in 853 + 854 + let all_tags = Arod_model.concat_tags tags (Arod_model.tags_of_ent ent) in 855 + let sections = match all_tags with 856 + | [] -> sections 857 + | tags -> 858 + let tag_elements = List.map (fun tag -> 859 + let tag_str = Arod_model.Tags.to_raw_string tag in 860 + El.span ~at:[At.v "data-tag" tag_str; At.class' "tag-label"] [ 861 + El.txt tag_str 862 + ] 863 + ) tags in 864 + let tags_section = List.fold_left (fun acc el -> 865 + if acc = [] then [el] 866 + else acc @ [El.txt ", "; el] 867 + ) [] tag_elements in 868 + sections @ [tags_section] 869 + in 870 + 871 + let meta_parts = List.fold_left (fun acc section -> 872 + if acc = [] then section 873 + else acc @ [bullet] @ section 874 + ) [] sections in 875 + 876 + El.div ~at:[At.class' "note-meta"] meta_parts 877 + 878 + (** {1 References Section} *) 879 + 880 + let note_references_html note = 881 + let is_perma = Arod_model.Note.perma note in 882 + let has_doi = match Arod_model.Note.doi note with Some _ -> true | None -> false in 883 + if not (is_perma || has_doi) then 884 + El.splice [] 885 + else 886 + let cfg = Arod_model.get_config () in 887 + let me = Arod_model.lookup_by_handle cfg.site.author_handle in 888 + match me with 889 + | None -> El.splice [] 890 + | Some author_contact -> 891 + let references = Bushel.Md.note_references (Arod_model.get_entries ()) author_contact note in 892 + if List.length references > 0 then 893 + let ref_items = List.map (fun (doi, citation, _is_paper) -> 894 + let doi_url = Printf.sprintf "https://doi.org/%s" doi in 895 + El.li [ 896 + El.txt citation; 897 + El.a ~at:[At.href doi_url; At.v "target" "_blank"] [El.i [El.txt doi]]; 898 + ] 899 + ) references in 900 + El.div ~at:[At.class' "references-section"] [ 901 + El.h3 ~at:[At.class' "references-heading"] [El.txt "References"]; 902 + El.ul ~at:[At.class' "references-list"] ref_items 903 + ] 904 + else 905 + El.splice []

+4

arod/lib/dune

··· 12 tomlt.bytesrw 13 uri 14 ptime 0 0 0 0 15 fmt))

··· 12 tomlt.bytesrw 13 uri 14 ptime 15 + ptime.clock.os 16 + syndic 17 + jsonfeed 18 + ezjsonm 19 fmt))

+74

ocaml-bushel/lib/bushel_entry.ml

··· 194 | `Slug t -> lk t 195 | _ -> None 196 ) tags 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 194 | `Slug t -> lk t 195 | _ -> None 196 ) tags 197 + 198 + (** {1 Thumbnail Functions} *) 199 + 200 + (** Get the smallest webp variant from a srcsetter image - prefers size just above 480px *) 201 + let smallest_webp_variant img = 202 + let variants = Srcsetter.variants img in 203 + let webp_variants = 204 + Srcsetter.MS.bindings variants 205 + |> List.filter (fun (name, _) -> String.ends_with ~suffix:".webp" name) 206 + in 207 + match webp_variants with 208 + | [] -> 209 + (* No webp variants - use the name field which is always webp *) 210 + "/images/" ^ Srcsetter.name img 211 + | variants -> 212 + (* Prefer variants with width > 480px, choosing the smallest one above 480 *) 213 + let large_variants = List.filter (fun (_, (w, _)) -> w > 480) variants in 214 + let candidates = if large_variants = [] then variants else large_variants in 215 + (* Find the smallest variant from candidates *) 216 + let smallest = List.fold_left (fun acc (name, (w, h)) -> 217 + match acc with 218 + | None -> Some (name, w, h) 219 + | Some (_, min_w, _) when w < min_w -> Some (name, w, h) 220 + | _ -> acc 221 + ) None candidates in 222 + match smallest with 223 + | Some (name, _, _) -> "/images/" ^ name 224 + | None -> "/images/" ^ Srcsetter.name img 225 + 226 + (** Get thumbnail slug for a contact *) 227 + let contact_thumbnail_slug contact = 228 + (* Contact images use just the handle as slug *) 229 + Some (Sortal_schema.Contact.handle contact) 230 + 231 + (** Get thumbnail URL for a contact - resolved through srcsetter *) 232 + let contact_thumbnail entries contact = 233 + match contact_thumbnail_slug contact with 234 + | None -> None 235 + | Some thumb_slug -> 236 + match lookup_image entries thumb_slug with 237 + | Some img -> Some (smallest_webp_variant img) 238 + | None -> None 239 + 240 + (** Get thumbnail slug for an entry - simple version *) 241 + let rec thumbnail_slug entries = function 242 + | `Paper p -> Some (Bushel_paper.slug p) 243 + | `Video v -> Some (Bushel_video.uuid v) 244 + | `Project p -> Some (Printf.sprintf "project-%s" (Bushel_project.slug p)) 245 + | `Idea i -> 246 + (* Use project thumbnail for ideas *) 247 + let project_slug = Bushel_idea.project i in 248 + (match lookup entries project_slug with 249 + | Some p -> thumbnail_slug entries p 250 + | None -> None) 251 + | `Note n -> 252 + (* Use titleimage if set, otherwise try slug_ent's thumbnail *) 253 + (match Bushel_note.titleimage n with 254 + | Some slug -> Some slug 255 + | None -> 256 + match Bushel_note.slug_ent n with 257 + | Some slug_ent -> 258 + (match lookup entries slug_ent with 259 + | Some entry -> thumbnail_slug entries entry 260 + | None -> None) 261 + | None -> None) 262 + 263 + (** Get thumbnail URL for an entry with fallbacks - resolved through srcsetter *) 264 + let thumbnail entries entry = 265 + match thumbnail_slug entries entry with 266 + | None -> None 267 + | Some thumb_slug -> 268 + match lookup_image entries thumb_slug with 269 + | Some img -> Some (smallest_webp_variant img) 270 + | None -> None

+17

ocaml-bushel/lib/bushel_entry.mli

··· 127 128 val mention_entries : t -> Bushel_tags.t list -> entry list 129 (** [mention_entries entries tags] returns entries mentioned in the tags. *) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 127 128 val mention_entries : t -> Bushel_tags.t list -> entry list 129 (** [mention_entries entries tags] returns entries mentioned in the tags. *) 130 + 131 + (** {1 Thumbnail Functions} *) 132 + 133 + val smallest_webp_variant : Srcsetter.t -> string 134 + (** [smallest_webp_variant img] returns URL path to smallest webp variant above 480px. *) 135 + 136 + val contact_thumbnail_slug : Sortal_schema.Contact.t -> string option 137 + (** [contact_thumbnail_slug contact] returns the image slug for a contact. *) 138 + 139 + val contact_thumbnail : t -> Sortal_schema.Contact.t -> string option 140 + (** [contact_thumbnail entries contact] returns the thumbnail URL for a contact. *) 141 + 142 + val thumbnail_slug : t -> entry -> string option 143 + (** [thumbnail_slug entries entry] returns the image slug for an entry. *) 144 + 145 + val thumbnail : t -> entry -> string option 146 + (** [thumbnail entries entry] returns the thumbnail URL for an entry. *)

+263

ocaml-bushel/lib/bushel_md.ml

··· 17 - Plain HTML mode for feeds and simple output 18 *) 19 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 20 (** {1 Link Detection} *) 21 22 let is_bushel_slug = String.starts_with ~prefix:":" ··· 103 | _ -> None) 104 | _ -> None 105 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 106 (** {1 Link-Only Mapper} 107 108 Converts Bushel links to regular HTML links without sidenotes. ··· 179 | None -> Mapper.default)) 180 | None -> Mapper.default)) 181 | _ -> Mapper.default 0 0 0 182 183 (** {1 Slug Scanning} *) 184 ··· 623 let mapper = Mapper.make ~inline:(make_to_markdown_mapper ~base_url ~image_base entries) () in 624 let mapped_doc = Mapper.map_doc mapper doc in 625 Cmarkit_commonmark.of_doc mapped_doc 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 17 - Plain HTML mode for feeds and simple output 18 *) 19 20 + (** {1 Sidenote Types} 21 + 22 + Sidenote data types for interactive previews on hover. 23 + These are defined here as Cmarkit inline extensions that can be 24 + generated by the sidenote mapper and rendered by the webserver. *) 25 + 26 + type sidenote_data = 27 + | Contact_note of Sortal_schema.Contact.t * string 28 + | Paper_note of Bushel_paper.t * string 29 + | Idea_note of Bushel_idea.t * string 30 + | Note_note of Bushel_note.t * string 31 + | Project_note of Bushel_project.t * string 32 + | Video_note of Bushel_video.t * string 33 + | Footnote_note of string * Cmarkit.Block.t * string 34 + 35 + (** Extensible inline for sidenotes *) 36 + type Cmarkit.Inline.t += Side_note of sidenote_data 37 + 38 (** {1 Link Detection} *) 39 40 let is_bushel_slug = String.starts_with ~prefix:":" ··· 121 | _ -> None) 122 | _ -> None 123 124 + (** {1 Sidenote Mapper} 125 + 126 + Creates sidenotes for Bushel links. Used for interactive previews 127 + on the main website. *) 128 + 129 + let make_sidenote_mapper entries = 130 + let open Cmarkit in 131 + fun _m -> 132 + function 133 + | Inline.Link (lb, meta) -> 134 + (match link_target_is_bushel lb with 135 + | Some (url, title) -> 136 + let s = strip_handle url in 137 + if is_tag_slug url then 138 + (* Tag link - keep as regular link with ## prefix for renderer *) 139 + let txt = Inline.Text (title, meta) in 140 + let ld = Link_definition.make ~dest:(url, meta) () in 141 + let ll = `Inline (ld, meta) in 142 + let link = Inline.Link.make txt ll in 143 + Mapper.ret (Inline.Link (link, meta)) 144 + else if is_contact_slug url then 145 + (* Contact sidenote *) 146 + (match List.find_opt (fun c -> Sortal_schema.Contact.handle c = s) (Bushel_entry.contacts entries) with 147 + | Some c -> 148 + let sidenote = Side_note (Contact_note (c, title)) in 149 + Mapper.ret sidenote 150 + | None -> 151 + (* Contact not found, fallback to text *) 152 + let txt = Inline.Text (title, meta) in 153 + Mapper.ret txt) 154 + else 155 + (* Check entry type and generate appropriate sidenote *) 156 + (match Bushel_entry.lookup entries s with 157 + | Some (`Paper p) -> 158 + let sidenote = Side_note (Paper_note (p, title)) in 159 + Mapper.ret sidenote 160 + | Some (`Idea i) -> 161 + let sidenote = Side_note (Idea_note (i, title)) in 162 + Mapper.ret sidenote 163 + | Some (`Note n) -> 164 + let sidenote = Side_note (Note_note (n, title)) in 165 + Mapper.ret sidenote 166 + | Some (`Project p) -> 167 + let sidenote = Side_note (Project_note (p, title)) in 168 + Mapper.ret sidenote 169 + | Some (`Video v) -> 170 + let sidenote = Side_note (Video_note (v, title)) in 171 + Mapper.ret sidenote 172 + | None -> 173 + (* Entry not found, use regular link *) 174 + let dest = Bushel_entry.lookup_site_url entries s in 175 + let txt = Inline.Text (title, meta) in 176 + let ld = Link_definition.make ~dest:(dest, meta) () in 177 + let ll = `Inline (ld, meta) in 178 + let link = Inline.Link.make txt ll in 179 + Mapper.ret (Inline.Link (link, meta))) 180 + | None -> 181 + (* Handle reference-style links *) 182 + (match Inline.Link.referenced_label lb with 183 + | Some l -> 184 + let m = Label.meta l in 185 + (match Meta.find authorlink m with 186 + | Some () -> 187 + let slug = Label.key l in 188 + let s = strip_handle slug in 189 + (match List.find_opt (fun c -> Sortal_schema.Contact.handle c = s) (Bushel_entry.contacts entries) with 190 + | Some c -> 191 + let name = Sortal_schema.Contact.name c in 192 + let sidenote = Side_note (Contact_note (c, name)) in 193 + Mapper.ret sidenote 194 + | None -> 195 + let title = Inline.Link.text lb |> text_of_inline in 196 + let txt = Inline.Text (title, meta) in 197 + Mapper.ret txt) 198 + | None -> 199 + (match Meta.find sluglink m with 200 + | Some () -> 201 + let slug = Label.key l in 202 + if is_bushel_slug slug then 203 + let s = strip_handle slug in 204 + let title = Inline.Link.text lb |> text_of_inline in 205 + (match Bushel_entry.lookup entries s with 206 + | Some (`Paper p) -> Mapper.ret (Side_note (Paper_note (p, title))) 207 + | Some (`Idea i) -> Mapper.ret (Side_note (Idea_note (i, title))) 208 + | Some (`Note n) -> Mapper.ret (Side_note (Note_note (n, title))) 209 + | Some (`Project p) -> Mapper.ret (Side_note (Project_note (p, title))) 210 + | Some (`Video v) -> Mapper.ret (Side_note (Video_note (v, title))) 211 + | None -> 212 + let dest = Bushel_entry.lookup_site_url entries s in 213 + let txt = Inline.Text (title, meta) in 214 + let ld = Link_definition.make ~dest:(dest, meta) () in 215 + let ll = `Inline (ld, meta) in 216 + let link = Inline.Link.make txt ll in 217 + Mapper.ret (Inline.Link (link, meta))) 218 + else if is_tag_slug slug then 219 + let title = Inline.Link.text lb |> text_of_inline in 220 + let txt = Inline.Text (title, meta) in 221 + let ld = Link_definition.make ~dest:(slug, meta) () in 222 + let ll = `Inline (ld, meta) in 223 + let link = Inline.Link.make txt ll in 224 + Mapper.ret (Inline.Link (link, meta)) 225 + else Mapper.default 226 + | None -> Mapper.default)) 227 + | None -> Mapper.default)) 228 + | Inline.Image (lb, meta) -> 229 + (* Handle images with bushel slugs *) 230 + (match image_target_is_bushel lb with 231 + | Some (url, alt, caption) -> 232 + let s = strip_handle url in 233 + (* Check if this is a video - if so, use /videos/ path *) 234 + (match Bushel_entry.lookup entries s with 235 + | Some (`Video _) -> 236 + let dest = Printf.sprintf "/videos/%s" s in 237 + let txt = Inline.Text (caption, meta) in 238 + let ld = Link_definition.make ?title:alt ~dest:(dest, meta) () in 239 + let ll = `Inline (ld, meta) in 240 + let img = Inline.Link.make txt ll in 241 + Mapper.ret (Inline.Image (img, meta)) 242 + | _ -> 243 + (* Convert bushel slug to /images/ path *) 244 + let dest = Printf.sprintf "/images/%s.webp" s in 245 + let txt = Inline.Text (caption, meta) in 246 + let ld = Link_definition.make ?title:alt ~dest:(dest, meta) () in 247 + let ll = `Inline (ld, meta) in 248 + let img = Inline.Link.make txt ll in 249 + Mapper.ret (Inline.Image (img, meta))) 250 + | None -> Mapper.default) 251 + | _ -> Mapper.default 252 + 253 + (** Alias for compatibility *) 254 + let make_bushel_inline_mapper = make_sidenote_mapper 255 + 256 (** {1 Link-Only Mapper} 257 258 Converts Bushel links to regular HTML links without sidenotes. ··· 329 | None -> Mapper.default)) 330 | None -> Mapper.default)) 331 | _ -> Mapper.default 332 + 333 + (** Alias for compatibility *) 334 + let make_bushel_link_only_mapper _defs = make_link_only_mapper 335 336 (** {1 Slug Scanning} *) 337 ··· 776 let mapper = Mapper.make ~inline:(make_to_markdown_mapper ~base_url ~image_base entries) () in 777 let mapped_doc = Mapper.map_doc mapper doc in 778 Cmarkit_commonmark.of_doc mapped_doc 779 + 780 + (** {1 References} 781 + 782 + Reference extraction for CiTO annotations. *) 783 + 784 + (** Reference source type for CiTO annotations *) 785 + type reference_source = 786 + | Paper (** CitesAsSourceDocument *) 787 + | Note (** CitesAsRelated *) 788 + | External (** Cites *) 789 + 790 + (** Extract references (papers/notes with DOIs) from a note. 791 + Returns a list of (doi, citation_text, reference_source) tuples. 792 + 793 + @param entries The entry collection 794 + @param default_author The default author contact for notes without explicit author 795 + @param note The note to extract references from *) 796 + let note_references entries (default_author:Sortal_schema.Contact.t) note = 797 + let refs = ref [] in 798 + 799 + (* Helper to format author name: extract last name from full name *) 800 + let format_author_last name = 801 + let parts = String.split_on_char ' ' name in 802 + List.nth parts (List.length parts - 1) 803 + in 804 + 805 + (* Helper to format a citation *) 806 + let format_citation ~authors ~year ~title ~publisher = 807 + let author_str = match authors with 808 + | [] -> "" 809 + | [author] -> format_author_last author ^ " " 810 + | author :: _ -> (format_author_last author) ^ " et al " 811 + in 812 + let pub_str = match publisher with 813 + | None | Some "" -> "" 814 + | Some p -> p ^ ". " 815 + in 816 + Printf.sprintf "%s(%d). %s. %s" author_str year title pub_str 817 + in 818 + 819 + (* Check slug_ent if it exists *) 820 + (match Bushel_note.slug_ent note with 821 + | Some slug -> 822 + (match Bushel_entry.lookup entries slug with 823 + | Some (`Paper p) -> 824 + (match Bushel_paper.doi p with 825 + | Some doi -> 826 + let authors = Bushel_paper.authors p in 827 + let year = Bushel_paper.year p in 828 + let title = Bushel_paper.title p in 829 + let publisher = Some (Bushel_paper.publisher p) in 830 + let citation = format_citation ~authors ~year ~title ~publisher in 831 + refs := (doi, citation, Paper) :: !refs 832 + | None -> ()) 833 + | Some (`Note n) -> 834 + (match Bushel_note.doi n with 835 + | Some doi -> 836 + let authors = match Bushel_note.author n with 837 + | Some a -> [a] 838 + | None -> [Sortal_schema.Contact.name default_author] 839 + in 840 + let (year, _, _) = Bushel_note.date n in 841 + let title = Bushel_note.title n in 842 + let publisher = None in 843 + let citation = format_citation ~authors ~year ~title ~publisher in 844 + refs := (doi, citation, Note) :: !refs 845 + | None -> ()) 846 + | _ -> ()) 847 + | None -> ()); 848 + 849 + (* Scan body for bushel references *) 850 + let slugs = scan_for_slugs entries (Bushel_note.body note) in 851 + List.iter (fun slug -> 852 + (* Strip leading : or @ from slug before lookup *) 853 + let normalized_slug = strip_handle slug in 854 + match Bushel_entry.lookup entries normalized_slug with 855 + | Some (`Paper p) -> 856 + (match Bushel_paper.doi p with 857 + | Some doi -> 858 + let authors = Bushel_paper.authors p in 859 + let year = Bushel_paper.year p in 860 + let title = Bushel_paper.title p in 861 + let publisher = Some (Bushel_paper.publisher p) in 862 + let citation = format_citation ~authors ~year ~title ~publisher in 863 + (* Check if doi already exists in refs *) 864 + if not (List.exists (fun (d, _, _) -> d = doi) !refs) then 865 + refs := (doi, citation, Paper) :: !refs 866 + | None -> ()) 867 + | Some (`Note n) -> 868 + (match Bushel_note.doi n with 869 + | Some doi -> 870 + let authors = match Bushel_note.author n with 871 + | Some a -> [a] 872 + | None -> [Sortal_schema.Contact.name default_author] 873 + in 874 + let (year, _, _) = Bushel_note.date n in 875 + let title = Bushel_note.title n in 876 + let publisher = None in 877 + let citation = format_citation ~authors ~year ~title ~publisher in 878 + (* Check if doi already exists in refs *) 879 + if not (List.exists (fun (d, _, _) -> d = doi) !refs) then 880 + refs := (doi, citation, Note) :: !refs 881 + | None -> ()) 882 + | _ -> () 883 + ) slugs; 884 + 885 + (* TODO: Add external DOI URL scanning and publisher URL resolution *) 886 + (* This requires DOI caching infrastructure which is not yet ported *) 887 + 888 + List.rev !refs