added blog_url information in html and templating

share/header.mustache

@@ -1 +1 @@
-<header><h1>{{title}}</h1></header>
+<header><h1><a href="{{blog_url}}">{{title}}</a></h1></header>

src/html.ml

@@ -8,14 +8,14 @@ let head ?(style="/style.css") t =
          meta ~a:[a_charset "utf-8"] ();
        ]
 
-let logarion_header ?(header_tpl=None) title =
+let logarion_header ?(header_tpl=None) blog_url title =
   match header_tpl with
-  | Some s -> Unsafe.data Template.(of_string s |> fold_header title)
+  | Some s -> Unsafe.data Template.(of_string s |> fold_header blog_url title)
   | None   -> header [ h1 [ pcdata title] ]
 
-let logarion_page ?(header_tpl=None) head_title header_title main = 
+let logarion_page ?(header_tpl=None) blog_url head_title header_title main = 
   html (head head_title)
-       (body [ logarion_header ~header_tpl header_title; main ] )
+       (body [ logarion_header ~header_tpl blog_url header_title; main ] )
 
 let logarion_text ?(text_tpl=None) ymd =
   match text_tpl with
@@ -28,9 +28,10 @@ let logarion_text ?(text_tpl=None) ymd =
      Unsafe.data ymd_body;
      footer [p []]
 
-let of_ymd ?(header_tpl=None) ?(text_tpl=None) lgrn ymd =
+let of_ymd ?(header_tpl=None) ?(text_tpl=None) blog_url lgrn ymd =
   logarion_page
     ~header_tpl
+    blog_url
     Ymd.(ymd.meta.title ^ " by " ^ ymd.meta.author.name)
     Logarion.Configuration.(lgrn.title)
     (logarion_text ~text_tpl ymd)
@@ -41,23 +42,25 @@ let article_link (file, meta) =
         [Unsafe.data Ymd.(meta.title)]
      ]
 
-let of_file_meta_pairs ?(header_tpl=None) ?(listing_tpl=None) lgrn file_meta_pairs =
+let of_file_meta_pairs ?(header_tpl=None) ?(listing_tpl=None) blog_url lgrn file_meta_pairs =
   let t = Logarion.Configuration.(lgrn.title) in
   logarion_page
     ~header_tpl
+    blog_url
     t t
     (match listing_tpl with
     | Some s -> Unsafe.data Template.(of_string s |> fold_index file_meta_pairs)
     | None -> (div [ h2 [pcdata "Articles"]; ul (List.map article_link file_meta_pairs); ]))
   |> to_string
 
-let form ?(header_tpl=None) lgrn ymd =
+let form ?(header_tpl=None) blog_url lgrn ymd =
   let input_set title name value =
     p [ label [ span [pcdata title]; input ~a:[a_name name; a_value value] () ] ]
   in
   let either a b = if a <> "" then a else b in
   logarion_page
     ~header_tpl
+    blog_url
     "Compose" "Article composition"
     Ymd.(div [
              form

src/template.ml

@@ -41,8 +41,9 @@ 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 fold_header blog_url title =
   let escaped e = match e with
+    | "blog_url" -> blog_url
     | "title" -> title
     | _ -> prerr_endline ("unknown tag: " ^ e); "" in
   Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat

src/web.ml

@@ -65,12 +65,16 @@ let () =
   let header_tpl = option_load Configuration.(webcfg.template.header) in
   let listing_tpl = option_load Configuration.(webcfg.template.listing) in
   let text_tpl = option_load Configuration.(webcfg.template.text) in
+  let blog_url = match Configuration.(webcfg.url) with Some url -> url | None -> "" in
+  let page_of_ymd = Html.of_ymd ~header_tpl ~text_tpl blog_url lgrn in
+  let form_of_ymd = Html.form ~header_tpl blog_url lgrn in
+  let list_of_ymds = Html.of_file_meta_pairs ~header_tpl ~listing_tpl blog_url lgrn in
   App.empty
-  |> post "/post"     (fun req -> ymd_of_req req >>= fun ymd -> L.to_file ymd >>= fun () -> html_response (Html.of_ymd ~header_tpl ~text_tpl lgrn ymd))
-  |> get "/edit/:ttl" (fun r   -> ret_param "ttl" r >>= ymdpath >|= ymd >|= Html.form ~header_tpl lgrn >>= html_response)
-  |> get "/new"       (fun _   -> return Ymd.blank_ymd >|= Html.form ~header_tpl lgrn >>= html_response)
-  |> get "/text/:ttl" (fun req -> ret_param "ttl" req >>= ymdpath >|= ymd >|= Html.of_ymd ~header_tpl ~text_tpl lgrn >>= html_response)
-  |> get "/!/:ttl"    (fun req -> ret_param "ttl" req >|= L.latest_file_meta_pair >|= ymd_or_error >|= Html.of_ymd ~header_tpl ~text_tpl lgrn >>= html_response)
+  |> post "/post"     (fun req -> ymd_of_req req >>= fun ymd -> L.to_file ymd >>= fun () -> html_response (page_of_ymd ymd))
+  |> get "/edit/:ttl" (fun r   -> ret_param "ttl" r >>= ymdpath >|= ymd >|= form_of_ymd >>= html_response)
+  |> get "/new"       (fun _   -> return Ymd.blank_ymd >|= form_of_ymd >>= html_response)
+  |> get "/text/:ttl" (fun req -> ret_param "ttl" req >>= ymdpath >|= ymd >|= page_of_ymd >>= html_response)
+  |> get "/!/:ttl"    (fun req -> ret_param "ttl" req >|= L.latest_file_meta_pair >|= ymd_or_error >|= page_of_ymd >>= 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 ~header_tpl ~listing_tpl lgrn >>= html_response)
+  |> get "/"          (fun _   -> return (L.file_meta_pairs ()) >|= list_of_ymds >>= html_response)
   |> App.run_command