Relativize header links

This commit is contained in:
Stavros Polymenis 2017-12-16 00:25:56 +00:00
parent d43764b49a
commit b1a77050e0
3 changed files with 16 additions and 11 deletions

View File

@ -20,12 +20,12 @@ let escaped_index ~from ~n metas e = [Html.data "temp"]
(* in *)
(* Logarion.Meta.StringSet.fold (fun e a -> a ^ "<li><a href=\"/topic/" ^ e ^ "\">" ^ e ^ "</a></li>") topics "" *)
let header_custom template archive =
let header_custom template linker archive =
Mustache.fold ~string ~section ~escaped:(Html.Renderer.archive archive) ~unescaped ~partial ~comment ~concat template
|> Html.header
let header_default archive =
Html.(header [title [anchor "index.html" [data archive.Logarion.Archive.Configuration.title]]])
let header_default linker archive =
Html.(header [title [anchor (linker "/") [data archive.Logarion.Archive.Configuration.title]]])
let meta meta =
let open Logarion.Note in
@ -49,9 +49,11 @@ let body_default note =
meta note.meta;
Html.unescaped_data @@ Omd.to_html @@ Omd.of_string note.Logarion.Note.body ]
let listing url_of_meta metas = Html.listing url_of_meta metas
let listing url_of_meta metas =
Html.listing url_of_meta metas
let page ~style title header body = Html.to_string @@ Html.page ~style title header body
let page ~style title header body =
Html.to_string @@ Html.page ~style title header body
let of_config config k = match config with
| Error msg -> prerr_endline "Couldn't load [templates] section"; None

View File

@ -127,8 +127,9 @@ let convert directory =
let module T = Converters.Template in
let header = T.header_converter template_config in
let body = T.body_converter template_config in
let page_of_listing metas = T.page_of_listing header (T.listing (fun x -> x ^ ".html")) config metas in
let page_of_note note = T.page_of_note header body config note in
let linker x = match Fpath.(relativize ~root:(v "/") (v x)) with Some l -> Fpath.to_string l | None -> "" in
let page_of_listing metas = T.page_of_listing (header linker) (T.listing (fun x -> x ^ ".html")) config metas in
let page_of_note note = T.page_of_note (header linker) body config note 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

View File

@ -85,12 +85,13 @@ let serve config_filename =
let module T = Converters.Template in
let header = T.header_converter template_config in
let body = T.body_converter template_config in
let linker r x = match Fpath.(relativize ~root:(v r) (v x)) with Some l -> Fpath.to_string l | None -> "" in
let page_of_listing metas =
let listing = T.listing (fun x -> "note/" ^ x) in
T.page_of_listing ~style:"/static/main.css" header listing config metas in
let page_of_note note = T.page_of_note ~style:"/static/main.css" header body config note in
let page_of_msg title msg = T.page_of_msg ~style:"/static/main.css" header config title msg in
let form_of_note note = T.page "/static/main.css" "Write new note" (header config) (Converters.Html.form "" "" note) in
T.page_of_listing ~style:"/static/main.css" (header (linker "/")) listing config metas in
let page_of_note note = T.page_of_note ~style:"/static/main.css" (header (linker "/note")) body config note in
let page_of_msg title msg = T.page_of_msg ~style:"/static/main.css" (header (linker "/note")) config title msg in
let form_of_note note = T.page "/static/main.css" "Write new note" ((header (linker "/")) config) (Converters.Html.form "" "" note) in
let post_note lgrn req =
note_of_req req
@ -154,6 +155,7 @@ let serve config_filename =
| Some meta -> L.note_with_id lgrn meta.Logarion.Meta.uuid
| None -> None)
|> get "/feed.atom" @@ atom_response lgrn
|> get "/index.html"@@ list_notes "p" lgrn
|> get "/" @@ list_notes "p" lgrn
|> App.start
in