test out dream templates
This commit is contained in:
@@ -1,4 +1,10 @@
|
||||
(library
|
||||
(name render)
|
||||
(public_name rawleydotxyz.render)
|
||||
(libraries dream lwt database))
|
||||
(libraries dream lwt database))
|
||||
|
||||
(rule
|
||||
(targets index.ml layout.ml)
|
||||
(deps index.eml.ml layout.eml.ml)
|
||||
(action
|
||||
(run dream_eml %{deps} --workspace %{workspace_root})))
|
||||
313
render/render.ml
313
render/render.ml
@@ -1,165 +1,172 @@
|
||||
open Database
|
||||
open Lwt
|
||||
|
||||
module Render = struct
|
||||
let header_template =
|
||||
{eos|<!DOCTYPE html>
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
<meta name="description" content="Rawley.xyz, Rawley Fowler's blog and personal website">
|
||||
<title>rawley.xyz</title>
|
||||
<link href="/static/index.css" rel="stylesheet">
|
||||
<link rel="alternate" type="application/rss+xml" href="https://rawley.xyz/blog/rss.xml" title="rawley.xyz">
|
||||
</head>
|
||||
<body>
|
||||
<body>
|
||||
<header>
|
||||
<h1>
|
||||
<a href="/">/home/rawley.xyz</a>
|
||||
</h1>
|
||||
<nav>
|
||||
<li>
|
||||
<a href="/blog">blog</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/resume">resume</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/philosophy">philosophy</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/web-ring">web ring</a>
|
||||
</li>
|
||||
</nav>
|
||||
</header>
|
||||
<main>|eos}
|
||||
module BlogPost = Database.BlogPost
|
||||
|
||||
let footer_template =
|
||||
{eos|</main>
|
||||
<footer>
|
||||
<hr>
|
||||
<p>
|
||||
Copyright © Rawley Fowler 2022
|
||||
</p>
|
||||
<p>
|
||||
<b>Disclaimer</b>: All opinions on this site, are that of my own. They do not
|
||||
reflect the opinions of any of my employers; past, present, or future.
|
||||
</p>
|
||||
</footer>
|
||||
</body>
|
||||
</html>|eos}
|
||||
module type SimpleRender = (sig val render : unit -> string end)
|
||||
|
||||
let replace_sequence r t s =
|
||||
Str.(global_replace (regexp r) t s)
|
||||
let header_template =
|
||||
{eos|<!DOCTYPE html>
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
<meta name="description" content="Rawley.xyz, Rawley Fowler's blog and personal website">
|
||||
<title>rawley.xyz</title>
|
||||
<link href="/static/index.css" rel="stylesheet">
|
||||
<link rel="alternate" type="application/rss+xml" href="https://rawley.xyz/blog/rss.xml" title="rawley.xyz">
|
||||
</head>
|
||||
<body>
|
||||
<body>
|
||||
<header>
|
||||
<h1>
|
||||
<a href="/">/home/rawley.xyz</a>
|
||||
</h1>
|
||||
<nav>
|
||||
<li>
|
||||
<a href="/blog">blog</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/resume">resume</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/philosophy">philosophy</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/web-ring">web ring</a>
|
||||
</li>
|
||||
</nav>
|
||||
</header>
|
||||
<main>|eos}
|
||||
|
||||
let html_unescape s =
|
||||
s
|
||||
|> replace_sequence "‘" "'"
|
||||
|> replace_sequence "’" "'"
|
||||
|> replace_sequence ">" ">"
|
||||
|> replace_sequence "<" "<"
|
||||
let footer_template =
|
||||
{eos|</main>
|
||||
<footer>
|
||||
<hr>
|
||||
<p>
|
||||
Copyright © Rawley Fowler 2022
|
||||
</p>
|
||||
<p>
|
||||
<b>Disclaimer</b>: All opinions on this site, are that of my own. They do not
|
||||
reflect the opinions of any of my employers; past, present, or future.
|
||||
</p>
|
||||
</footer>
|
||||
</body>
|
||||
</html>|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
|
||||
"<h4>404 Not found<h4>"
|
||||
footer_template
|
||||
|
||||
let error_template =
|
||||
Printf.sprintf "%s %s %s"
|
||||
header_template
|
||||
"<h4>500 Server Error</h4>"
|
||||
footer_template
|
||||
|
||||
let render_page content =
|
||||
Printf.sprintf
|
||||
"%s %s %s"
|
||||
header_template
|
||||
content
|
||||
footer_template
|
||||
|
||||
let not_found_template =
|
||||
Printf.sprintf "%s %s %s"
|
||||
header_template
|
||||
"<h4>404 Not found<h4>"
|
||||
footer_template
|
||||
|
||||
let error_template =
|
||||
Printf.sprintf "%s %s %s"
|
||||
header_template
|
||||
"<h4>500 Server Error</h4>"
|
||||
footer_template
|
||||
let generate_link (p : BlogPost.t) =
|
||||
Printf.sprintf
|
||||
{eos|<div class="link-wrapper">
|
||||
<a href="/blog/%s">%s</a>
|
||||
<i>%s</i>
|
||||
</div>|eos}
|
||||
p.slug p.title p.date
|
||||
|
||||
let render_page content =
|
||||
Printf.sprintf
|
||||
"%s %s %s"
|
||||
header_template
|
||||
content
|
||||
footer_template
|
||||
|
||||
let generate_link (p : BlogPost.t) =
|
||||
Printf.sprintf
|
||||
{eos|<div class="link-wrapper">
|
||||
<a href="/blog/%s">%s</a>
|
||||
<i>%s</i>
|
||||
</div>|eos}
|
||||
p.slug p.title p.date
|
||||
let generate_rss_item (p : BlogPost.t) =
|
||||
Printf.sprintf
|
||||
{eos|<item>
|
||||
<title>%s</title>
|
||||
<link>https://rawley.xyz/blog/%s</link>
|
||||
<description></description>
|
||||
</item>|eos}
|
||||
p.title p.slug
|
||||
|
||||
let generate_rss_item (p : BlogPost.t) =
|
||||
Printf.sprintf
|
||||
{eos|<item>
|
||||
<title>%s</title>
|
||||
<link>https://rawley.xyz/blog/%s</link>
|
||||
<description></description>
|
||||
</item>|eos}
|
||||
p.title p.slug
|
||||
|
||||
let handle_error e =
|
||||
print_endline (Caqti_error.show e);
|
||||
Dream.html ?code:(Some 500) error_template
|
||||
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 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 "<h2>%s</h2>\r\n%s" p.title p.content
|
||||
|> render_page
|
||||
|> Dream.html
|
||||
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 "<h2>%s</h2>\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 "<h3>Blog</h3> I have an <a href=\"/blog/rss.xml\">rss feed</a> 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 "<br>No blog posts..." in
|
||||
Dream.html c
|
||||
let render_blog_index (_ : Dream.request) =
|
||||
let buff = Buffer.create 512 in
|
||||
let () = Buffer.add_string buff "<h3>Blog</h3> I have an <a href=\"/blog/rss.xml\">rss feed</a> 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 "<br>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|<?xml version="1.0" encoding="UTF-8" ?>
|
||||
<rss version="2.0">
|
||||
<channel>
|
||||
<title>rawley.xyz blog</title>
|
||||
<description>Functional programming, math, and philosophy</description>
|
||||
<image>
|
||||
<url>https://rawley.xyz/static/rawley.xyz.png</url>
|
||||
<link>https://rawley.xyz/</link>
|
||||
</image>|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|</channel>
|
||||
</rss>|eos}
|
||||
in
|
||||
Lwt.return @@
|
||||
Dream.response
|
||||
~headers:["Content-Type", "text/xml";]
|
||||
(Buffer.contents buff)
|
||||
end
|
||||
let render_rss_feed (_ : Dream.request) =
|
||||
let buff = Buffer.create 512 in
|
||||
let add_str = Buffer.add_string buff in
|
||||
let () =
|
||||
add_str
|
||||
{eos|<?xml version="1.0" encoding="UTF-8" ?>
|
||||
<rss version="2.0">
|
||||
<channel>
|
||||
<title>rawley.xyz blog</title>
|
||||
<description>Functional programming, math, and philosophy</description>
|
||||
<image>
|
||||
<url>https://rawley.xyz/static/rawley.xyz.png</url>
|
||||
<link>https://rawley.xyz/</link>
|
||||
</image>|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|</channel>
|
||||
</rss>|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)
|
||||
|
||||
@@ -1,16 +1,18 @@
|
||||
open Database
|
||||
|
||||
module Render :
|
||||
sig
|
||||
val not_found_template : string
|
||||
val error_template : string
|
||||
val header_template : string
|
||||
val footer_template : string
|
||||
val render_page : string -> string
|
||||
val generate_link : BlogPost.t -> string
|
||||
val handle_error : [< Caqti_error.t ] -> Dream.response Lwt.t
|
||||
val handle_not_found : unit -> Dream.response Lwt.t
|
||||
val render_blog_post : Dream.request -> Dream.response Lwt.t
|
||||
val render_blog_index : Dream.request -> Dream.response Lwt.t
|
||||
val render_rss_feed : Dream.request -> Dream.response Lwt.t
|
||||
end
|
||||
module BlogPost = Database.BlogPost
|
||||
module type SimpleRender = sig val render : unit -> string end
|
||||
val header_template : string
|
||||
val footer_template : string
|
||||
val replace_sequence : string -> string -> string -> string
|
||||
val html_unescape : string -> string
|
||||
val not_found_template : string
|
||||
val error_template : string
|
||||
val render_page : string -> string
|
||||
val generate_link : BlogPost.t -> string
|
||||
val generate_rss_item : BlogPost.t -> string
|
||||
val handle_error : [< Caqti_error.t ] -> Dream.response Lwt.t
|
||||
val handle_not_found : unit -> Dream.response Lwt.t
|
||||
val render_blog_post : Dream.request -> Dream.response Lwt.t
|
||||
val render_blog_index : Dream.request -> Dream.response Lwt.t
|
||||
val render_rss_feed : Dream.request -> Dream.response Lwt.t
|
||||
val render_simple : (module SimpleRender) -> Dream.response Lwt.t
|
||||
val render_index : unit -> Dream.response Lwt.t
|
||||
|
||||
Reference in New Issue
Block a user