load templates according to configuration

This commit is contained in:
Stavros Polymenis 2016-10-19 22:00:43 +01:00
parent 6d9baec448
commit a2e0272db9

View File

@ -1,5 +1,38 @@
open Opium.Std
module Configuration = struct
type template_set = {
index : string;
listing: string;
text : string;
}
type t = {
url : string;
stylesheets : string list;
templates : template_set;
}
let of_filename fn =
let result = Toml.Parser.from_filename fn in
match result with
| `Error (str, loc) -> { url = ""; stylesheets = []; templates = { 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
let strs_of table_name key_name = match TomlLenses.(get tbl (key table_name |-- table |-- key key_name |-- array |-- strings)) with
Some v -> v | None -> [] in
{
url = str_of "general" "url";
stylesheets = strs_of "general" "stylesheets";
templates = {
index = str_of "templates" "index";
listing = str_of "templates" "listing";
text = str_of "templates" "text";
}
}
end
let ymdpath title = return @@ "ymd/" ^ (Ymd.filename_of_title title)
let ymd_of_body_pairs pairs =
@ -16,6 +49,7 @@ 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 webcfg = Configuration.of_filename "web.toml"
let lgrn = Logarion.Configuration.of_filename "logarion.toml"
let () =
@ -24,8 +58,8 @@ 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 listing_tpl = Some (Logarion.load_file "share/index.mustache") in
let text_tpl = Some (Logarion.load_file "share/text.mustache") 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)