implemented header template

share/header.mustache

@@ -0,0 +1 @@
+<header><h1>{{title}}</h1></header>

src/html.ml

@@ -15,7 +15,7 @@ let logarion_header ?(header_tpl=None) title =
 
 let logarion_page ?(header_tpl=None) head_title header_title main = 
   html (head head_title)
-       (body [ logarion_header header_title; main ] )
+       (body [ logarion_header ~header_tpl header_title; main ] )
 
 let logarion_text ?(text_tpl=None) ymd =
   match text_tpl with
@@ -28,8 +28,9 @@ let logarion_text ?(text_tpl=None) ymd =
      Unsafe.data ymd_body;
      footer [p []]
 
-let of_ymd ?(text_tpl=None) lgrn ymd =
+let of_ymd ?(header_tpl=None) ?(text_tpl=None) lgrn ymd =
   logarion_page
+    ~header_tpl
     Ymd.(ymd.meta.title ^ " by " ^ ymd.meta.author.name)
     Logarion.Configuration.(lgrn.title)
     (logarion_text ~text_tpl ymd)
@@ -40,21 +41,23 @@ let article_link (file, meta) =
         [Unsafe.data Ymd.(meta.title)]
      ]
 
-let of_file_meta_pairs ?(listing_tpl=None) lgrn file_meta_pairs =
+let of_file_meta_pairs ?(header_tpl=None) ?(listing_tpl=None) lgrn file_meta_pairs =
   let t = Logarion.Configuration.(lgrn.title) in
   logarion_page
+    ~header_tpl
     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 lgrn ymd =
+let form ?(header_tpl=None) 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
     "Compose" "Article composition"
     Ymd.(div [
              form

src/web.ml

@@ -2,6 +2,7 @@ open Opium.Std
 
 module Configuration = struct
   type template_set = {
+      header : string;
       index : string;
       listing: string;
       text : string;
@@ -16,7 +17,7 @@ module Configuration = struct
   let of_filename fn =
     let result = Toml.Parser.from_filename fn in
     match result with
-    | `Error (str, loc) -> { url = ""; stylesheets = []; templates = { index = ""; listing = ""; text = "" } }
+    | `Error (str, loc) -> { url = ""; stylesheets = []; templates = { header = ""; index = ""; listing = ""; text = "" } }
     | `Ok tbl ->
        let str_of table_name key_name = match TomlLenses.(get tbl (key table_name |-- table |-- key key_name |-- string)) with
          Some v -> v | None -> "" in
@@ -26,6 +27,7 @@ module Configuration = struct
          url = str_of "general" "url";
          stylesheets = strs_of "general" "stylesheets";
          templates = {
+             header = str_of "templates" "header";
              index = str_of "templates" "index";
              listing = str_of "templates" "listing";
              text = str_of "templates" "text";
@@ -58,14 +60,15 @@ let () =
   let module L = Logarion in
   let ymd f = L.of_file f in
   let ret_param name req = return (param req name) in
+  let header_tpl = Some (Logarion.load_file Configuration.(webcfg.templates.header)) in
   let listing_tpl = Some (Logarion.load_file Configuration.(webcfg.templates.listing)) in
   let text_tpl = Some (Logarion.load_file Configuration.(webcfg.templates.text)) in
   App.empty
-  |> 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)
+  |> 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)
   |> 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 lgrn >>= html_response)
+  |> get "/"          (fun _   -> return (L.file_meta_pairs ()) >|= Html.of_file_meta_pairs ~header_tpl ~listing_tpl lgrn >>= html_response)
   |> App.run_command

web.toml

@@ -3,6 +3,7 @@ url = "http://localhost/"
 stylesheets = [ "style.css" ]
 
 [templates]
-index = "share/index.mustache"
+header = "share/header.mustache"
+index  = "share/index.mustache"
 listing = "share/listing.mustache"
-text = "share/text.mustache"
+text   = "share/text.mustache"