open Lwt module BlogPost = Database.BlogPost module type SimpleRender = (sig val render : unit -> string end) let header_template = {eos| rawley.xyz

/home/rawley.xyz

|eos} let footer_template = {eos|
|eos} let replace_sequence r t s = Str.(global_replace (regexp r) t s) let html_unescape s = s |> replace_sequence "‘" "'" |> replace_sequence "’" "'" |> replace_sequence ">" ">" |> replace_sequence "<" "<" let not_found_template = Printf.sprintf "%s %s %s" header_template "

404 Not found

" footer_template let error_template = Printf.sprintf "%s %s %s" header_template "

500 Server Error

" footer_template let render_page content = Printf.sprintf "%s %s %s" header_template content footer_template let generate_link (p : BlogPost.t) = Printf.sprintf {eos||eos} p.slug p.title p.date let generate_rss_item (p : BlogPost.t) = Printf.sprintf {eos| %s https://rawley.xyz/blog/%s |eos} p.title p.slug let handle_error e = print_endline (Caqti_error.show e); Dream.html ?code:(Some 500) error_template let handle_not_found () = Dream.html ?code:(Some 404) not_found_template let render_blog_post request = let slug = Dream.param request "post" in let post_t = Database.get_blog_post_by_slug slug in post_t >>= fun post -> match post with | Error e -> handle_error e | Ok p_opt -> match p_opt with | None -> handle_not_found () | Some p -> Printf.sprintf "

%s

\r\n%s" p.title p.content |> render_page |> Dream.html let render_blog_index (_ : Dream.request) = let buff = Buffer.create 512 in let () = Buffer.add_string buff "

Blog

I have an rss feed too." in let posts_t = Database.get_all_blog_posts () in posts_t >>= function | Error e -> handle_error e | Ok posts -> List.iter (fun p -> Buffer.add_string buff (generate_link p)) posts; let c = if List.length posts <> 0 then render_page @@ Buffer.contents buff else render_page "
No blog posts..." in Dream.html c let render_rss_feed (_ : Dream.request) = let buff = Buffer.create 512 in let add_str = Buffer.add_string buff in let () = add_str {eos| rawley.xyz blog Functional programming, math, and philosophy https://rawley.xyz/static/rawley.xyz.png https://rawley.xyz/ |eos} in let posts_t = Database.get_all_blog_posts () in posts_t >>= function | Error e -> handle_error e | Ok posts -> let () = List.iter (fun t -> generate_rss_item t |> html_unescape |> add_str) posts in let () = add_str {eos| |eos} in Lwt.return @@ Dream.response ~headers:["Content-Type", "text/xml";] (Buffer.contents buff) let render_simple (module R : SimpleRender) = R.render () |> Layout.render |> Dream.html let render_index () = render_simple (module Index)