Fix web server

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_name = either auth.name default_owner in
-    let auth_addr = either (Email.to_string auth.email) Logarion.(lgrn.Archive.Configuration.email) 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

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 =
+let page_of_listing ?(style="static/main.css") header listing archive metas =
-  page ~style:"static/main.css" "Index" (header archive) (listing metas)
+  page ~style "Index" (header archive) (listing metas)
 
-let page_of_note header body archive note =
+let page_of_note ?(style="static/main.css") header body archive note =
-  page ~style:"static/main.css" note.Logarion.Note.meta.Logarion.Meta.title (header archive) (body 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])

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 =

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