ivan/site
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

test out dream templates

Browse Source
This commit is contained in:
Rawley Fowler
2022-10-07 07:40:18 -06:00
parent cec095a7e7
commit b422246ac8
7 changed files with 241 additions and 294 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
db/database.ml
View File

@@ -64,33 +64,31 @@ end
module Db = (val Caqti_lwt.connect (Uri.of_string "sqlite3:database.db") >>= Caqti_lwt.or_fail |> Lwt_main.run) 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 *) (* Wrappers for the generic functions defined in Q *)
module Database = struct let create_blog_post_table () =
let create_blog_post_table () =
Db.exec Q.create_blog_post_table () Db.exec Q.create_blog_post_table ()
let 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) Db.exec Q.create_blog_post (slug, title, content, date)
let update_blog_post_content slug content = let update_blog_post_content slug content =
Db.exec Q.update_blog_post_content (content, slug) Db.exec Q.update_blog_post_content (content, slug)
let update_blog_post_title slug title = let update_blog_post_title slug title =
Db.exec Q.update_blog_post_title (title, slug) Db.exec Q.update_blog_post_title (title, slug)
let get_blog_post_by_slug slug = let get_blog_post_by_slug slug =
Db.find_opt Q.get_blog_post_by_slug slug Db.find_opt Q.get_blog_post_by_slug slug
let get_all_blog_posts () = let get_all_blog_posts () =
Db.collect_list Q.get_all_blog_posts () Db.collect_list Q.get_all_blog_posts ()
let iter_blog_posts f = let iter_blog_posts f =
Db.iter_s Q.get_all_blog_posts f () Db.iter_s Q.get_all_blog_posts f ()
let (>>=?) monad func = let (>>=?) monad func =
monad >>= (function | Ok x -> func x | Error err -> Lwt.return (Error err)) monad >>= (function | Ok x -> func x | Error err -> Lwt.return (Error err))
let report_error = function let report_error = function
| Ok () -> Lwt.return_unit | Ok () -> Lwt.return_unit
| Error err -> | Error err ->
Lwt_io.eprintl (Caqti_error.show err) Lwt_io.eprintl (Caqti_error.show err)
end

21
db/database.mli
View File

