Move page structuring from Html to Template
This commit is contained in:
Stavros Polymenis
parent
bfe1279ff2
commit
b9a55a2be9
@ -10,63 +10,32 @@ let head ~style t =
|
||||
meta ~a:[a_charset "utf-8"] ();
|
||||
]
|
||||
|
||||
let logarion_header ?(header_tpl=None) blog_url title =
|
||||
match header_tpl with
|
||||
| Some (Template.Header s) -> Unsafe.data Template.(fold_header blog_url title s)
|
||||
| None -> header [ h1 [ pcdata title] ]
|
||||
|
||||
let default_style = "/static/main.css"
|
||||
|
||||
let logarion_page ?(style=default_style) ?(header_tpl=None) blog_url head_title header_title main =
|
||||
html (head ~style head_title) (body [ logarion_header ~header_tpl blog_url header_title; main ])
|
||||
let page ?(style=default_style) blog_url head_title header main =
|
||||
html (head ~style head_title) (body [ header; main ])
|
||||
|
||||
let logarion_note ?(note_tpl=None) ymd =
|
||||
match note_tpl with
|
||||
| Some (Template.Note s) -> Unsafe.data Template.(fold_note ymd s)
|
||||
| None ->
|
||||
let open Note in
|
||||
let open Meta in
|
||||
let ymd_body = Omd.to_html (Omd.of_string ymd.body) in
|
||||
article [
|
||||
details
|
||||
(summary [Unsafe.data ymd.meta.abstract])
|
||||
[time ~a:[a_datetime Date.(pretty_date @@ last ymd.meta.date)] []];
|
||||
Unsafe.data ymd_body;
|
||||
]
|
||||
let heading1 data = h1 [ pcdata data ]
|
||||
|
||||
let of_note ?(style=default_style) ?(header_tpl=None) ?(note_tpl=None) blog_url lgrn ymd =
|
||||
logarion_page
|
||||
~style
|
||||
~header_tpl
|
||||
blog_url
|
||||
(Note.title ymd ^ " by " ^ ymd.Note.meta.Meta.author.Meta.Author.name)
|
||||
Logarion.(lgrn.Archive.Configuration.title)
|
||||
(logarion_note ~note_tpl ymd)
|
||||
|> to_string
|
||||
let header data = header [ data ]
|
||||
|
||||
let article_link meta =
|
||||
let open Logarion in
|
||||
let u = "/note/" ^ Meta.alias meta in
|
||||
let d =
|
||||
let open Meta in
|
||||
Unsafe.data Note.(meta.Meta.title ^ (Meta.Date.pretty_date (meta.date |> Meta.Date.last)))
|
||||
in
|
||||
li [ a ~a:[ a_href (uri_of_string u) ] [ d ] ]
|
||||
let note ~date ~abstract ~body =
|
||||
article [
|
||||
details (summary [Unsafe.data abstract]) [time ~a:[a_datetime date] []];
|
||||
Unsafe.data body;
|
||||
]
|
||||
|
||||
let of_entries ?(style=default_style) ?(header_tpl=None) ?(list_tpl=None) ?(item_tpl=None) ?(from=0) ?(n=0) blog_url lgrn notes =
|
||||
let title = Logarion.(lgrn.Archive.Configuration.title) in
|
||||
logarion_page
|
||||
~style
|
||||
~header_tpl
|
||||
blog_url
|
||||
title
|
||||
title
|
||||
(match list_tpl with
|
||||
| Some (Template.List s) -> Unsafe.data Template.(fold_list ~item_tpl ~from ~n notes s)
|
||||
| None -> (div [ h2 [pcdata "Articles"]; ul (List.map article_link notes); ]))
|
||||
|> to_string
|
||||
let anchor url content = a ~a:[ a_href (uri_of_string url) ] [ Unsafe.data content ]
|
||||
|
||||
let form ?(header_tpl=None) blog_url lgrn ymd =
|
||||
let message message = [ pcdata message ]
|
||||
|
||||
let list_unordered = ul
|
||||
|
||||
let list_item content = li [ content ]
|
||||
|
||||
let block = Unsafe.data
|
||||
|
||||
let form blog_url lgrn ymd =
|
||||
let article_form =
|
||||
let input_set title input = p [ label [ pcdata title; input ] ] in
|
||||
let either a b = if a <> "" then a else b in
|
||||
@ -106,22 +75,10 @@ let form ?(header_tpl=None) blog_url lgrn ymd =
|
||||
"Text"
|
||||
(textarea ~a:[a_name "body"] (pcdata ymd.body));
|
||||
p [ button ~a:[a_button_type `Submit] [pcdata "Submit"] ];
|
||||
] in
|
||||
logarion_page
|
||||
~header_tpl
|
||||
blog_url
|
||||
"Compose" "Article composition"
|
||||
(div [ form
|
||||
~a:[a_method `Post; a_action (uri_of_string "/post.note"); a_accept_charset ["utf-8"];]
|
||||
[ fieldset ~legend:(legend [pcdata "Article"]) article_form ]
|
||||
])
|
||||
|> to_string
|
||||
|
||||
let of_message ?(header_tpl=None) blog_url lgrn title message =
|
||||
logarion_page
|
||||
~header_tpl
|
||||
blog_url
|
||||
title
|
||||
Logarion.(lgrn.Archive.Configuration.title)
|
||||
(div [pcdata message])
|
||||
|> to_string
|
||||
]
|
||||
in
|
||||
div
|
||||
[ form
|
||||
~a:[a_method `Post; a_action (uri_of_string "/post.note"); a_accept_charset ["utf-8"]]
|
||||
[ fieldset ~legend:(legend [pcdata "Article"]) article_form ]
|
||||
]
|
||||
|
||||
@ -71,6 +71,8 @@ let fold_meta (meta : Logarion.Meta.t) =
|
||||
| tag -> Meta.value_with_name meta tag in
|
||||
Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat
|
||||
|
||||
let fold_meta tpl meta = fold_meta meta tpl
|
||||
|
||||
let fold_header blog_url title =
|
||||
let escaped e =
|
||||
let e = List.hd e in
|
||||
@ -80,31 +82,64 @@ let fold_header blog_url title =
|
||||
| _ -> prerr_endline ("unknown tag: " ^ e); "" in
|
||||
Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat
|
||||
|
||||
let fold_list ?(item_tpl=None) ~from ~n notes =
|
||||
let anchor_of_meta meta =
|
||||
let module Meta = Logarion.Meta in
|
||||
let simple meta =
|
||||
"<li><a href=\"/note/" ^ Meta.alias meta ^ "\"><p class=\"title\">"
|
||||
^ meta.Meta.title ^ "</p><p class=\"time\">" ^ Meta.Date.(pretty_date (last meta.Meta.date))
|
||||
^ "</p></a></li>"
|
||||
in
|
||||
let fold_meta tpl meta = fold_meta meta tpl in
|
||||
let meta = match item_tpl with Some (Item e) -> fold_meta e | None -> simple 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 listing metas =
|
||||
let open Html in
|
||||
list_unordered @@ List.map (fun m -> list_item @@ anchor_of_meta @@ m) metas
|
||||
|
||||
let fold_index ~from ~n metas =
|
||||
let escaped e =
|
||||
let e = List.hd e in
|
||||
match e with
|
||||
match List.hd e with
|
||||
| "navigation" ->
|
||||
""
|
||||
^ (if from > 0 then ("<a href=\"?p=" ^ string_of_int (pred from) ^ "\">previous</a> | ") else "")
|
||||
^ (if n <= List.length notes then ("<a href=\"?p=" ^ string_of_int (succ from) ^ "\">next</a>") else "")
|
||||
| "recent_texts_listing" ->
|
||||
let open Logarion in
|
||||
ListLabels.fold_left ~init:"" ~f:(fun a e -> a ^ meta e) notes
|
||||
^ (if n <= List.length metas then ("<a href=\"?p=" ^ string_of_int (succ from) ^ "\">next</a>") else "")
|
||||
| "recent_texts_listing" -> (* listing metas *) ""
|
||||
| "topics" ->
|
||||
let topics =
|
||||
ListLabels.fold_left
|
||||
~init:(Meta.StringSet.empty)
|
||||
~f:(fun a e -> Meta.unique_topics a e ) notes
|
||||
~init:(Logarion.Meta.StringSet.empty)
|
||||
~f:(fun a e -> Logarion.Meta.unique_topics a e ) metas
|
||||
in
|
||||
Meta.StringSet.fold (fun e a -> a ^ "<li><a href=\"/topic/" ^ e ^ "\">" ^ e ^ "</a></li>") topics ""
|
||||
| _ -> prerr_endline ("unknown tag: " ^ e); "" in
|
||||
Logarion.Meta.StringSet.fold (fun e a -> a ^ "<li><a href=\"/topic/" ^ e ^ "\">" ^ e ^ "</a></li>") topics ""
|
||||
| e -> prerr_endline ("unknown tag: " ^ e); "" in
|
||||
Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat
|
||||
|
||||
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
|
||||
| None -> Html.(header (heading1 title))
|
||||
in
|
||||
|
||||
let note_html = match note_template with
|
||||
| Some (Note s) -> Html.block @@ fold_note note s
|
||||
| None ->
|
||||
let open Logarion.Note in
|
||||
let open Logarion.Meta in
|
||||
let date = Date.(pretty_date @@ last note.meta.date) in
|
||||
let abstract = note.meta.abstract in
|
||||
let body = Omd.to_html (Omd.of_string note.body) in
|
||||
Html.note ~date ~abstract ~body
|
||||
in
|
||||
|
||||
Html.to_string @@ Html.page ~style url title header_html note_html
|
||||
|
||||
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
|
||||
| None -> Html.(header (heading1 title))
|
||||
in
|
||||
|
||||
let listing_html = match listing_template with
|
||||
| Some (Note s) -> Html.block @@ fold_index ~from ~n metas s
|
||||
| None -> listing metas
|
||||
in
|
||||
|
||||
Html.to_string @@ Html.page ~style url title header_html listing_html
|
||||
|
||||
@ -123,8 +123,8 @@ let convert directory =
|
||||
let notes = File.to_list L.note_lens archive.store in
|
||||
let metas = File.to_list L.meta_lens archive.store in
|
||||
|
||||
let page_of_note = Converters.Html.of_note ~style:"static/main.css" "localhost" config in
|
||||
let page_of_note_listing = Converters.Html.of_entries ~style:"static/main.css" "localhost" config in
|
||||
let page_of_note = Converters.Template.note_page ~style:"static/main.css" "localhost" "title for now" in
|
||||
let page_of_note_listing = Converters.Template.listing_page ~style:"static/main.css" ~from:0 ~n:1000 "localhost" "title for now" in
|
||||
let path_of_note note = directory ^ "/" ^ Meta.string_alias Note.(note.meta.Meta.title) ^ ".html" in
|
||||
let file_creation path content =
|
||||
let out = open_out path in
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user