refactoring and introduction of logarion parameter

src/html.ml

@@ -2,29 +2,32 @@ open Tyxml.Html
 
 let to_string tyxml = Format.asprintf "%a" (Tyxml.Html.pp ()) tyxml
 
-let logarion_head ?(style="/style.css") t =
+let head ?(style="/style.css") t =
   head (title (pcdata t)) [
          link ~rel:[`Stylesheet] ~href:"/style.css" ();
          meta ~a:[a_charset "utf-8"] ();
        ]
 
-let of_ymd ?text_tpl:(tpl=None) ymd =
+let logarion_header ?header_tpl:(tpl=None) title =
+  match tpl with
+  | Some s -> Unsafe.data Template.(of_string s |> fold_header title)
+  | None   -> header [ h1 [ pcdata title] ]
+
+let logarion_text ?text_tpl:(tpl=None) ymd =
+  match tpl with
+  | Some s -> Unsafe.data Template.(of_string s |> fold_text ymd)
+  | None ->
+     let ymd_body = Omd.to_html (Omd.of_string Ymd.(ymd.body)) in
+     details
+       (summary [Unsafe.data Ymd.(ymd.meta.abstract)])
+       [time ~a:[a_datetime (Ymd.(rfc_string_of ymd.meta.date.published))] []];
+     Unsafe.data ymd_body;
+     footer [p []]
+
+let of_ymd ?text_tpl:(tpl=None) lgrn ymd =
   let ymd_title = Ymd.(ymd.meta.title) in
-  html (logarion_head ymd_title)
-       (body [
-            match tpl with
-            | Some s -> Unsafe.data Template.(of_string s |> fold_text ymd)
-            | None ->
-               let ymd_body = Omd.to_html (Omd.of_string Ymd.(ymd.body)) in
-               header [
-                   h1 [Unsafe.data ymd_title];
-                   details
-                     (summary [Unsafe.data Ymd.(ymd.meta.abstract)])
-                     [time ~a:[a_datetime (Ymd.(rfc_string_of ymd.meta.date.published))] []];
-                 ];
-               Unsafe.data ymd_body;
-               footer [p []];
-       ])
+  html (head (ymd_title ^ " by " ^ ymd.meta.author.name))
+       (body [logarion_header ymd_title; logarion_text ~text_tpl:tpl ymd ])
   |> to_string
 
 let article_link (file, meta) =
@@ -32,10 +35,11 @@ let article_link (file, meta) =
         [Unsafe.data Ymd.(meta.title)]
      ]
 
-let of_file_meta_pairs ?listing_tpl:(tpl=None) file_meta_pairs =
-  html (logarion_head "Homepage")
+let of_file_meta_pairs ?listing_tpl:(tpl=None) lgrn file_meta_pairs =
+  let t = Logarion.(lgrn.title) in
+  html (head t)
        (body [
-            header [ h1 [pcdata "Homepage"] ];
+            logarion_header t;
             div [
                 h2 [pcdata "Articles"];
                 match tpl with
@@ -45,16 +49,16 @@ let of_file_meta_pairs ?listing_tpl:(tpl=None) file_meta_pairs =
        ])
   |> to_string
 
-let form ymd =
+let form lgrn ymd =
   let input_set title name value =
     p [ label [
             span [pcdata title];
             input ~a:[a_name name; a_value value] ()
       ]]
   in
-  Ymd.(html (logarion_head "Compose")
+  Ymd.(html (head "Compose")
        (body [
-            header [ h1 [pcdata "Article composition"] ];
+            logarion_header "Article composition";
             div [
                 form
                   ~a:[a_method `Post; a_action (uri_of_string "/post"); a_accept_charset ["utf-8"];]

src/template.ml

@@ -41,6 +41,12 @@ let fold_entry (file, meta) =
     | _ -> prerr_endline ("unknown tag: " ^ e); "" in
   Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat
 
+let fold_header title =
+  let escaped e = match e with
+    | "title" -> title
+    | _ -> prerr_endline ("unknown tag: " ^ e); "" in
+  Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat
+  
 let fold_index ymd_meta_pairs =
   let string s = s in
   let section ~inverted name contents = "section" in

src/web.ml

@@ -16,6 +16,8 @@ let html_response h = `Html h |> respond'
 
 let ymd_or_error y = match y with Some (path, meta) -> Logarion.of_file ("ymd/" ^ path) | None -> Ymd.blank_ymd
 
+let lgrn = Logarion.({ title = "Test" })
+
 let () =
   let (>>=) = Lwt.(>>=)
   and (>|=) = Lwt.(>|=) in
@@ -25,11 +27,11 @@ let () =
   let listing_tpl = Some (Logarion.load_file "share/index.mustache") in
   let text_tpl = Some (Logarion.load_file "share/text.mustache") in
   App.empty
-  |> post "/post"     (fun req -> ymd_of_req req >>= fun ymd -> L.to_file ymd >>= fun () -> html_response (Html.of_ymd ymd))
-  |> get "/edit/:ttl" (fun r   -> ret_param "ttl" r >>= ymdpath >|= ymd >|= Html.form >>= html_response)
-  |> get "/new"       (fun _   -> return Ymd.blank_ymd >|= Html.form   >>= html_response)
-  |> get "/text/:ttl" (fun req -> ret_param "ttl" req >>= ymdpath >|= ymd >|= Html.of_ymd ~text_tpl >>= html_response)
-  |> get "/!/:ttl"    (fun req -> ret_param "ttl" req >|= L.latest_file_meta_pair >|= ymd_or_error >|= Html.of_ymd >>= html_response)
+  |> post "/post"     (fun req -> ymd_of_req req >>= fun ymd -> L.to_file ymd >>= fun () -> html_response (Html.of_ymd lgrn ymd))
+  |> get "/edit/:ttl" (fun r   -> ret_param "ttl" r >>= ymdpath >|= ymd >|= Html.form lgrn >>= html_response)
+  |> get "/new"       (fun _   -> return Ymd.blank_ymd >|= Html.form lgrn >>= html_response)
+  |> get "/text/:ttl" (fun req -> ret_param "ttl" req >>= ymdpath >|= ymd >|= Html.of_ymd ~text_tpl lgrn >>= html_response)
+  |> get "/!/:ttl"    (fun req -> ret_param "ttl" req >|= L.latest_file_meta_pair >|= ymd_or_error >|= Html.of_ymd lgrn >>= html_response)
   |> get "/style.css" (fun _   -> return "ymd/style.css" >|= L.load_file >>= string_response)
-  |> get "/"          (fun _   -> return (L.file_meta_pairs ()) >|= Html.of_file_meta_pairs ~listing_tpl >>= html_response)
+  |> get "/"          (fun _   -> return (L.file_meta_pairs ()) >|= Html.of_file_meta_pairs ~listing_tpl lgrn >>= html_response)
   |> App.run_command