diff --git a/db/database.ml b/db/database.ml index 52f8c0b..91b1e19 100644 --- 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 () = - 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) diff --git a/db/database.mli b/db/database.mli index 91f6a41..5504589 100644 --- 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 : - 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 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 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 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 report_error : (unit, [< Caqti_error.t ]) Stdlib.result -> unit Lwt.t - end +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 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 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 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 report_error : (unit, [< Caqti_error.t ]) Stdlib.result -> unit Lwt.t diff --git a/html/index.html b/html/index.html deleted file mode 100644 index 184a792..0000000 --- a/html/index.html +++ /dev/null @@ -1,61 +0,0 @@ - - - - - - - rawley.xyz - - - -
-

- /home/rawley.xyz -

- -
-
-

Welcome!

-

- 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. -

-

- All of my personal projects are Free Software and can be - found on my git server or, on my github. - 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. -

-

- If you need to contact me, please send me an email. -

-
- - - diff --git a/rawleydotxyz.ml b/rawleydotxyz.ml index 392be5d..5246188 100644 --- 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"; diff --git a/render/dune b/render/dune index c48986b..97b6f85 100644 --- a/render/dune +++ b/render/dune @@ -1,4 +1,10 @@ (library (name render) (public_name rawleydotxyz.render) - (libraries dream lwt database)) \ No newline at end of file + (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}))) \ No newline at end of file diff --git a/render/render.ml b/render/render.ml index 00b5404..270842a 100644 --- a/render/render.ml +++ b/render/render.ml @@ -1,165 +1,172 @@ -open Database open Lwt -module Render = struct - let header_template = - {eos| - - - - - rawley.xyz - - - - - -
-

- /home/rawley.xyz -

- -
-
|eos} +module BlogPost = Database.BlogPost - let footer_template = - {eos|
- - - |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| + + + + + rawley.xyz + + + + + +
+

+ /home/rawley.xyz +

+ +
+
|eos} - let html_unescape s = - s - |> replace_sequence "‘" "'" - |> replace_sequence "’" "'" - |> replace_sequence ">" ">" - |> replace_sequence "<" "<" +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 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 generate_link (p : BlogPost.t) = + Printf.sprintf + {eos||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||eos} - p.slug p.title p.date +let generate_rss_item (p : BlogPost.t) = + Printf.sprintf + {eos| + %s + https://rawley.xyz/blog/%s + + |eos} + p.title p.slug - let generate_rss_item (p : BlogPost.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_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 "

%s

\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 "

%s

\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 "

Blog

I have an rss feed 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 "
No blog posts..." in - Dream.html c +let render_blog_index (_ : Dream.request) = + let buff = Buffer.create 512 in + let () = Buffer.add_string buff "

Blog

I have an rss feed 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 "
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| - - - 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) -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| + + + 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_index () = + render_simple (module Index) diff --git a/render/render.mli b/render/render.mli index 2e26d02..8887f0f 100644 --- 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