Relativize header links
This commit is contained in:
parent
d43764b49a
commit
b1a77050e0
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user