open Lwt open Views module Blog_post = Database.Blog_post 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 : Blog_post.t) = Printf.sprintf {eos||eos} p.slug p.title p.date let generate_rss_item (p : Blog_post.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_index () = let%lwt posts = Database.get_all_blog_posts () in match posts with | Error e -> handle_error e | Ok posts -> Blog_index.render ~posts |> Layout.render |> Dream.html 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_blog_post ~slug = let%lwt post = Database.get_blog_post_by_slug slug in match post with | Ok p_opt -> begin match p_opt with | None -> handle_not_found () | Some p -> Dream.html @@ Post_layout.render ~title:p.title ~body:p.content ~tags:[p.title] end | Error e -> handle_error e let render_index () = render_simple (module Index)