Refactor html composition from Template

This commit is contained in:
Stavros Polymenis 2017-11-28 22:23:49 +00:00
parent fe0ae40e86
commit 1283c1de78
2 changed files with 15 additions and 10 deletions

View File

@ -25,15 +25,18 @@ let note ~date ~abstract ~body =
Unsafe.data body;
]
let anchor url content = a ~a:[ a_href (uri_of_string url) ] [ Unsafe.data content ]
let anchor url content = a ~a:[ a_href (uri_of_string url) ] content
let message message = [ pcdata message ]
let div ?(style_class="") content =
let a = if style_class <> "" then [a_class [style_class]] else [] in
div ~a content
let list_unordered = ul
let list_item content = li [ content ]
let block = Unsafe.data
let html_data = Unsafe.data
let data = pcdata
let form blog_url lgrn ymd =
let article_form =

View File

@ -84,9 +84,11 @@ let fold_header blog_url title =
let anchor_of_meta meta =
let module Meta = Logarion.Meta in
Html.anchor
("/note/" ^ Meta.alias meta)
("<p class=\"title\">" ^ meta.Meta.title ^ "</p><p class=\"time\">" ^ Meta.Date.(pretty_date (last meta.Meta.date)) ^ "</p>")
let open Html in
anchor
(Meta.alias meta ^ ".html")
[ div ~style_class:"title" [data meta.Meta.title];
div ~style_class:"time" [data Meta.Date.(pretty_date (last meta.Meta.date))] ]
let listing metas =
let open Html in
@ -113,12 +115,12 @@ let fold_index ~from ~n metas =
let note_page ?(header_template=None) ?(note_template=None) ~style url title note =
let header_html = match header_template with
| Some (Header s) -> Html.header @@ Html.block @@ fold_header url title s
| Some (Header s) -> Html.header @@ Html.data @@ fold_header url title s
| None -> Html.(header (heading1 title))
in
let note_html = match note_template with
| Some (Note s) -> Html.block @@ fold_note note s
| Some (Note s) -> Html.data @@ fold_note note s
| None ->
let open Logarion.Note in
let open Logarion.Meta in
@ -133,12 +135,12 @@ let note_page ?(header_template=None) ?(note_template=None) ~style url title not
let listing_page ?(header_template=None) ?(listing_template=None) ~style ~from ~n url title metas =
let header_html = match header_template with
| Some (Header s) -> Html.header @@ Html.block @@ fold_header url title s
| Some (Header s) -> Html.header @@ Html.data @@ fold_header url title s
| None -> Html.(header (heading1 title))
in
let listing_html = match listing_template with
| Some (Note s) -> Html.block @@ fold_index ~from ~n metas s
| Some (Note s) -> Html.data @@ fold_index ~from ~n metas s
| None -> listing metas
in