test out dream templates

2022-10-07 07:40:18 -06:00
parent cec095a7e7
commit b422246ac8
7 changed files with 241 additions and 294 deletions
--- a/db/database.ml
+++ b/db/database.ml
@@ -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 () =
+let 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)

-  let update_blog_post_content slug content =
+let update_blog_post_content slug content =
  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)

-  let 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 () =
+let 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 ()

-  let (>>=?) monad func =
+let (>>=?) monad func =
  monad >>= (function | Ok x -> func x | Error err -> Lwt.return (Error err))

-  let report_error = function
+let report_error = function
  | Ok () -> Lwt.return_unit
  | Error err ->
      Lwt_io.eprintl (Caqti_error.show err)
-end
--- a/db/database.mli
+++ b/db/database.mli
@@ -37,41 +37,38 @@ module Q :

 module Db : Caqti_lwt.CONNECTION

-module Database :
-  sig
-    val create_blog_post_table :
+val create_blog_post_table :
  unit -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t

-    val create_blog_post :
+val create_blog_post :
  string ->
  string ->
  string ->
  string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t

-    val update_blog_post_content :
+val update_blog_post_content :
  string ->
  string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t

-    val update_blog_post_title :
+val update_blog_post_title :
  string ->
  string -> (unit, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t

-    val get_blog_post_by_slug :
+val get_blog_post_by_slug :
  string ->
  (BlogPost.t option, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t

-    val get_all_blog_posts :
+val get_all_blog_posts :
  unit ->
  (BlogPost.t list, [> Caqti_error.call_or_retrieve ]) Stdlib.result Lwt.t

-    val iter_blog_posts :
+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 ( >>=? ) :
+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
--- a/html/index.html
+++ b/html/index.html
@@ -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>
--- a/rawleydotxyz.ml
+++ b/rawleydotxyz.ml
@@ -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";
--- a/render/dune
+++ b/render/dune
@@ -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})))
--- a/render/render.ml
+++ b/render/render.ml
@@ -1,8 +1,10 @@
-open Database
 open Lwt

-module Render = struct
-  let header_template =
+module BlogPost = Database.BlogPost
+
+module type SimpleRender = (sig val render : unit -> string end)
+
+let header_template =
  {eos|<!DOCTYPE html>
    <head>
    <meta charset="utf-8">
@@ -35,7 +37,7 @@ module Render = struct
    </header>
    <main>|eos}

-  let footer_template =
+let footer_template =
  {eos|</main>
    <footer>
    <hr>
@@ -50,36 +52,36 @@ module Render = struct
    </body>
    </html>|eos}

-  let replace_sequence r t s =
+let replace_sequence r t s =
  Str.(global_replace (regexp r) t s)

-  let html_unescape s =
+let html_unescape s =
  s
  |> replace_sequence "&lsquo;" "'"
  |> replace_sequence "&rsquo;" "'"
  |> replace_sequence "&gt;" ">"
  |> replace_sequence "&lt;" "<"

-  let not_found_template =
+let not_found_template =
  Printf.sprintf "%s %s %s"
    header_template
    "<h4>404 Not found<h4>"
    footer_template

-  let error_template =
+let error_template =
  Printf.sprintf "%s %s %s"
    header_template
    "<h4>500 Server Error</h4>"
    footer_template

-  let render_page content =
+let render_page content =
  Printf.sprintf
    "%s %s %s"
    header_template
    content
    footer_template
  
-  let generate_link (p : BlogPost.t) =
+let generate_link (p : BlogPost.t) =
  Printf.sprintf
    {eos|<div class="link-wrapper">
      <a href="/blog/%s">%s</a>
@@ -87,7 +89,7 @@ module Render = struct
      </div>|eos}
    p.slug p.title p.date

-  let generate_rss_item (p : BlogPost.t) =
+let generate_rss_item (p : BlogPost.t) =
  Printf.sprintf
    {eos|<item>
      <title>%s</title>
@@ -96,14 +98,14 @@ module Render = struct
      </item>|eos}
    p.title p.slug

-  let handle_error e =
+let handle_error e =
  print_endline (Caqti_error.show e);
  Dream.html ?code:(Some 500) error_template

-  let handle_not_found () =
+let handle_not_found () =
  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 post_t = Database.get_blog_post_by_slug slug in
  post_t >>= fun post ->
@@ -117,7 +119,7 @@ module Render = struct
        |> render_page
        |> Dream.html

-  let render_blog_index (_ : Dream.request) =
+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
@@ -130,7 +132,7 @@ module Render = struct
              else render_page "<br>No blog posts..." in
      Dream.html c

-  let render_rss_feed (_ : Dream.request) =
+let render_rss_feed (_ : Dream.request) =
  let buff = Buffer.create 512 in
  let add_str = Buffer.add_string buff in
  let () =
@@ -162,4 +164,9 @@ module Render = struct
        Dream.response
          ~headers:["Content-Type", "text/xml";]
          (Buffer.contents buff)
-end
+
+let render_simple (module R : SimpleRender) =
+  R.render () |> Layout.render |> Dream.html
+
+let render_index () = 
+  render_simple (module Index)
--- a/render/render.mli
+++ b/render/render.mli
@@ -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