@@ -37,41 +37,38 @@ module Q :
module Db : Caqti_lwt.CONNECTION module Db : Caqti_lwt.CONNECTION
module Database : val create_blog_post_table :
sig
val create_blog_post_table :
unit -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t unit -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
val create_blog_post : val create_blog_post :
string -> string ->
string -> string ->
string -> string ->
string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
val update_blog_post_content : val update_blog_post_content :
string -> string ->
string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
val update_blog_post_title : val update_blog_post_title :
string -> string ->
string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
val get_blog_post_by_slug : val get_blog_post_by_slug :
string -> string ->
(BlogPost.t option, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t (BlogPost.t option, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
val get_all_blog_posts : val get_all_blog_posts :
unit -> unit ->
(BlogPost.t list, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t (BlogPost.t list, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t
val iter_blog_posts : val iter_blog_posts :
(BlogPost.t -> (BlogPost.t ->
(unit, [> Caqti_error.call_or_retrieve ] as 'a) Stdlib.result Lwt.t) -> (unit, [> Caqti_error.call_or_retrieve ] as 'a) Stdlib.result Lwt.t) ->
(unit, 'a) Stdlib.result Lwt.t (unit, 'a) Stdlib.result Lwt.t
val ( >>=? ) : val ( >>=? ) :
('a, 'b) Stdlib.result Lwt.t -> ('a, 'b) Stdlib.result Lwt.t ->
('a -> ('c, 'b) Stdlib.result Lwt.t) -> ('c, '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 val report_error : (unit, [< Caqti_error.t ]) Stdlib.result -> unit Lwt.t
end

61
html/index.html
View File

@@ -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 &copy; 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>

4
rawleydotxyz.ml
View File

@@ -1,6 +1,4 @@
open Lwt.Infix open Lwt.Infix
open Database
open Render
let db_created = ref true let db_created = ref true
@@ -16,7 +14,7 @@ let () =
@@ Dream.logger @@ Dream.logger
@@ Dream.router [ @@ Dream.router [
Dream.get "/static/**" @@ Dream.static "static"; 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 "/resume" @@ Dream.from_filesystem "html" "resume.html";
Dream.get "/philosophy" @@ Dream.from_filesystem "html" "philosophy.html"; Dream.get "/philosophy" @@ Dream.from_filesystem "html" "philosophy.html";
Dream.get "/web-ring" @@ Dream.from_filesystem "html" "web-ring.html"; Dream.get "/web-ring" @@ Dream.from_filesystem "html" "web-ring.html";

6
render/dune
View File

@@ -2,3 +2,9 @@
(name render) (name render)
(public_name rawleydotxyz.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})))

41
render/render.ml
View File

@@ -1,8 +1,10 @@
open Database
open Lwt open Lwt
module Render = struct module BlogPost = Database.BlogPost
let header_template =
module type SimpleRender = (sig val render : unit -> string end)
let header_template =
{eos|<!DOCTYPE html> {eos|<!DOCTYPE html>
<head> <head>
<meta charset="utf-8"> <meta charset="utf-8">
@@ -35,7 +37,7 @@ module Render = struct
</header> </header>
<main>|eos} <main>|eos}
let footer_template = let footer_template =
{eos|</main> {eos|</main>
<footer> <footer>
<hr> <hr>
@@ -50,36 +52,36 @@ module Render = struct
</body> </body>
</html>|eos} </html>|eos}
let replace_sequence r t s = let replace_sequence r t s =
Str.(global_replace (regexp r) t s) Str.(global_replace (regexp r) t s)
let html_unescape s = let html_unescape s =
s s
|> replace_sequence "&lsquo;" "'" |> replace_sequence "&lsquo;" "'"
|> replace_sequence "&rsquo;" "'" |> replace_sequence "&rsquo;" "'"
|> replace_sequence "&gt;" ">" |> replace_sequence "&gt;" ">"
|> replace_sequence "&lt;" "<" |> replace_sequence "&lt;" "<"
let not_found_template = let not_found_template =
Printf.sprintf "%s %s %s" Printf.sprintf "%s %s %s"
header_template header_template
"<h4>404 Not found<h4>" "<h4>404 Not found<h4>"
footer_template footer_template
let error_template = let error_template =
Printf.sprintf "%s %s %s" Printf.sprintf "%s %s %s"
header_template header_template
"<h4>500 Server Error</h4>" "<h4>500 Server Error</h4>"
footer_template footer_template
let render_page content = let render_page content =
Printf.sprintf Printf.sprintf
"%s %s %s" "%s %s %s"
header_template header_template
content content
footer_template footer_template
let generate_link (p : BlogPost.t) = let generate_link (p : BlogPost.t) =
Printf.sprintf Printf.sprintf
{eos|<div class="link-wrapper"> {eos|<div class="link-wrapper">
<a href="/blog/%s">%s</a> <a href="/blog/%s">%s</a>
@@ -87,7 +89,7 @@ module Render = struct
</div>|eos} </div>|eos}
p.slug p.title p.date p.slug p.title p.date
let generate_rss_item (p : BlogPost.t) = let generate_rss_item (p : BlogPost.t) =
Printf.sprintf Printf.sprintf
{eos|<item> {eos|<item>
<title>%s</title> <title>%s</title>
@@ -96,14 +98,14 @@ module Render = struct
</item>|eos} </item>|eos}
p.title p.slug p.title p.slug
let handle_error e = let handle_error e =
print_endline (Caqti_error.show e); print_endline (Caqti_error.show e);
Dream.html ?code:(Some 500) error_template Dream.html ?code:(Some 500) error_template
let handle_not_found () = let handle_not_found () =
Dream.html ?code:(Some 404) not_found_template Dream.html ?code:(Some 404) not_found_template
let render_blog_post request = let render_blog_post request =
let slug = Dream.param request "post" in let slug = Dream.param request "post" in
let post_t = Database.get_blog_post_by_slug slug in let post_t = Database.get_blog_post_by_slug slug in
post_t >>= fun post -> post_t >>= fun post ->
@@ -117,7 +119,7 @@ module Render = struct
|> render_page |> render_page
|> Dream.html |> Dream.html
let render_blog_index (_ : Dream.request) = let render_blog_index (_ : Dream.request) =
let buff = Buffer.create 512 in 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 () = 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 let posts_t = Database.get_all_blog_posts () in
@@ -130,7 +132,7 @@ module Render = struct
else render_page "<br>No blog posts..." in else render_page "<br>No blog posts..." in
Dream.html c Dream.html c
let render_rss_feed (_ : Dream.request) = let render_rss_feed (_ : Dream.request) =
let buff = Buffer.create 512 in let buff = Buffer.create 512 in
let add_str = Buffer.add_string buff in let add_str = Buffer.add_string buff in
let () = let () =
@@ -162,4 +164,9 @@ module Render = struct
Dream.response Dream.response
~headers:["Content-Type", "text/xml";] ~headers:["Content-Type", "text/xml";]
(Buffer.contents buff) (Buffer.contents buff)
end
let render_simple (module R : SimpleRender) =
R.render () |> Layout.render |> Dream.html
let render_index () =
render_simple (module Index)

34
render/render.mli
View File

@@ -1,16 +1,18 @@
open Database module BlogPost = Database.BlogPost
module type SimpleRender = sig val render : unit -> string end
module Render : val header_template : string
sig val footer_template : string
val not_found_template : string val replace_sequence : string -> string -> string -> string
val error_template : string val html_unescape : string -> string
val header_template : string val not_found_template : string
val footer_template : string val error_template : string
val render_page : string -> string val render_page : string -> string
val generate_link : BlogPost.t -> string val generate_link : BlogPost.t -> string
val handle_error : [< Caqti_error.t ] -> Dream.response Lwt.t val generate_rss_item : BlogPost.t -> string
val handle_not_found : unit -> Dream.response Lwt.t val handle_error : [< Caqti_error.t ] -> Dream.response Lwt.t
val render_blog_post : Dream.request -> Dream.response Lwt.t val handle_not_found : unit -> Dream.response Lwt.t
val render_blog_index : Dream.request -> Dream.response Lwt.t val render_blog_post : Dream.request -> Dream.response Lwt.t
val render_rss_feed : Dream.request -> Dream.response Lwt.t val render_blog_index : Dream.request -> Dream.response Lwt.t
end 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