From b1a77050e01e43565b530928c9c282aac931cd26 Mon Sep 17 00:00:00 2001
From: Stavros Polymenis <sp@orbitalfox.eu>
Date: Sat, 16 Dec 2017 00:25:56 +0000
Subject: [PATCH] Relativize header links

---
 src/converters/template.ml | 12 +++++++-----
 src/logarion_cli.ml        |  5 +++--
 src/logarion_webserver.ml  | 10 ++++++----
 3 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/src/converters/template.ml b/src/converters/template.ml
index d334449..1358188 100644
--- a/src/converters/template.ml
+++ b/src/converters/template.ml
@@ -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
diff --git a/src/logarion_cli.ml b/src/logarion_cli.ml
index 5ff3780..9caa882 100644
--- a/src/logarion_cli.ml
+++ b/src/logarion_cli.ml
@@ -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
diff --git a/src/logarion_webserver.ml b/src/logarion_webserver.ml
index e50fab5..1f48e06 100644
--- a/src/logarion_webserver.ml
+++ b/src/logarion_webserver.ml
@@ -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