From eef6f3f7100c5d4e7ad56a8b5d1ea9381f81940e Mon Sep 17 00:00:00 2001
From: orbifx <fox@orbitalfox.eu>
Date: Tue, 22 Jun 2021 00:38:41 +0100
Subject: [PATCH] Gemini index.gmi, topics and latest

---
 cli/convert.ml | 14 +++++++----
 cli/gemini.ml  | 65 ++++++++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 73 insertions(+), 6 deletions(-)

diff --git a/cli/convert.ml b/cli/convert.ml
index 7161a84..8a108fe 100644
--- a/cli/convert.ml
+++ b/cli/convert.ml
@@ -26,18 +26,24 @@ let index_writer types dir archive topic_roots topic_map indexed_texts =
 	file "/index.pck"	(Header_pack.pack archive indexed_texts);
 	if "htm" = types || "all" = types then (
 		file "/index.html" (Html.topic_main_index name topic_roots indexed_texts);
+		file "/index.date.htm" (Html.date_index name indexed_texts);
 		List.iter
 			(fun topic -> file ("/index." ^ topic ^ ".htm")
 			 (Html.topic_sub_index name topic_map topic indexed_texts))
-			topic_roots;
-		file "/index.date.htm" (Html.date_index name indexed_texts);
+			topic_roots
 	);
 	let base_url = try Store.KV.find "HTTP-URL" archive.File_store.kv
 		with Not_found -> prerr_endline "Missing `HTTP-URL:` in config"; ""
 	in
 	file "/feed.atom" (Atom.feed archive.A.name archive.A.id base_url indexed_texts);
-	if "gmi" = types || "all" = types then
-	file "/index.date.gmi" (Gemini.date_index name indexed_texts)
+	if "gmi" = types || "all" = types then (
+		file "/index.gmi" (Gemini.topic_main_index name topic_roots indexed_texts);
+		file "/index.date.gmi" (Gemini.date_index name indexed_texts);
+		List.iter
+			(fun topic -> file ("/index." ^ topic ^ ".gmi")
+			 (Gemini.topic_sub_index name topic_map topic indexed_texts))
+			topic_roots
+	)
 
 let txt_writer types dir name ((text, _store_item) as r) =
 	match Logarion.Text.str "Content-Type" text with
diff --git a/cli/gemini.ml b/cli/gemini.ml
index 472e97f..4bfa0d0 100644
--- a/cli/gemini.ml
+++ b/cli/gemini.ml
@@ -2,7 +2,7 @@ let page _archive_title text =
   let open Logarion.Text in
   "# " ^ text.title
   ^ "\nAuthors: " ^ Logarion.Person.Set.to_string text.authors
-  ^ "\nDated: " ^ Logarion.Date.(pretty_date @@ listing text.date)
+  ^ "\nDate: " ^ Logarion.Date.(pretty_date @@ listing text.date)
   ^ let module T = Parsers.Plain_text.Make (Converter.Gemini) in
   "\n" ^ T.of_string text.body ""
 
@@ -11,4 +11,65 @@ let date_index title meta_list =
     (fun a m ->
       a ^ "=> " ^ Logarion.Text.alias m ^ ".gmi " ^
         Logarion.(Date.(pretty_date (listing m.date)) ^ " " ^ m.title) ^ "\n")
-    ("# " ^ title ^ "\n") meta_list
+    ("# " ^ title ^ "\n\n") meta_list
+
+let to_dated_links ?(limit) meta_list =
+  let meta_list = match limit with
+    | None -> meta_list
+    | Some limit->
+       let rec reduced acc i = function
+         | [] -> acc
+         | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in
+       List.rev @@ reduced [] 0 meta_list
+  in
+  List.fold_left
+    (fun a m ->
+      a
+      ^ "=> " ^ Logarion.Text.alias m ^ ".gmi "
+      ^ Logarion.(Date.(pretty_date (listing m.Text.date))) ^ " "
+      ^ m.Logarion.Text.title ^ "\n")
+    "" meta_list
+
+let topic_link root topic = 
+ "=> index." ^ root ^ ".gmi " ^ String.capitalize_ascii topic ^ "\n"
+
+
+let text_item path meta =
+  let open Logarion in
+  "=> " ^ path ^ Text.alias meta ^ ".gmi "
+  ^ Date.(pretty_date (listing meta.Text.date)) ^ " "
+  ^ meta.Text.title ^ "\n"
+
+let listing_index topic_map topic_roots path metas =
+  let rec item_group topics =
+    List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics
+  and sub_groups topic = match Logarion.Topic_set.Map.find_opt topic topic_map with
+    | None -> ""
+    | Some (_, subtopics) -> item_group (Logarion.String_set.elements subtopics)
+  and items topic =
+    let items =
+      let open Logarion in
+      List.fold_left
+        (fun a e ->
+        if String_set.mem topic (String_set.map (Logarion.Topic_set.topic) (Text.set "Topics" e))
+        then text_item path e ^ a else a) "" metas in
+    match items with
+    | "" -> ""
+    | x -> "## " ^ String.capitalize_ascii topic ^ "\n\n" ^ x
+  in
+  item_group topic_roots
+
+
+let fold_topic_roots topic_roots =
+  let list_item root t = topic_link root t in
+  List.fold_left (fun a x -> a ^ list_item x x) "" (List.rev topic_roots)
+
+let topic_main_index _title topic_roots metas =
+  "# Main topics\n\n"
+  ^ fold_topic_roots topic_roots
+  ^ "\n\n# Latest\n\n" ^ to_dated_links ~limit:10 metas
+  ^ "\n=> index.date.gmi More by date\n"
+
+let topic_sub_index _title topic_map topic_root metas =
+  "# " ^ String.capitalize_ascii topic_root ^ "\n\n"
+  ^ listing_index topic_map [topic_root] "" metas