test out dream templates
This commit is contained in:
@@ -64,33 +64,31 @@ end
|
||||
module Db = (val Caqti_lwt.connect (Uri.of_string "sqlite3:database.db") >>= Caqti_lwt.or_fail |> Lwt_main.run)
|
||||
|
||||
(* Wrappers for the generic functions defined in Q *)
|
||||
module Database = struct
|
||||
let create_blog_post_table () =
|
||||
Db.exec Q.create_blog_post_table ()
|
||||
let create_blog_post_table () =
|
||||
Db.exec Q.create_blog_post_table ()
|
||||
|
||||
let create_blog_post slug title content date =
|
||||
Db.exec Q.create_blog_post (slug, title, content, date)
|
||||
let create_blog_post slug title content date =
|
||||
Db.exec Q.create_blog_post (slug, title, content, date)
|
||||
|
||||
let update_blog_post_content slug content =
|
||||
Db.exec Q.update_blog_post_content (content, slug)
|
||||
let update_blog_post_content slug content =
|
||||
Db.exec Q.update_blog_post_content (content, slug)
|
||||
|
||||
let update_blog_post_title slug title =
|
||||
Db.exec Q.update_blog_post_title (title, slug)
|
||||
let update_blog_post_title slug title =
|
||||
Db.exec Q.update_blog_post_title (title, slug)
|
||||
|
||||
let get_blog_post_by_slug slug =
|
||||
Db.find_opt Q.get_blog_post_by_slug slug
|
||||
let get_blog_post_by_slug slug =
|
||||
Db.find_opt Q.get_blog_post_by_slug slug
|
||||
|
||||
let get_all_blog_posts () =
|
||||
Db.collect_list Q.get_all_blog_posts ()
|
||||
let get_all_blog_posts () =
|
||||
Db.collect_list Q.get_all_blog_posts ()
|
||||
|
||||
let iter_blog_posts f =
|
||||
Db.iter_s Q.get_all_blog_posts f ()
|
||||
let iter_blog_posts f =
|
||||
Db.iter_s Q.get_all_blog_posts f ()
|
||||
|
||||
let (>>=?) monad func =
|
||||
monad >>= (function | Ok x -> func x | Error err -> Lwt.return (Error err))
|
||||
let (>>=?) monad func =
|
||||
monad >>= (function | Ok x -> func x | Error err -> Lwt.return (Error err))
|
||||
|
||||
let report_error = function
|
||||
| Ok () -> Lwt.return_unit
|
||||
| Error err ->
|
||||
Lwt_io.eprintl (Caqti_error.show err)
|
||||
end
|
||||
let report_error = function
|
||||
| Ok () -> Lwt.return_unit
|
||||
| Error err ->
|
||||
Lwt_io.eprintl (Caqti_error.show err)
|
||||
|
||||
@@ -37,41 +37,38 @@ module Q :
|
||||
|
||||
module Db : Caqti_lwt.CONNECTION
|
||||
|
||||
module Database :
|
||||
sig
|
||||
val create_blog_post_table :
|
||||
unit -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
|
||||
val create_blog_post_table :
|
||||
unit -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
|
||||
|
||||
val create_blog_post :
|
||||
string ->
|
||||
string ->
|
||||
string ->
|
||||
string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
|
||||
val create_blog_post :
|
||||
string ->
|
||||
string ->
|
||||
string ->
|
||||
string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
|
||||
|
||||
val update_blog_post_content :
|
||||
string ->
|
||||
string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
|
||||
val update_blog_post_content :
|
||||
string ->
|
||||
string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
|
||||
|
||||
val update_blog_post_title :
|
||||
string ->
|
||||
string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
|
||||
val update_blog_post_title :
|
||||
string ->
|
||||
string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
|
||||
|
||||
val get_blog_post_by_slug :
|
||||
string ->
|
||||
(BlogPost.t option, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
|
||||
val get_blog_post_by_slug :
|
||||
string ->
|
||||
(BlogPost.t option, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
|
||||
|
||||
val get_all_blog_posts :
|
||||
unit ->
|
||||
(BlogPost.t list, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
|
||||
val get_all_blog_posts :
|
||||
unit ->
|
||||
(BlogPost.t list, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
|
||||
|
||||
val iter_blog_posts :
|
||||
(BlogPost.t ->
|
||||
(unit, [> Caqti_error.call_or_retrieve ] as 'a) Stdlib.result Lwt.t) ->
|
||||
(unit, 'a) Stdlib.result Lwt.t
|
||||
val iter_blog_posts :
|
||||
(BlogPost.t ->
|
||||
(unit, [> Caqti_error.call_or_retrieve ] as 'a) Stdlib.result Lwt.t) ->
|
||||
(unit, 'a) Stdlib.result Lwt.t
|
||||
|
||||
val ( >>=? ) :
|
||||
('a, 'b) Stdlib.result Lwt.t ->
|
||||
('a -> ('c, 'b) Stdlib.result Lwt.t) -> ('c, 'b) Stdlib.result Lwt.t
|
||||
val ( >>=? ) :
|
||||
('a, 'b) Stdlib.result Lwt.t ->
|
||||
('a -> ('c, 'b) Stdlib.result Lwt.t) -> ('c, 'b) Stdlib.result Lwt.t
|
||||
|
||||
val report_error : (unit, [< Caqti_error.t ]) Stdlib.result -> unit Lwt.t
|
||||
end
|
||||
val report_error : (unit, [< Caqti_error.t ]) Stdlib.result -> unit Lwt.t
|
||||
|
||||
@@ -1,61 +0,0 @@
|
||||
<!DOCTYPE html>
|
||||
<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">
|
||||
</head>
|
||||
<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>
|
||||
<h3>Welcome!</h3>
|
||||
<p>
|
||||
Hi, I'm Rawley. I'm a software developer and self-proclaimed systems administrator
|
||||
from Saskatchewan, Canada. I am experienced with a wide variety of technologies, including
|
||||
but not limited to OCaml, Clojure, Scheme, GNU/Linux, OpenBSD, C/C++,
|
||||
and Java. I am particularily interested in functional programming and
|
||||
programming language theory.
|
||||
</p>
|
||||
<p>
|
||||
All of my personal projects are <a href="https://www.gnu.org/philosophy/philosophy.html">Free Software</a> and can be
|
||||
found on <a href="https://git.rawley.xyz">my git server</a> or, on my <a href="https://github.com/rawleyfowler">github</a>.
|
||||
I spend most of my free time working on personal projects,
|
||||
writing blog posts, or listening to bluegrass music.
|
||||
To top it all off, I am a free software advocate, digital minimalist, and a full time husband.
|
||||
</p>
|
||||
<p>
|
||||
If you need to contact me, please send me an email.
|
||||
</p>
|
||||
</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>
|
||||
@@ -1,6 +1,4 @@
|
||||
open Lwt.Infix
|
||||
open Database
|
||||
open Render
|
||||
|
||||
let db_created = ref true
|
||||
|
||||
@@ -16,7 +14,7 @@ let () =
|
||||
@@ Dream.logger
|
||||
@@ Dream.router [
|
||||
Dream.get "/static/**" @@ Dream.static "static";
|
||||
Dream.get "/" @@ Dream.from_filesystem "html" "index.html";
|
||||
Dream.get "/" @@ (fun _ -> Render.render_index ());
|
||||
Dream.get "/resume" @@ Dream.from_filesystem "html" "resume.html";
|
||||
Dream.get "/philosophy" @@ Dream.from_filesystem "html" "philosophy.html";
|
||||
Dream.get "/web-ring" @@ Dream.from_filesystem "html" "web-ring.html";
|
||||
|
||||
@@ -2,3 +2,9 @@
|
||||
(name render)
|
||||
(public_name rawleydotxyz.render)
|
||||
(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})))
|
||||
307
render/render.ml
307
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 not_found_template =
|
||||
Printf.sprintf "%s %s %s"
|
||||
header_template
|
||||
"<h4>404 Not found<h4>"
|
||||
footer_template
|
||||
let replace_sequence r t s =
|
||||
Str.(global_replace (regexp r) t s)
|
||||
|
||||
let error_template =
|
||||
Printf.sprintf "%s %s %s"
|
||||
header_template
|
||||
"<h4>500 Server Error</h4>"
|
||||
footer_template
|
||||
let html_unescape s =
|
||||
s
|
||||
|> replace_sequence "‘" "'"
|
||||
|> replace_sequence "’" "'"
|
||||
|> replace_sequence ">" ">"
|
||||
|> replace_sequence "<" "<"
|
||||
|
||||
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 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 error_template =
|
||||
Printf.sprintf "%s %s %s"
|
||||
header_template
|
||||
"<h4>500 Server Error</h4>"
|
||||
footer_template
|
||||
|
||||
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 render_page content =
|
||||
Printf.sprintf
|
||||
"%s %s %s"
|
||||
header_template
|
||||
content
|
||||
footer_template
|
||||
|
||||
let handle_error e =
|
||||
print_endline (Caqti_error.show e);
|
||||
Dream.html ?code:(Some 500) error_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 handle_not_found () =
|
||||
Dream.html ?code:(Some 404) not_found_template
|
||||
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 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 handle_error e =
|
||||
print_endline (Caqti_error.show e);
|
||||
Dream.html ?code:(Some 500) error_template
|
||||
|
||||
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 handle_not_found () =
|
||||
Dream.html ?code:(Some 404) not_found_template
|
||||
|
||||
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_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_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