From d43764b49ab32490829b21665c7aa8bb974cf6b9 Mon Sep 17 00:00:00 2001 From: Stavros Polymenis Date: Thu, 7 Dec 2017 23:15:42 +0000 Subject: [PATCH] Fix web server --- src/converters/html.ml | 10 +++++----- src/converters/template.ml | 13 ++++++++----- src/logarion_cli.ml | 2 +- src/logarion_webserver.ml | 27 ++++++++++++++------------- 4 files changed, 28 insertions(+), 24 deletions(-) diff --git a/src/converters/html.ml b/src/converters/html.ml index 1a91aa0..c6e3d9d 100644 --- a/src/converters/html.ml +++ b/src/converters/html.ml @@ -42,13 +42,13 @@ let meta ~abstract ~author ~date ~series ~topics ~keywords ~uuid = let note = article -let listing metas = +let listing url_of_meta metas = let open Html in let item meta = let module Meta = Logarion.Meta in li [ anchor - (Meta.alias meta ^ ".html") + (url_of_meta @@ Meta.alias meta) [ time @@ [unescaped_data Meta.Date.(pretty_date (last meta.Meta.date))]; pcdata "\n"; @@ -76,7 +76,7 @@ module Renderer = struct | tag -> prerr_endline ("unknown tag: " ^ tag); [unescaped_data ""] end -let form blog_url lgrn ymd = +let form default_owner default_email ymd = let article_form = let input_set title input = p [ label [ pcdata title; input ] ] in let either a b = if a <> "" then a else b in @@ -84,8 +84,8 @@ let form blog_url lgrn ymd = let open Meta in let open Author in let auth = ymd.meta.author in - let auth_name = either auth.name Logarion.(lgrn.Archive.Configuration.owner) in - let auth_addr = either (Email.to_string auth.email) Logarion.(lgrn.Archive.Configuration.email) in + let auth_name = either auth.name default_owner in + let auth_addr = either (Email.to_string auth.email) default_email in [ input ~a:[a_name "uuid"; a_value (Id.to_string ymd.meta.uuid); a_input_type `Hidden] (); input_set diff --git a/src/converters/template.ml b/src/converters/template.ml index c27089f..d334449 100644 --- a/src/converters/template.ml +++ b/src/converters/template.ml @@ -49,7 +49,7 @@ let body_default note = meta note.meta; Html.unescaped_data @@ Omd.to_html @@ Omd.of_string note.Logarion.Note.body ] -let listing metas = Html.listing metas +let listing url_of_meta metas = Html.listing url_of_meta metas let page ~style title header body = Html.to_string @@ Html.page ~style title header body @@ -68,8 +68,11 @@ let converter default custom = function let header_converter config = converter header_default header_custom @@ of_config config "header" let body_converter config = converter body_default body_custom @@ of_config config "body" -let page_of_listing header listing archive metas = - page ~style:"static/main.css" "Index" (header archive) (listing metas) +let page_of_listing ?(style="static/main.css") header listing archive metas = + page ~style "Index" (header archive) (listing metas) -let page_of_note header body archive note = - page ~style:"static/main.css" note.Logarion.Note.meta.Logarion.Meta.title (header archive) (body note) +let page_of_note ?(style="static/main.css") header body archive note = + page ~style note.Logarion.Note.meta.Logarion.Meta.title (header archive) (body note) + +let page_of_msg ?(style="static/main.css") header archive title msg = + page ~style title (header archive) (Html.div [Html.data msg]) diff --git a/src/logarion_cli.ml b/src/logarion_cli.ml index d139288..5ff3780 100644 --- a/src/logarion_cli.ml +++ b/src/logarion_cli.ml @@ -127,7 +127,7 @@ let convert directory = let module T = Converters.Template in let header = T.header_converter template_config in let body = T.body_converter template_config in - let page_of_listing metas = T.page_of_listing header T.listing config metas in + let page_of_listing metas = T.page_of_listing header (T.listing (fun x -> x ^ ".html")) config metas in let page_of_note note = T.page_of_note header body config note in let path_of_note note = directory ^ "/" ^ Meta.string_alias Note.(note.meta.Meta.title) ^ ".html" in let file_creation path content = diff --git a/src/logarion_webserver.ml b/src/logarion_webserver.ml index 3387cce..e50fab5 100644 --- a/src/logarion_webserver.ml +++ b/src/logarion_webserver.ml @@ -8,7 +8,6 @@ module Configuration = struct url : Uri.t; static : Fpath.t; styles : Fpath.t list; - template : Template.Configuration.paths_t; } let of_config config = @@ -19,7 +18,6 @@ module Configuration = struct url = string config ("web"/"url") |> mandatory |> Uri.of_string; static = path config ("web"/"static_dir") |> mandatory; styles = paths config ("web"/"stylesheets") |> mandatory; - template = Template.Configuration.of_config config; } with Failure str -> Error str @@ -71,17 +69,8 @@ let serve config_filename = let store = File.store config.repository in let lgrn = L.{ config; store; } in - let header_tpl = Template.header web_config.Configuration.template in - let list_tpl = Template.list web_config.Configuration.template in - let item_tpl = Template.item web_config.Configuration.template in - let note_tpl = Template.note web_config.Configuration.template in - let blog_url = Uri.to_string web_config.Configuration.url in let module Html = Converters.Html in - let page_of_msg = Html.of_message ~header_tpl blog_url config in - let page_of_note = Html.of_note ~header_tpl ~note_tpl blog_url config in - let form_of_note = Html.form ~header_tpl blog_url config in - let list_of_notes ~from ~n = Html.of_entries ~header_tpl ~list_tpl ~item_tpl ~from ~n blog_url config in let lwt_blanknote () = Lwt.return (Logarion.Note.blank ()) in @@ -91,6 +80,18 @@ let serve config_filename = >|= Converters.Atom.feed config blog_url (L.note_with_id lgrn) >>= html_response in + + let template_config = toml_config in + let module T = Converters.Template in + let header = T.header_converter template_config in + let body = T.body_converter template_config in + let page_of_listing metas = + let listing = T.listing (fun x -> "note/" ^ x) in + T.page_of_listing ~style:"/static/main.css" header listing config metas in + let page_of_note note = T.page_of_note ~style:"/static/main.css" header body config note in + let page_of_msg title msg = T.page_of_msg ~style:"/static/main.css" header config title msg in + let form_of_note note = T.page "/static/main.css" "Write new note" (header config) (Converters.Html.form "" "" note) in + let post_note lgrn req = note_of_req req >>= L.with_note lgrn @@ -117,7 +118,7 @@ let serve config_filename = in Lwt.return (L.latest_listed lgrn) >|= L.sublist ~from:(from * n) ~n - >|= list_of_notes ~from ~n + >|= page_of_listing >>= html_response in @@ -129,7 +130,7 @@ let serve config_filename = in Lwt.return (L.with_topic lgrn (param req param_name)) >|= L.sublist ~from:(from * n) ~n - >|= list_of_notes ~from ~n + >|= page_of_listing >>= html_response in