introduced topic listing

share/html_templates/listing.mustache

@@ -1,2 +1,7 @@
+<h2>Topics</h2>
+
+{{topics}}
+
 <h2>Recent articles</h2>
+
 {{recent_texts_listing}}

src/html.ml

@@ -44,15 +44,17 @@ let article_link entry =
         [Unsafe.data (Ymd.(entry.meta.title) ^ Ymd.Date.(pretty_date @@ last entry.meta.date)) ]
      ]
 
-let of_entries ?(header_tpl=None) ?(listing_tpl=None) ?(entry_tpl=None) blog_url lgrn (entries : Logarion.Entry.t list) =
+let of_entries ?(header_tpl=None) ?(listing_tpl=None) ?(entry_tpl=None) blog_url lgrn =
   let t = Logarion.Configuration.(lgrn.title) in
   logarion_page
     ~header_tpl
     blog_url
     t t
     (match listing_tpl with
-     | Some (Template.Listing s) -> Unsafe.data Template.(fold_index ~entry_tpl entries s)
-     | None -> (div [ h2 [pcdata "Articles"]; ul (List.map article_link entries); ]))
+     | Some (Template.Listing s) -> Unsafe.data Template.(fold_index ~entry_tpl lgrn s)
+     | None ->
+        let entries = Logarion.(Archive.of_repo lgrn.Configuration.repository |> latest_listed_entries) in
+        (div [ h2 [pcdata "Articles"]; ul (List.map article_link entries); ]))
   |> to_string
 
 let form ?(header_tpl=None) blog_url lgrn ymd =

src/logarion.ml

@@ -84,6 +84,9 @@ let rec next_semantic_filepath ?(version=0) titles ymd =
 module Archive = struct
   type t = Entry.t list
 
+  let latest = List.fast_sort Ymd.(fun b a -> compare (Date.last a.Entry.meta.date) (Date.last b.Entry.meta.date))
+  let listed = List.filter Ymd.(fun a -> not @@ CategorySet.categorised [Category.Unlisted] a.Entry.meta.categories)
+
   let of_repo ?(bodies=false) repo =
     let files = Array.to_list @@ Sys.readdir (titledir repo) in
     let ymd_list a e = if BatString.ends_with e extension then List.cons e a else a in
@@ -113,8 +116,20 @@ module Archive = struct
       end
     else
       Lwt.return ()
+
+  let topics archive =
+    let rec unique_entry ts = function
+      | h :: t ->
+         let p x = x = h in
+         if not (List.exists p ts) then unique_entry (List.cons h ts) t else unique_entry ts t
+      | [] -> ts
+    in
+    let unique_topics ts x = unique_entry ts x.Entry.meta.topics in
+    List.fold_left unique_topics [] archive
 end
 
+let latest_listed_entries es = es |> Archive.listed |> Archive.latest
+
 let latest_entry config fragment =
   let repo = Configuration.(config.repository) in
   let latest p entry' =

src/template.ml

@@ -7,6 +7,7 @@ type footer = Footer of t
 type listing = Listing of t
 type listing_entry = Listing_entry of t
 type text = Text of t
+type index = Index of t
 
 let of_string = Mustache.of_string
 let of_file f = Logarion.File.load f |> of_string
@@ -15,6 +16,7 @@ let header  f = Header (of_file f)
 let listing f = Listing (of_file f)
 let listing_entry f = Listing_entry (of_file f)
 let text    f = Text (of_file f)
+let index   f = Index (of_file f)
 
 let string s = s
 let section ~inverted name contents = "section"
@@ -68,8 +70,8 @@ let fold_header blog_url title =
     | "title" -> title
     | _ -> prerr_endline ("unknown tag: " ^ e); "" in
   Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat
-  
-let fold_index ?(entry_tpl=None) entries =
+
+let fold_index ?(entry_tpl=None) lgrn =
   let simple entry =
     "<li><a href=\"/text/" ^ Filename.chop_extension entry.Logarion.Entry.filepath ^ "\">"
     ^ entry.meta.title ^ " ~ " ^ Ymd.Date.(pretty_date @@ last entry.meta.date) ^ "</a></li>" in
@@ -77,10 +79,12 @@ let fold_index ?(entry_tpl=None) entries =
   let entry = match entry_tpl with Some (Listing_entry e) -> fold_entry e | None -> simple in
   let escaped e = match e with
     | "recent_texts_listing" ->
-       (ListLabels.fold_left
-          ~init:("<ul>")
-          ~f:(fun a e -> a ^ (entry e))
-          entries)
+       let entries = Logarion.(Archive.of_repo lgrn.Configuration.repository |> latest_listed_entries) in
+       (ListLabels.fold_left ~init:("<ul>") ~f:(fun a e -> a ^ (entry e)) entries)
+       ^ "</ul>"
+    | "topics" ->
+       let entries = Logarion.(Archive.of_repo lgrn.Configuration.repository |> Archive.listed |> Archive.topics) in
+       (ListLabels.fold_left ~init:("<ul>") ~f:(fun a e -> a ^ "<li>" ^ e ^ "</li>") entries)
        ^ "</ul>"
     | _ -> prerr_endline ("unknown tag: " ^ e); "" in
   Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat

src/web.ml

@@ -87,11 +87,6 @@ let () =
   let page_of_ymd = Html.of_ymd ~header_tpl ~text_tpl blog_url lgrn in
   let form_of_ymd = Html.form ~header_tpl blog_url lgrn in
   let list_of_ymds = Html.of_entries ~header_tpl ~listing_tpl ~entry_tpl blog_url lgrn in
-  let latest_listed_entries es =
-    es
-    |> List.filter Ymd.(fun a -> not @@ CategorySet.categorised [Category.Unlisted] a.L.Entry.meta.categories)
-    |> List.fast_sort Ymd.(fun b a -> compare (Date.last a.L.Entry.meta.date) (Date.last b.L.Entry.meta.date))
-  in
   let repo = lgrn.L.Configuration.repository in
   App.empty
   |> App.port webcfg.Configuration.port
@@ -101,6 +96,6 @@ let () =
   |> get "/new"       (fun _   -> Lwt.return (Ymd.blank_ymd ()) >|= form_of_ymd >>= html_response)
   |> get "/text/:ttl" (fun req -> ret_param "ttl" req >>= ymdpath >|= ymd >|= L.Entry.to_ymd >|= page_of_ymd >>= html_response)
   |> get "/!/:ttl"    (fun req -> ret_param "ttl" req >|= L.latest_entry lgrn >|= entry_option >|= L.Entry.to_ymd >|= page_of_ymd >>= html_response)
-  |> get "/feed.atom" (fun _   -> Lwt.return L.Archive.(of_repo ~bodies:true repo) >|= latest_listed_entries >|= List.map L.Entry.to_ymd >|= Atom.feed webcfg.url lgrn >>= html_response)
-  |> get "/"          (fun _   -> Lwt.return L.Archive.(of_repo repo) >|= latest_listed_entries >|= list_of_ymds >>= html_response)
+  |> get "/feed.atom" (fun _   -> Lwt.return L.Archive.(of_repo ~bodies:true repo) >|= L.latest_listed_entries >|= List.map L.Entry.to_ymd >|= Atom.feed webcfg.url lgrn >>= html_response)
+  |> get "/"          (fun _   -> Lwt.return list_of_ymds >>= html_response)
   |> App.run_command