software-archive/logarion-2016
2
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactoring and introduction of logarion parameter

Browse Source
This commit is contained in:
Stavros Polymenis 2016-10-17 22:38:48 +01:00
parent b9a1ea7f95
commit 5c3e43dd54
3 changed files with 41 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
src/html.ml
View File

@ -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"];]

6
src/template.ml
View File

@ -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

14
src/web.ml
View File

@ -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